diff --git a/.github/workflows/e3sm-gh-md-linter.yml b/.github/workflows/e3sm-gh-md-linter.yml index 46259830c5c2..c013e8612f2f 100644 --- a/.github/workflows/e3sm-gh-md-linter.yml +++ b/.github/workflows/e3sm-gh-md-linter.yml @@ -25,7 +25,7 @@ jobs: with: files: '**/*.md' separator: "," - - uses: DavidAnson/markdownlint-cli2-action@v19 + - uses: DavidAnson/markdownlint-cli2-action@v20 if: steps.changed-files.outputs.any_changed == 'true' with: config: 'docs/.markdownlint.json' diff --git a/.github/workflows/eamxx-gh-clang-format.yml b/.github/workflows/eamxx-gh-clang-format.yml new file mode 100644 index 000000000000..a07710b8425f --- /dev/null +++ b/.github/workflows/eamxx-gh-clang-format.yml @@ -0,0 +1,42 @@ +name: "eamxx-format" + +# if .{cpp,hpp} files are touched in a PR, lint them! + +on: + pull_request: + branches: ["master"] + paths: + - 'components/eamxx/**/*.cpp' + - 'components/eamxx/**/*.hpp' + +concurrency: + group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.run_id }} + cancel-in-progress: true + +jobs: + clang-format-linter: + if: ${{ github.repository == 'E3SM-Project/E3SM' }} + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + - uses: tj-actions/changed-files@v46 + id: changed-files + with: + files: 'components/eamxx/**/*.{cpp,hpp}' + separator: " " + # 1. runs clang-format on the files changed by this PR, and returns pass/fail + # error code. + # 2. prints the diff to screen (action log), comparing to the changes + # that *would* be made + # 3. the E3SM-Project fork of DoozyX/clang-format-lint-action@v0.20 + # adds a Step summary to the workflow page, and, on failure, lists the + # files that fail the clang-format test + - uses: E3SM-Project/clang-format-lint-action@v1.0.0 + with: + source: ${{ steps.changed-files.outputs.all_changed_files }} + exclude: '' + extensions: 'hpp,cpp' + clangFormatVersion: 14 + style: 'file:components/eamxx/.clang-format' diff --git a/.github/workflows/eamxx-v1-testing.yml b/.github/workflows/eamxx-v1-testing.yml index 42d9862d449d..cdb97729c952 100644 --- a/.github/workflows/eamxx-v1-testing.yml +++ b/.github/workflows/eamxx-v1-testing.yml @@ -72,8 +72,10 @@ jobs: short_name: ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.eamxx-dpxx-arm97 - full_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.ghci-snl-cpu_gnu.eamxx-small_kernels--eamxx-output-preset-5 short_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels--eamxx-output-preset-5 - - full_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.ghci-snl-cpu_gnu.eamxx-mam4xx-all_mam4xx_procs - short_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs + - full_name: REP_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.ghci-snl-cpu_gnu + short_name: REP_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx + - full_name: "ERS.ne4pg2_ne4pg2.F2010-SCREAMv1.ghci-snl-cpu_gnu.eamxx-prod" + short_name: ERS.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-prod fail-fast: false name: cpu-gcc / ${{ matrix.test.short_name }} steps: diff --git a/.gitmodules b/.gitmodules index b36d90a00a42..da03b18ef666 100644 --- a/.gitmodules +++ b/.gitmodules @@ -22,8 +22,8 @@ branch = scorpio_classic [submodule "cosp2"] path = components/eam/src/physics/cosp2/external - url = git@github.com:bartgol/COSPv2.0.git - branch = bartgol/fix-cosp_optical_inputs + url = git@github.com:e3sm-project/COSPv2.0.git + branch = e3sm-master [submodule "cime"] path = cime url = git@github.com:ESMCI/cime.git diff --git a/README.md b/README.md index 13c927b8c7f1..b257cd7fc5b0 100644 --- a/README.md +++ b/README.md @@ -5,9 +5,9 @@ Energy Exascale Earth System Model (E3SM) ================================================================================ -E3SM is a state-of-the-art fully coupled model of the Earth's climate including +E3SM is a state-of-the-art fully coupled model of the Earth System including important biogeochemical and cryospheric processes. It is intended to address -the most challenging and demanding climate-change research problems and +the most challenging and demanding earth system research problems and Department of Energy mission needs while efficiently using DOE Leadership Computing Facilities. diff --git a/cime b/cime index 1fde6df29e11..5f6a6a8334dc 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 1fde6df29e11bc2508535293f3c4c8203c9cb347 +Subproject commit 5f6a6a8334dc1b168e47add97daa983fa8ade49f diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index b083a230c05d..3ad22b7b5a80 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -107,7 +107,7 @@ - + allactive: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0 @@ -160,21 +160,6 @@ - - - allactive+gcp: default 1 node 30x1 - - 30 - 30 - 30 - 16 - 16 - 16 - 30 - 30 - - - allactive+lawrencium-lr3: default, 2 nodes @@ -263,7 +248,7 @@ - + "pm-cpu basic 4 nodes, 256 partition, 128x1, ~6 sypd" @@ -313,29 +298,6 @@ - - - "gcp10, 8 nodes, 240 partition, 2 threads 30x2" - - -8 - -8 - -8 - -8 - -8 - -1 - -1 - -8 - - - 2 - 2 - 2 - 2 - 2 - 2 - - - "anvil, GPMPAS-JRA compset, 6 nodes" @@ -507,7 +469,7 @@ - + pm-cpu: ne120-wcycl on 42 nodes 128x1 ~0.7 sypd 128 @@ -981,36 +943,7 @@ - - - gcp10 -compset A_WCYCL* -res ne30pg2_oECv3 with MPASO on 11 nodes - - 240 - 240 - 240 - 240 - 84 - 240 - - - 2 - 2 - 2 - 2 - 2 - 1 - - - 0 - 0 - 0 - 0 - 240 - 0 - - - - + pm-cpu: -compset A_WCYCL* -res ne30pg2_oECv3 with MPASO on 8 nodes, stacked layout, 128x1 4-5 sypd 128 @@ -1383,7 +1316,7 @@ - + pm-cpu --compset WCYCL* --res ne30pg2_r05_IcoswISC30E3r5 on 8 nodes, stacked layout, 128x1 4-5 sypd 128 @@ -1461,21 +1394,6 @@ - - - sunspot|aurora: --compset BGC* --res ne30pg2_r05_IcoswISC30E3r5 on 2 nodes pure-MPI - - -2 - -2 - -2 - -2 - -2 - -2 - -2 - -2 - - - @@ -1780,7 +1698,7 @@ - + allactive+pm-cpu: default, 1 node, 96 tasks, 1 thread @@ -1797,30 +1715,30 @@ - + - "pm-gpu ne30np4 and ne30np4.pg2 2 nodes, 4x16" + default pm-gpu ne30np4 and ne30np4.pg2 1 node 4x1 (16 threads in lnd/ice/ocn/rof) - -2 - -2 - -2 - -2 - -2 - -2 - -2 - -2 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 - 16 + 1 16 - 8 - 8 - 8 - 8 + 16 + 16 + 16 + 1 - "pm-gpu ne30 for fully coupled cases with ATM on GPU, MPAS on CPU -- WCYCLXX2010 4 nodes, 4x16" + pm-gpu ne30 for fully coupled cases with ATM on GPU, MPAS on CPU -- WCYCLXX2010 4 nodes, 4x16 -4 -4 @@ -1841,44 +1759,6 @@ - - - "pm-cpu ne30np4 and ne30np4.pg2 2 nodes, stacked, 1 thread, 128x1" - - -2 - -2 - -2 - -2 - -2 - -2 - -2 - -2 - - - - - - "frontier ne30np4 and ne30np4.pg2" - - -2 - -2 - -2 - -2 - -2 - -2 - -2 - -2 - - - 1 - 7 - 1 - 1 - 1 - 1 - - - @@ -2168,7 +2048,7 @@ - + pm-cpu: 8 nodes, 128x1 @@ -2496,53 +2376,6 @@ - - - 8 - 56 - - -6 - -6 - -6 - -6 - -6 - -6 - -6 - -6 - - - 1 - 7 - 1 - 1 - 1 - 1 - - - - - - pm-gpu conus 2 nodes, 4x1 except 16 threads in LND - 4 - 16 - - -2 - -2 - -2 - -2 - -2 - -2 - - - 1 - 16 - 1 - 1 - 1 - 1 - - - @@ -2587,7 +2420,7 @@ - + pm-cpu: conus 2 nodes @@ -2610,7 +2443,7 @@ - + pm-cpu: GIS 1-to-10km (high-res) baseline config 128 @@ -2685,7 +2518,7 @@ - + GIS 20km (low-res) testing config 128 @@ -2722,4 +2555,23 @@ + + + + + + pm-cpu: GIS 20 or 40km (low-res) testing config, 2 nodes, 128x1 + + 256 + 256 + 256 + 256 + 256 + 256 + 256 + 256 + + + + diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index 8cb7a5305386..4f844a971de8 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -30,6 +30,10 @@ rhist\.(INSTANT|AVERAGE|MAX|MIN)\.n(step|sec|min|hour|day|month|year)s_x\d* .*\.h\.(?!rhist\.).*\.nc$ + + rpointer.atm$NINST_STRING + $CASE.scream$NINST_STRING.r.$DATENAME.nc + diff --git a/cime_config/config_files.xml b/cime_config/config_files.xml index 842cd41f49cd..6eaf5f61acbd 100644 --- a/cime_config/config_files.xml +++ b/cime_config/config_files.xml @@ -286,6 +286,7 @@ $SRCROOT/cime_config/allactive/config_pesall.xml $COMP_ROOT_DIR_CPL/cime_config/config_pes.xml $SRCROOT/components/eam/cime_config/config_pes.xml + $SRCROOT/components/eamxx/cime_config/config_pes.xml $SRCROOT/components/elm/cime_config/config_pes.xml $SRCROOT/components/cice/cime_config/config_pes.xml $SRCROOT/components/mpas-ocean/cime_config/config_pes.xml diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index bac808250863..144f75acc513 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -1913,6 +1913,36 @@ oRRS18to6v3 + + ne1024np4.pg2 + ne1024np4.pg2 + RRSwISC6to18E3r5 + r025 + null + null + RRSwISC6to18E3r5 + + + + ne1024np4.pg2 + r025 + RRSwISC6to18E3r5 + r025 + null + null + RRSwISC6to18E3r5 + + + + ne1024np4.pg2 + r0125 + RRSwISC6to18E3r5 + r0125 + null + null + RRSwISC6to18E3r5 + + ne1024np4.pg2 ne1024np4.pg2 @@ -3245,8 +3275,8 @@ $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_ICOS10.230120.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne120pg2_IcoswISC30E3r5.231121.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_IcoswISC30E3r5.231121.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.ne120pg2_RRSwISC6to18E3r5.240328.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_RRSwISC6to18E3r5.240328.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.ne120pg2_RRSwISC6to18E3r5.250216.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_RRSwISC6to18E3r5.250216.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne120pg2_gx1v6.190819.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_gx1v6.190819.nc ne120np4 is Spectral Elem 1/4-deg grid w/ 2x2 FV physics grid @@ -3314,6 +3344,8 @@ $DIN_LOC_ROOT/share/domains/domain.ocn.ne1024pg2_oRRS18to6v3.200212.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne1024pg2_ICOS10.211018.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne1024pg2_ICOS10.211018.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.ne1024pg2_RRSwISC6to18E3r5.250421.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne1024pg2_RRSwISC6to18E3r5.250421.nc ne1024np4.pg2 is Spectral Elem 3km grid w/ 2x2 FV physics grid per element: @@ -3544,8 +3576,8 @@ $DIN_LOC_ROOT/share/domains/domain.lnd.r05_IcosXISC30E3r7.240326.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_RRSwISC6to18E3r5.240328.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_RRSwISC6to18E3r5.240328.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.r05_SOwISC12to30E3r3.240808.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.r05_SOwISC12to30E3r3.240808.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r05_SOwISC12to30E3r3.250515.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r05_SOwISC12to30E3r3.250515.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_SOwISC12to30E3r4.250122.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_SOwISC12to30E3r4.250122.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_gx1v6.191014.nc @@ -3574,6 +3606,8 @@ $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_gx1v6.191017.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_oARRM60to10.210630.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_oARRM60to10.210630.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_RRSwISC6to18E3r5.250429.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_RRSwISC6to18E3r5.250429.nc r0125 is 1/8 degree river routing grid: @@ -3581,7 +3615,7 @@ 1440 720 $DIN_LOC_ROOT/share/domains/domain.lnd.r025_IcoswISC30E3r5.240129.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.r025_RRSwISC6to18E3r5.240402.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r025_RRSwISC6to18E3r5.250216.nc r025 is 1/4 degree river routing grid: @@ -4343,6 +4377,8 @@ cpl/gridmaps/ne120pg2/map_ne120pg2_to_RRSwISC6to18E3r5-nomask_trbilin.20240328.nc cpl/gridmaps/RRSwISC6to18E3r5/map_RRSwISC6to18E3r5_to_ne120pg2_traave.20240328.nc cpl/gridmaps/RRSwISC6to18E3r5/map_RRSwISC6to18E3r5_to_ne120pg2_traave.20240328.nc + cpl/gridmaps/ne120pg2/map_ne120pg2_to_RRSwISC6to18E3r5_trfvnp2.20240328.nc + cpl/gridmaps/ne120pg2/map_ne120pg2_to_RRSwISC6to18E3r5_trfvnp2.20240328.nc @@ -4502,6 +4538,28 @@ cpl/gridmaps/ne1024pg2/map_ICOS10_to_ne1024pg2_nco.211018.nc + + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_RRSwISC6to18E3r5_traave.20250402.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_RRSwISC6to18E3r5-nomask_trbilin.20250402.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_RRSwISC6to18E3r5_trbilin.20250402.nc + cpl/gridmaps/RRSwISC6to18E3r5/map_RRSwISC6to18E3r5_to_ne1024pg2_traave.20250402.nc + cpl/gridmaps/RRSwISC6to18E3r5/map_RRSwISC6to18E3r5_to_ne1024pg2_traave.20250402.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_RRSwISC6to18E3r5_trfvnp2.20250402.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_RRSwISC6to18E3r5_trfvnp2.20250402.nc + + + + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r025_traave.20250402.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r025_traave.20250402.nc + cpl/gridmaps/r025/map_r025_to_ne1024pg2_traave.20250402.nc + cpl/gridmaps/r025/map_r025_to_ne1024pg2_traave.20250402.nc + + + + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r025_traave.20250402.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r025_traave.20250402.nc + + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r0125_mono.200212.nc @@ -5958,6 +6016,11 @@ cpl/cpl6/map_r0125_to_ICOS10_smoothed.r50e100.220302.nc + + cpl/cpl6/map_r0125_to_RRSwISC6to18E3r5_r50e100.cstmnn.20250423.nc + cpl/cpl6/map_r0125_to_RRSwISC6to18E3r5_r50e100.cstmnn.20250423.nc + + ACTIVE @@ -6040,7 +6103,7 @@ cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_esmfaave.20240919.nc cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_esmfbilin.20240919.nc - cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_deeperThan300m.esmfneareststod.20240919.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_esmfbilin.20240919.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc @@ -6063,7 +6126,7 @@ cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfaave.20240403.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfbilin.20240403.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_deeperThan300m.esmfneareststod.20240422.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfbilin.20240403.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc @@ -6107,25 +6170,31 @@ cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis4to40_esmfaave.20250303.nc cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis4to40_esmfbilin.20250303.nc - cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis4to40_esmfaave.20250303.nc + + cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis4to40_esmfbilin.20250303.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI_esmfaave.20250303.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI_esmfaave.20250303.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI_esmfaave.20250303.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI_esmfaave.20250303.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI_nn.20250303.nc - cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI_nn.20250303.nc + cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_oQU240wLI-nomask_nn.20250403.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis4to40_esmfaave.20250218.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis4to40_esmfbilin.20250218.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis4to40_esmfaave.20250218.nc + + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis4to40_esmfbilin.20250218.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5_esmfaave.20250218.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5_esmfaave.20250218.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5_esmfaave.20250218.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5_esmfaave.20250218.nc cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5_nn.20250218.nc - cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5_nn.20250218.nc + cpl/gridmaps/mpas.gis4to40km/map_gis4to40_to_IcoswISC30E3r5-nomask_nn.20250403.nc @@ -6221,13 +6290,16 @@ cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfaave.20240403.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfbilin.20240403.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_deeperThan300m.esmfneareststod.20240820.nc + + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfbilin.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc - cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc - cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_nn.20250326.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5-nomask_nn.20250403.nc @@ -6280,23 +6352,25 @@ cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfaave.20240701.nc cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfbilin.20240701.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfbilin.20250403.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfbilin.20240701.nc - cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfnearestdtos.20240701.nc - cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI_esmfnearestdtos.20240701.nc + cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI_nn.20250218.nc + cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_nn.20250218.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfaave.20240701.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfbilin.20240701.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfbilin.20250403.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfbilin.20240701.nc - cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfnearestdtos.20240701.nc - cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5_esmfnearestdtos.20240701.nc + cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5_nn.20250403.nc + cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_nn.20250321.nc @@ -6320,23 +6394,25 @@ cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfaave.20240701.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfbilin.20240701.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfbilin.20250403.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfbilin.20240701.nc - cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfnearestdtos.20240701.nc - cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5_esmfnearestdtos.20240701.nc + cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5_nn.20250403.nc + cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_nn.20250403.nc cpl/gridmaps/SOwISC12to30E3r4/map_SOwISC12to30E3r4-nomask_to_ais4to20_esmfaave.20250122.nc cpl/gridmaps/SOwISC12to30E3r4/map_SOwISC12to30E3r4-nomask_to_ais4to20_esmfbilin.20250122.nc + cpl/gridmaps/SOwISC12to30E3r4/map_SOwISC12to30E3r4-nomask_to_ais4to20_esmfbilin.20250415.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4-nomask_esmfaave.20250122.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4-nomask_esmfbilin.20250122.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4-nomask_esmfaave.20250122.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4-nomask_esmfbilin.20250122.nc - cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4-nomask_esmfnearestdtos.20250122.nc - cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4_esmfnearestdtos.20250122.nc + cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4_nn.20250415.nc + cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_SOwISC12to30E3r4-nomask_nn.20250415.nc diff --git a/cime_config/customize/case_post_run_io.py b/cime_config/customize/case_post_run_io.py index d14c32ffa9d9..ba9116a105b6 100755 --- a/cime_config/customize/case_post_run_io.py +++ b/cime_config/customize/case_post_run_io.py @@ -35,6 +35,10 @@ def _convert_adios_to_nc(case): adios_conv_tool_args = "--idir=" + rundir adios_conv_tool_cmd = adios_conv_tool_exe + " " + adios_conv_tool_args + adios_conv_tool_extra_args = os.environ.get('SPIO_ADIOSBP2NC_CONVERSION_TOOL_EXTRA_ARGS', '') + if adios_conv_tool_extra_args.strip(): + adios_conv_tool_cmd += " " + adios_conv_tool_extra_args.strip() + # Replace logfile name, "e3sm.log.*" with "e3sm_adios_post_io.log.*" # The logfile name is part of the run command suffix adios_conv_tool_cmd_suffix = env_mach_specific.get_value("run_misc_suffix") diff --git a/cime_config/machines/Depends.alvarez.gnu.cmake b/cime_config/machines/Depends.alvarez-cpu.gnu.cmake similarity index 100% rename from cime_config/machines/Depends.alvarez.gnu.cmake rename to cime_config/machines/Depends.alvarez-cpu.gnu.cmake diff --git a/cime_config/machines/Depends.alvarez.intel.cmake b/cime_config/machines/Depends.alvarez-cpu.intel.cmake similarity index 100% rename from cime_config/machines/Depends.alvarez.intel.cmake rename to cime_config/machines/Depends.alvarez-cpu.intel.cmake diff --git a/cime_config/machines/Depends.alvarez.nvidia.cmake b/cime_config/machines/Depends.alvarez-cpu.nvidia.cmake similarity index 100% rename from cime_config/machines/Depends.alvarez.nvidia.cmake rename to cime_config/machines/Depends.alvarez-cpu.nvidia.cmake diff --git a/cime_config/machines/Depends.alvarez-gpu.nvidia.cmake b/cime_config/machines/Depends.alvarez-gpu.nvidia.cmake new file mode 100644 index 000000000000..89235ac5efd1 --- /dev/null +++ b/cime_config/machines/Depends.alvarez-gpu.nvidia.cmake @@ -0,0 +1,10 @@ +list(APPEND REDUCE_OPT_LIST + homme/src/share/derivative_mod_base.F90 +) + +# Can use this flag to avoid internal compiler error for this file (with nvidia/21.11) +if (NOT DEBUG) + foreach(ITEM IN LISTS REDUCE_OPT_LIST) + e3sm_add_flags("${ITEM}" " -Mnovect") + endforeach() +endif() diff --git a/cime_config/machines/Depends.alvarez-gpu.nvidiagpu.cmake b/cime_config/machines/Depends.alvarez-gpu.nvidiagpu.cmake new file mode 100644 index 000000000000..89235ac5efd1 --- /dev/null +++ b/cime_config/machines/Depends.alvarez-gpu.nvidiagpu.cmake @@ -0,0 +1,10 @@ +list(APPEND REDUCE_OPT_LIST + homme/src/share/derivative_mod_base.F90 +) + +# Can use this flag to avoid internal compiler error for this file (with nvidia/21.11) +if (NOT DEBUG) + foreach(ITEM IN LISTS REDUCE_OPT_LIST) + e3sm_add_flags("${ITEM}" " -Mnovect") + endforeach() +endif() diff --git a/cime_config/machines/Depends.oneapi-ifx.cmake b/cime_config/machines/Depends.oneapi-ifx.cmake deleted file mode 100644 index 5a958df26eba..000000000000 --- a/cime_config/machines/Depends.oneapi-ifx.cmake +++ /dev/null @@ -1,5 +0,0 @@ - -# compile mpas_seaice_core_interface.f90 with ifort, not ifx -if (NOT MPILIB STREQUAL "openmpi") - e3sm_add_flags("${CMAKE_BINARY_DIR}/core_seaice/model_forward/mpas_seaice_core_interface.f90" "-fc=ifort") -endif() diff --git a/cime_config/machines/Depends.oneapi-ifxgpu.cmake b/cime_config/machines/Depends.oneapi-ifxgpu.cmake deleted file mode 100644 index 5a958df26eba..000000000000 --- a/cime_config/machines/Depends.oneapi-ifxgpu.cmake +++ /dev/null @@ -1,5 +0,0 @@ - -# compile mpas_seaice_core_interface.f90 with ifort, not ifx -if (NOT MPILIB STREQUAL "openmpi") - e3sm_add_flags("${CMAKE_BINARY_DIR}/core_seaice/model_forward/mpas_seaice_core_interface.f90" "-fc=ifort") -endif() diff --git a/cime_config/machines/cmake_macros/amdclang_alvarez.cmake b/cime_config/machines/cmake_macros/amdclang_alvarez-cpu.cmake similarity index 100% rename from cime_config/machines/cmake_macros/amdclang_alvarez.cmake rename to cime_config/machines/cmake_macros/amdclang_alvarez-cpu.cmake diff --git a/cime_config/machines/cmake_macros/gnu_alvarez.cmake b/cime_config/machines/cmake_macros/gnu_alvarez-cpu.cmake similarity index 100% rename from cime_config/machines/cmake_macros/gnu_alvarez.cmake rename to cime_config/machines/cmake_macros/gnu_alvarez-cpu.cmake diff --git a/cime_config/machines/cmake_macros/gnu_alvarez-gpu.cmake b/cime_config/machines/cmake_macros/gnu_alvarez-gpu.cmake new file mode 100644 index 000000000000..226d07350a78 --- /dev/null +++ b/cime_config/machines/cmake_macros/gnu_alvarez-gpu.cmake @@ -0,0 +1,12 @@ +string(APPEND CONFIG_ARGS " --host=cray") +if (COMP_NAME STREQUAL gptl) + string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") +endif() +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -g") +set(MPICC "cc") +set(MPICXX "CC") +set(MPIFC "ftn") +set(SCC "gcc") +set(SCXX "g++") +set(SFC "gfortran") diff --git a/cime_config/machines/cmake_macros/gnu_gcp10.cmake b/cime_config/machines/cmake_macros/gnu_gcp10.cmake deleted file mode 100644 index b4b93eabb63f..000000000000 --- a/cime_config/machines/cmake_macros/gnu_gcp10.cmake +++ /dev/null @@ -1,5 +0,0 @@ -if (COMP_NAME STREQUAL gptl) - string(APPEND CPPDEFS " -DHAVE_VPRINTF -DHAVE_GETTIMEOFDAY -DHAVE_BACKTRACE -DHAVE_SLASHPROC") -endif() -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -fno-unsafe-math-optimizations") -string(APPEND CMAKE_EXE_LINKER_FLAGS " -L$ENV{CURL_PATH}/lib -lcurl") diff --git a/cime_config/machines/cmake_macros/gnugpu_alvarez-gpu.cmake b/cime_config/machines/cmake_macros/gnugpu_alvarez-gpu.cmake new file mode 100644 index 000000000000..4b9e77acb50f --- /dev/null +++ b/cime_config/machines/cmake_macros/gnugpu_alvarez-gpu.cmake @@ -0,0 +1,20 @@ +string(APPEND CONFIG_ARGS " --host=cray") +set(USE_CUDA "TRUE") +string(APPEND CPPDEFS " -DGPU") +if (COMP_NAME STREQUAL gptl) + string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") +endif() +string(APPEND CPPDEFS " -DTHRUST_IGNORE_CUB_VERSION_CHECK") +string(APPEND CMAKE_CUDA_FLAGS " -ccbin CC -O2 -arch sm_80 --use_fast_math") +string(APPEND KOKKOS_OPTIONS " -DKokkos_ARCH_AMPERE80=On -DKokkos_ENABLE_CUDA=On -DKokkos_ENABLE_CUDA_LAMBDA=On -DKokkos_ENABLE_SERIAL=ON -DKokkos_ENABLE_OPENMP=Off -DKokkos_ENABLE_IMPL_CUDA_MALLOC_ASYNC=OFF") +# Was trying this with cmake 3.30, but then ran into other issues +#string(APPEND KOKKOS_OPTIONS " -DKokkos_ARCH_AMPERE80=On -DKokkos_ENABLE_CUDA=On -DKokkos_ENABLE_CUDA_LAMBDA=On -DKokkos_ENABLE_SERIAL=ON -DKokkos_ENABLE_OPENMP=Off -DKokkos_ENABLE_IMPL_CUDA_MALLOC_ASYNC=OFF -DCMAKE_CXX_EXTENSIONS=Off") +set(CMAKE_CUDA_ARCHITECTURES "80") +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2") +set(MPICC "cc") +set(MPICXX "CC") +set(MPIFC "ftn") +set(SCC "cc") +set(SCXX "CC") +set(SFC "ftn") diff --git a/cime_config/machines/cmake_macros/intel_alvarez.cmake b/cime_config/machines/cmake_macros/intel_alvarez-cpu.cmake similarity index 88% rename from cime_config/machines/cmake_macros/intel_alvarez.cmake rename to cime_config/machines/cmake_macros/intel_alvarez-cpu.cmake index 4505a59a0f92..bd9b5949939a 100644 --- a/cime_config/machines/cmake_macros/intel_alvarez.cmake +++ b/cime_config/machines/cmake_macros/intel_alvarez-cpu.cmake @@ -25,8 +25,8 @@ string(APPEND CMAKE_CXX_FLAGS " -fp-model=precise") # and manually add precise #message(STATUS "ndk CXXFLAGS=${CXXFLAGS}") string(APPEND CMAKE_Fortran_FLAGS " -fp-model=consistent -fimf-use-svml") - # string(APPEND FFLAGS " -qno-opt-dynamic-align") - string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -g -traceback") - string(APPEND CMAKE_CXX_FLAGS_RELEASE " -g -traceback") +# string(APPEND FFLAGS " -qno-opt-dynamic-align") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -g -traceback") +#string(APPEND CMAKE_CXX_FLAGS_RELEASE " -g -traceback") string(APPEND CMAKE_Fortran_FLAGS " -DHAVE_ERF_INTRINSICS") string(APPEND CMAKE_CXX_FLAGS " -fp-model=consistent") diff --git a/cime_config/machines/cmake_macros/intel_chicoma-cpu.cmake b/cime_config/machines/cmake_macros/intel_chicoma-cpu.cmake index 28380b1e94f5..75a5bc8e4688 100644 --- a/cime_config/machines/cmake_macros/intel_chicoma-cpu.cmake +++ b/cime_config/machines/cmake_macros/intel_chicoma-cpu.cmake @@ -1,7 +1,8 @@ set(PIO_FILESYSTEM_HINTS "lustre") string(APPEND CONFIG_ARGS " --host=cray") string(APPEND CMAKE_EXE_LINKER_FLAGS " -qmkl") - +string(REPLACE "-fp-model source" "-fp-model precise" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") +string(REPLACE "-fp-model source" "-fp-model precise" CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS}") set(MPICC "cc") set(MPICXX "CC") set(MPIFC "ftn") diff --git a/cime_config/machines/cmake_macros/intel_stampede2.cmake b/cime_config/machines/cmake_macros/intel_stampede2.cmake deleted file mode 100644 index ff958842a506..000000000000 --- a/cime_config/machines/cmake_macros/intel_stampede2.cmake +++ /dev/null @@ -1,10 +0,0 @@ -string(APPEND CMAKE_C_FLAGS " -xCORE-AVX2") -string(APPEND CPPDEFS " -DLINUX") -if (COMP_NAME STREQUAL gptl) - string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY") -endif() -string(APPEND CPPDEFS " -DARCH_MIC_KNL") -string(APPEND CMAKE_Fortran_FLAGS " -fp-model consistent -fimf-use-svml") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -qno-opt-dynamic-align") -string(APPEND CMAKE_Fortran_FLAGS " -xCORE-AVX2") -string(APPEND CMAKE_EXE_LINKER_FLAGS " -lpthread") diff --git a/cime_config/machines/cmake_macros/nvidia_alvarez-cpu.cmake b/cime_config/machines/cmake_macros/nvidia_alvarez-cpu.cmake new file mode 100644 index 000000000000..49f785dafa92 --- /dev/null +++ b/cime_config/machines/cmake_macros/nvidia_alvarez-cpu.cmake @@ -0,0 +1,22 @@ +string(APPEND CONFIG_ARGS " --host=cray") +if (COMP_NAME STREQUAL gptl) + string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") +endif() +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -g") + +# currently, there is known issue with nvidia compiler installation (not seeing all relevant include files) +# and this is temporary work-around github.com/E3SM-Project/E3SM/issues/7003 +string(APPEND CMAKE_CXX_FLAGS_RELEASE " --gcc-toolchain=/usr/bin/gcc") +string(APPEND CMAKE_CXX_FLAGS_DEBUG " --gcc-toolchain=/usr/bin/gcc") + +if (compile_threaded) + string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_OPENMP=Off") # work-around for nvidia as kokkos is not passing "-mp" for threaded build +endif() +set(MPICC "cc") +set(MPICXX "CC") +set(MPIFC "ftn") +set(SCC "cc") +set(SCXX "CC") +set(SFC "ftn") diff --git a/cime_config/machines/cmake_macros/nvidia_alvarez.cmake b/cime_config/machines/cmake_macros/nvidia_alvarez-gpu.cmake similarity index 91% rename from cime_config/machines/cmake_macros/nvidia_alvarez.cmake rename to cime_config/machines/cmake_macros/nvidia_alvarez-gpu.cmake index 1818df0707f0..13d3b42fc48b 100644 --- a/cime_config/machines/cmake_macros/nvidia_alvarez.cmake +++ b/cime_config/machines/cmake_macros/nvidia_alvarez-gpu.cmake @@ -4,7 +4,7 @@ if (COMP_NAME STREQUAL gptl) endif() string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -g") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2") if (compile_threaded) string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_OPENMP=Off") # work-around for nvidia as kokkos is not passing "-mp" for threaded build endif() diff --git a/cime_config/machines/cmake_macros/nvidiagpu_alvarez-gpu.cmake b/cime_config/machines/cmake_macros/nvidiagpu_alvarez-gpu.cmake new file mode 100644 index 000000000000..93c7cdd16b21 --- /dev/null +++ b/cime_config/machines/cmake_macros/nvidiagpu_alvarez-gpu.cmake @@ -0,0 +1,14 @@ +string(APPEND CONFIG_ARGS " --host=cray") +set(USE_CUDA "TRUE") +string(APPEND CPPDEFS " -DGPU -DMPAS_OPENACC") +if (COMP_NAME STREQUAL gptl) + string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") +endif() +string(APPEND CPPDEFS " -DTHRUST_IGNORE_CUB_VERSION_CHECK") +string(APPEND CMAKE_CUDA_FLAGS " -ccbin CC -O2 -arch sm_80 --use_fast_math") +set(CMAKE_CUDA_ARCHITECTURES "80") +string(APPEND CMAKE_Fortran_FLAGS " -acc -gpu=cc80 -Minfo=accel") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -acc -gpu=cc80 -Minfo=accel") +set(SCC "cc") +set(SCXX "CC") +set(SFC "ftn") diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index 1f282b267cc8..b87716151f5f 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -13,7 +13,7 @@ string(APPEND CMAKE_CXX_FLAGS_RELEASE " -fp-model precise -O2 -g -gline-tables-o string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -fpscomp logicals") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") -string(APPEND CMAKE_C_FLAGS " -fp-model precise -std=gnu99") +string(APPEND CMAKE_C_FLAGS " -fp-model precise") string(APPEND CMAKE_CXX_FLAGS " -fp-model precise") string(APPEND CMAKE_Fortran_FLAGS " -fpscomp logicals -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise") string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL -DHAVE_SLASHPROC -DHIDE_MPI") diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake index 87698245781f..bf256e41aa17 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake @@ -5,9 +5,8 @@ if (compile_threaded) endif() string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") -string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") +string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 ") string(APPEND OMEGA_SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") -string(APPEND CMAKE_CXX_FLAGS " -Xclang -fsycl-allow-virtual-functions") # Let's start with the best case: using device buffers in MPI calls by default. # This is paired with MPIR_CVAR_ENABLE_GPU=1 in config_machines.xml. If this diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml index fab3a771f295..09da68864fad 100644 --- a/cime_config/machines/config_batch.xml +++ b/cime_config/machines/config_batch.xml @@ -435,18 +435,20 @@ preempt shared overrun - debug + debug - + --constraint=cpu - regular - preempt + regular + preempt + shared + overrun debug @@ -474,44 +476,60 @@ -G 0 - regular - preempt - debug + regular + preempt + debug - + --constraint=cpu - regular - preempt - shared - overrun + regular + preempt debug - + - --constraint=cpu + --constraint=gpu + + + --gpus-per-node=4 + --gpu-bind=none + + + --gpus-per-task=1 + --gpu-bind=map_gpu:0,1,2,3 + + + --gpus-per-node=4 + --gpu-bind=none + + + -G 0 + + + -G 0 - regular - debug + regular + preempt + debug - + - -n {{ total_tasks }} + --constraint=cpu - skx-dev - skx-large - skx-normal + regular + debug @@ -811,14 +829,6 @@ - - - compute-30 - computep - compute - - - c2dh112 diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 486d6af7026d..f6ba5c5795cd 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -275,16 +275,31 @@ CMA - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/intel-2023.1.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/intel-2023.2.0/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/intel-2023.2.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/intel-2023.2.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/intel-2023.2.0; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/intel-2023.2.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/intel-2023.2.0; else echo "$ZFP_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/gcc-native-12.3/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/gcc-native-12.3; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/gcc-native-12.3; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/gcc-native-12.3; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/gcc-native-12.3; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/gcc-native-12.3; else echo "$ZFP_ROOT"; fi} Generic $SHELL{if [ -z "$Albany_ROOT" ]; then echo /global/common/software/e3sm/albany/2024.03.26/gcc/11.2.0; else echo "$Albany_ROOT"; fi} $SHELL{if [ -z "$Trilinos_ROOT" ]; then echo /global/common/software/e3sm/trilinos/15.1.1/gcc/11.2.0; else echo "$Trilinos_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/nvidia-22.7; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/nvidia-24.5/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/nvidia-24.5; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/nvidia-24.5; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/nvidia-24.5; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/nvidia-24.5; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/nvidia-24.5; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$BLAS_ROOT" ]; then echo $NVIDIA_PATH/compilers; else echo "$BLAS_ROOT"; fi} @@ -295,7 +310,12 @@ Intel10_64_dyn - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/aocc-4.0.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/aocc-4.1.0/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/aocc-4.1.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/aocc-4.1.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/aocc-4.1.0; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/aocc-4.1.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/aocc-4.1.0; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /global/cfs/cdirs/e3sm/software/moab/intel; else echo "$MOAB_ROOT"; fi} @@ -454,10 +474,20 @@ $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /global/cfs/cdirs/e3sm/software/moab/gnugpu ; else echo "$MOAB_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/gcc-native-12.3/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/gcc-native-12.3; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/gcc-native-12.3; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/gcc-native-12.3; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/gcc-native-12.3; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/gcc-native-12.3; else echo "$ZFP_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/nvidia-22.7; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/nvidia-24.5/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/nvidia-24.5; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/nvidia-24.5; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/nvidia-24.5; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/nvidia-24.5; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/nvidia-24.5; else echo "$ZFP_ROOT"; fi} -1 @@ -592,16 +622,31 @@ 4000MB - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/intel-2023.1.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/intel-2023.2.0/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/intel-2023.2.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/intel-2023.2.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/intel-2023.2.0; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/intel-2023.2.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/intel-2023.2.0; else echo "$ZFP_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/gcc-native-12.3/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/gcc-native-12.3; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/gcc-native-12.3; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/gcc-native-12.3; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/gcc-native-12.3; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/gcc-native-12.3; else echo "$ZFP_ROOT"; fi} Generic $SHELL{if [ -z "$Albany_ROOT" ]; then echo /global/common/software/e3sm/albany/2024.03.26/gcc/11.2.0; else echo "$Albany_ROOT"; fi} $SHELL{if [ -z "$Trilinos_ROOT" ]; then echo /global/common/software/e3sm/trilinos/15.1.1/gcc/11.2.0; else echo "$Trilinos_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/nvidia-22.7; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/nvidia-24.5/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/nvidia-24.5; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/nvidia-24.5; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/nvidia-24.5; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/nvidia-24.5; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/nvidia-24.5; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$BLAS_ROOT" ]; then echo $NVIDIA_PATH/compilers; else echo "$BLAS_ROOT"; fi} @@ -612,7 +657,12 @@ Intel10_64_dyn - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/aocc-4.0.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/aocc-4.1.0/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/aocc-4.1.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/aocc-4.1.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/aocc-4.1.0; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/aocc-4.1.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/aocc-4.1.0; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /global/cfs/cdirs/e3sm/software/moab/intel; else echo "$MOAB_ROOT"; fi} @@ -772,18 +822,28 @@ $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /global/cfs/cdirs/e3sm/software/moab/gnugpu ; else echo "$MOAB_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/gcc-native-12.3/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/gcc-native-12.3; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/gcc-native-12.3; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/gcc-native-12.3; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/gcc-native-12.3; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/gcc-native-12.3; else echo "$ZFP_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/nvidia-22.7; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/nvidia-24.5/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/nvidia-24.5; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/nvidia-24.5; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/nvidia-24.5; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/nvidia-24.5; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/nvidia-24.5; else echo "$ZFP_ROOT"; fi} -1 - - test machine at NERSC, very similar to pm-cpu. each node has 2 AMD EPYC 7713 64-Core (Milan) 512GB + + Alvarez CPU nodes -- internal test machine at NERSC, very similar to pm-cpu. each node has 2 AMD EPYC 7713 64-Core (Milan) 512GB $ENV{NERSC_HOST}:alvarez Linux intel,gnu,nvidia,amdclang @@ -791,7 +851,7 @@ e3sm /global/cfs/cdirs/e3sm e3sm,m3411,m3412 - $ENV{SCRATCH}/e3sm_scratch/alvarez + $ENV{SCRATCH}/e3sm_scratch/alvarez-cpu /global/cfs/cdirs/e3sm/www/$ENV{USER} http://portal.nersc.gov/project/e3sm/$ENV{USER} /global/cfs/cdirs/e3sm/inputdata @@ -858,34 +918,37 @@ PrgEnv-gnu/8.5.0 gcc-native/13.2 - cray-libsci/24.03.0 + cray-libsci/24.07.0 PrgEnv-intel/8.5.0 intel/2024.1.0 + PrgEnv-nvidia nvidia/24.5 - cray-libsci/24.03.0 + cray-libsci/24.07.0 PrgEnv-aocc aocc/4.1.0 - cray-libsci/24.03.0 + cray-libsci/24.07.0 craype-accel-host - craype/2.7.31.11 - cray-mpich/8.1.29 - cray-hdf5-parallel/1.12.2.11 - cray-netcdf-hdf5parallel/4.9.0.11 - cray-parallel-netcdf/1.12.3.11 - cmake/3.24.3 + craype/2.7.32 + cray-mpich/8.1.30 + + + cray-hdf5-parallel/1.12.2.9 + cray-netcdf-hdf5parallel/4.9.0.9 + cray-parallel-netcdf/1.12.3.13 + cmake/3.30.2 @@ -908,18 +971,35 @@ $ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} $ENV{CRAY_PARALLEL_NETCDF_PREFIX} 4000MB + $ENV{CRAY_LD_LIBRARY_PATH}:$ENV{LD_LIBRARY_PATH} + XPMEM - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/intel-2023.1.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/intel-2023.2.0/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/intel-2023.2.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/intel-2023.2.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/intel-2023.2.0; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/intel-2023.2.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/intel-2023.2.0; else echo "$ZFP_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/gcc-native-12.3/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/gcc-native-12.3; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/gcc-native-12.3; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/gcc-native-12.3; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/gcc-native-12.3; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/gcc-native-12.3; else echo "$ZFP_ROOT"; fi} Generic $SHELL{if [ -z "$Albany_ROOT" ]; then echo /global/common/software/e3sm/albany/2024.03.26/gcc/11.2.0; else echo "$Albany_ROOT"; fi} $SHELL{if [ -z "$Trilinos_ROOT" ]; then echo /global/common/software/e3sm/trilinos/15.1.1/gcc/11.2.0; else echo "$Trilinos_ROOT"; fi} - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/nvidia-22.7; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/nvidia-24.5/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/nvidia-24.5; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/nvidia-24.5; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/nvidia-24.5; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/nvidia-24.5; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/nvidia-24.5; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$BLAS_ROOT" ]; then echo $NVIDIA_PATH/compilers; else echo "$BLAS_ROOT"; fi} @@ -930,7 +1010,12 @@ Intel10_64_dyn - $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/aocc-4.0.0; else echo "$ADIOS2_ROOT"; fi} + /global/cfs/cdirs/e3sm/3rdparty/protobuf/21.6/aocc-4.1.0/lib/pkgconfig:$ENV{PKG_CONFIG_PATH} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.10.2/cray-mpich-8.1.28/aocc-4.1.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/c-blosc2/2.15.2/aocc-4.1.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$MGARD_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/mgard/1.5.2/aocc-4.1.0; else echo "$MGARD_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/sz/2.1.12.5/aocc-4.1.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/zfp/1.0.1/aocc-4.1.0; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /global/cfs/cdirs/e3sm/software/moab/intel; else echo "$MOAB_ROOT"; fi} @@ -944,6 +1029,162 @@ + + Alvarez GPU nodes -- internal test machine at NERSC. similar to pm-gpu + $ENV{NERSC_HOST}:alvarez + Linux + gnugpu,gnu,nvidiagpu,nvidia + mpich + e3sm_g + /global/cfs/cdirs/e3sm + e3sm,m3411,m3412 + $ENV{SCRATCH}/e3sm_scratch/alvarez-gpu + /global/cfs/cdirs/e3sm/www/$ENV{USER} + http://portal.nersc.gov/project/e3sm/$ENV{USER} + /global/cfs/cdirs/e3sm/inputdata + /global/cfs/cdirs/e3sm/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /global/cfs/cdirs/e3sm/baselines/$COMPILER + /global/cfs/cdirs/e3sm/tools/cprnc/cprnc + 10 + e3sm_developer + 4 + nersc_slurm + e3sm + 128 + 256 + 256 + 4 + 64 + 64 + TRUE + + srun + + --label + -n {{ total_tasks }} -N {{ num_nodes }} + -c $SHELL{echo 128/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} + $SHELL{if [ 64 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} + -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} + + + + /usr/share/lmod/8.3.1/init/perl + /usr/share/lmod/8.3.1/init/python + /usr/share/lmod/8.3.1/init/sh + /usr/share/lmod/8.3.1/init/csh + /usr/share/lmod/lmod/libexec/lmod perl + /usr/share/lmod/lmod/libexec/lmod python + module + module + + + cpe + cray-hdf5-parallel + cray-netcdf-hdf5parallel + cray-parallel-netcdf + cray-netcdf + cray-hdf5 + PrgEnv-gnu + PrgEnv-intel + PrgEnv-nvidia + PrgEnv-cray + PrgEnv-aocc + gcc-native + intel + intel-oneapi + nvidia + aocc + cudatoolkit + climate-utils + cray-libsci + matlab + craype-accel-nvidia80 + craype-accel-host + perftools-base + perftools + darshan + + + + PrgEnv-gnu/8.5.0 + gcc-native/13.2 + + + + PrgEnv-nvidia + nvidia/24.5 + + + + cudatoolkit/12.4 + craype-accel-nvidia80 + + + + cudatoolkit/12.4 + craype-accel-nvidia80 + gcc-native-mixed/13.2 + + + + craype-accel-host + + + + craype-accel-host + + + + cray-libsci/24.07.0 + craype/2.7.32 + cray-mpich/8.1.30 + cray-hdf5-parallel/1.14.3.1 + cray-netcdf-hdf5parallel/4.9.0.13 + cray-parallel-netcdf/1.12.3.13 + cmake/3.24.3 + + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + 0.20 + + + 1 + 1 + 1 + 128M + spread + threads + FALSE + /global/cfs/cdirs/e3sm/perl/lib/perl5-only-switch + kdreg2 + MPI_Bcast + $ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} + $ENV{CRAY_PARALLEL_NETCDF_PREFIX} + + + 1 + + + 1 + + + $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /global/cfs/cdirs/e3sm/software/moab/gnugpu ; else echo "$MOAB_ROOT"; fi} + + + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + + + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /global/cfs/cdirs/e3sm/3rdparty/adios2/2.9.1/cray-mpich-8.1.25/nvidia-22.7; else echo "$ADIOS2_ROOT"; fi} + + + -1 + + Spock. NCCS moderate-security system that contains similar hardware and software as the upcoming Frontier system at ORNL. @@ -1138,7 +1379,6 @@ $ENV{NETCDF_DIR} $ENV{PNETCDF_DIR} - 0 1 2 @@ -1188,94 +1428,6 @@ - - - Stampede2. Intel skylake nodes at TACC. 48 cores per node, batch system is SLURM - .*stampede2.* - LINUX - intel,gnu - impi - $ENV{SCRATCH} - acme - $ENV{SCRATCH}/acme_scratch/stampede2 - $ENV{SCRATCH}/inputdata - $ENV{SCRATCH}/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - $ENV{SCRATCH}/baselines/$COMPILER - $ENV{SCRATCH}/tools/cprnc/cprnc - 8 - e3sm_developer - slurm - e3sm - 96 - 48 - FALSE - - ibrun - - - /opt/apps/lmod/lmod/init/perl - /opt/apps/lmod/lmod/init/python - /opt/apps/lmod/lmod/init/sh - /opt/apps/lmod/lmod/init/csh - /opt/apps/lmod/lmod/libexec/lmod perl - /opt/apps/lmod/lmod/libexec/lmod python - module -q - module -q - - - - - - - intel/18.0.0 - - - - gcc/6.3.0 - - - - impi/18.0.0 - - - - hdf5/1.8.16 - netcdf/4.3.3.1 - - - phdf5/1.8.16 - parallel-netcdf/4.3.3.1 - pnetcdf/1.8.1 - - - git - cmake - autotools - xalt - - - - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 1 - 1 - - 128M - spread - threads - 1 - -l - $ENV{TACC_NETCDF_DIR} - $ENV{TACC_PNETCDF_DIR} - - - Mac OS/X workstation or laptop @@ -1962,6 +2114,7 @@ @@ -2120,7 +2273,7 @@ sems-archive-netcdf/4.4.1/exo - /nscratch/$USER/acme_scratch/sandiatoss3/$CASE/run + /tscratch/$USER/acme_scratch/sandiatoss3/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld @@ -2181,6 +2334,7 @@ /projects/sems/acme-boca-modulefiles/env-module acme-boca-env + aue/python/3.11.6 sems-archive-git sems-archive-cmake/3.19.1 gnu/10.2 @@ -2194,7 +2348,7 @@ sems-archive-netcdf/4.4.1/exo - /nscratch/$USER/acme_scratch/boca/$CASE/run + /tscratch/$USER/acme_scratch/boca/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld @@ -2262,6 +2416,7 @@ /projects/sems/acme-boca-modulefiles/env-module acme-boca-env + aue/python/3.11.6 sems-archive-git sems-archive-cmake/3.19.1 gnu/10.3.1 @@ -2275,7 +2430,7 @@ sems-archive-netcdf/4.4.1/exo - /nscratch/$USER/acme_scratch/flight/$CASE/run + /tscratch/$USER/acme_scratch/flight/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld @@ -2306,7 +2461,7 @@ openmpi fy210162 - /gscratch/$USER/acme_scratch/ghost + /tscratch/$USER/acme_scratch/ghost /projects/ccsm/inputdata /projects/ccsm/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE @@ -2340,17 +2495,20 @@ module - sems-env - sems-git - sems-python/3.5.2 - sems-cmake - gnu/4.9.2 - sems-intel/16.0.2 - mkl/16.0 - sems-netcdf/4.4.1/exo_parallel + /projects/sems/acme-boca-modulefiles/env-module + acme-boca-env + aue/python/3.11.6 + sems-archive-git + sems-archive-cmake/3.19.1 + gnu/10.3.1 + sems-archive-intel/21.3.0 - sems-openmpi/1.10.5 + sems-archive-openmpi/4.1.4 + acme-netcdf/4.7.4/acme + + + sems-archive-netcdf/4.4.1/exo $CIME_OUTPUT_ROOT/$CASE/run @@ -2603,6 +2761,7 @@ 0 /lcrc/group/e3sm/soft/perl/chrys/lib/perl5 + $SHELL{dirname $(dirname $(which h5dump))} $SHELL{dirname $(dirname $(which nc-config))} $SHELL{dirname $(dirname $(which nf-config))} $SHELL{dirname $(dirname $(which pnetcdf_version))} @@ -2625,11 +2784,19 @@ $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/chrysalis/intel; else echo "$MOAB_ROOT"; fi} $SHELL{if [ -z "$Albany_ROOT" ]; then echo /lcrc/group/e3sm/soft/albany/2024.03.26/intel/20.0.4; else echo "$Albany_ROOT"; fi} $SHELL{if [ -z "$Trilinos_ROOT" ]; then echo /lcrc/group/e3sm/soft/trilinos/15.1.1/intel/20.0.4; else echo "$Trilinos_ROOT"; fi} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /lcrc/soft/climate/adios2/2.10.2/openmpi-4.1.6/intel-20.0.4; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /lcrc/soft/climate/c-blosc2/2.15.2/intel-20.0.4; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /lcrc/soft/climate/sz/2.1.12.5/intel-20.0.4; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /lcrc/soft/climate/zfp/1.0.1/intel-20.0.4; else echo "$ZFP_ROOT"; fi} $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/chrysalis/gnu; else echo "$MOAB_ROOT"; fi} $SHELL{if [ -z "$Albany_ROOT" ]; then echo /lcrc/group/e3sm/soft/albany/2024.03.26/gcc/9.2.0; else echo "$Albany_ROOT"; fi} $SHELL{if [ -z "$Trilinos_ROOT" ]; then echo /lcrc/group/e3sm/soft/trilinos/15.1.1/gcc/9.2.0; else echo "$Trilinos_ROOT"; fi} + $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /lcrc/soft/climate/adios2/2.10.2/openmpi-4.1.6/gcc-11.2.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$BLOSC2_ROOT" ]; then echo /lcrc/soft/climate/c-blosc2/2.15.2/gcc-11.2.0; else echo "$BLOSC2_ROOT"; fi} + $SHELL{if [ -z "$SZ_ROOT" ]; then echo /lcrc/soft/climate/sz/2.1.12.5/gcc-11.2.0; else echo "$SZ_ROOT"; fi} + $SHELL{if [ -z "$ZFP_ROOT" ]; then echo /lcrc/soft/climate/zfp/1.0.1/gcc-11.2.0; else echo "$ZFP_ROOT"; fi} @@ -3419,7 +3586,7 @@ ALCF Aurora, 10624 nodes, 2x52c SPR, 6x2s PVC, 2x512GB DDR5, 2x64GB CPU-HBM, 6x128GB GPU-HBM, Slingshot 11, PBSPro aurora-uan-.* LINUX - oneapi-ifxgpu,oneapi-ifx,gnu + oneapi-ifxgpu,oneapi-ifx mpich E3SM_Dec /lus/flare/projects/E3SM_Dec/performance_archive @@ -3435,9 +3602,9 @@ 4 pbspro e3sm - 104 - 12 - 104 + 102 + 96 + 102 12 FALSE @@ -3459,17 +3626,8 @@ module /usr/share/lmod/lmod/libexec/lmod python - cmake - - - oneapi/eng-compiler/2024.07.30.002 - - - - - - spack-pe-gcc cmake - gcc/10.3.0 + cmake/3.30.5 + oneapi/release/2025.0.5 $CIME_OUTPUT_ROOT/$CASE/run @@ -3483,9 +3641,6 @@ 131072 20 - - 1 - level_zero:gpu @@ -3507,8 +3662,7 @@ 4000MB 0 /lus/flare/projects/E3SM_Dec/tools/mpi_wrapper_utils/gpu_tile_compact.sh - list:1-8:9-16:17-24:25-32:33-40:41-48:53-60:61-68:69-76:77-84:85-92:93-100 - + list:1-8:9-16:17-24:25-32:33-40:41-48:53-60:61-68:69-76:77-84:85-92:93-100 --gpu-bind list:0.0:0.1:1.0:1.1:2.0:2.1:3.0:3.1:4.0:4.1:5.0:5.1 --mem-bind list:0:0:0:0:0:0:1:1:1:1:1:1 1 @@ -3522,12 +3676,8 @@ core - - verbose,granularity=core,balanced - 128M - - - cores + + granularity=core,balanced 128M @@ -4130,8 +4280,8 @@ gnu,intel,nvidia,amdclang mpich /lustre/scratch5/$ENV{USER}/E3SM/scratch/chicoma-cpu - /usr/projects/e3sm/inputdata - /usr/projects/e3sm/inputdata/atm/datm7 + /lustre/scratch5/$ENV{USER}/inputdata + /lustre/scratch5/$ENV{USER}/inputdata/atm/datm7 /lustre/scratch5/$ENV{USER}/E3SM/archive/$CASE /lustre/scratch5/$ENV{USER}/E3SM/input_data/ccsm_baselines/$COMPILER /usr/projects/e3sm/software/chicoma-cpu/cprnc @@ -4206,6 +4356,7 @@ PrgEnv-intel/8.5.0 intel/2023.2.0 + intel-mkl/2023.2.0 @@ -4221,7 +4372,7 @@ cray-hdf5-parallel/1.12.2.9 cray-netcdf-hdf5parallel/4.9.0.9 cray-parallel-netcdf/1.12.3.9 - cmake/3.27.7 + cmake/3.29.6 @@ -5272,95 +5423,6 @@ - - Google Cloud cluster with c2-compute-60's gcp-e3sm10 - gcp-e3sm10* - LINUX - gnu - openmpi - /home/$USER/e3sm/scratch - /home/inputdata - /home/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /home/baselines/$COMPILER - /home/tools/cprnc/cprnc - 16 - e3sm_developer - 4 - slurm - e3sm - 60 - 30 - FALSE - - srun - - --mpi=pmi2 - --label - -n {{ total_tasks }} -N {{ num_nodes }} --kill-on-bad-exit - -c $SHELL{echo `./xmlquery --value MAX_TASKS_PER_NODE`/ {{ tasks_per_node }} |bc} - $SHELL{if [ `./xmlquery --value MAX_TASKS_PER_NODE` -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} - -m plane={{ tasks_per_node }} - - - - - /usr/share/lmod/lmod/init/env_modules_python.py - /usr/share/lmod/lmod/init/sh - /usr/share/lmod/lmod/init/csh - - /usr/share/lmod/lmod/libexec/lmod python - module - module - - - /apps/spack/share/spack/modules/linux-centos7-cascadelake - gcc - openmpi - - - - gcc/12.2.0 - - - - openmpi-gcc@12.2.0 - - - - cmake - perl - perl-xml-libxml - netcdf-c-gcc@12.2.0 - netcdf-cxx-gcc@12.2.0 - netcdf-fortran-gcc@12.2.0 - parallel-netcdf-gcc@12.2.0 - hdf5-gcc@12.2.0 - netlib-lapack-gcc@12.2.0 - openblas-gcc@12.2.0 - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.2 - 0.20 - - $SHELL{dirname $(dirname $(which h5diff))} - $SHELL{dirname $(dirname $(which nc-config))} - $SHELL{dirname $(dirname $(which nf-config))} - $SHELL{dirname $(dirname $(which pnetcdf-config))} - /apps/spack/opt/spack/linux-centos7-cascadelake/gcc-12.2.0/openblas-0.3.20-nxcsxdi56nj2gxyo65iyuaecp3cbd4xd - /apps/spack/opt/spack/linux-centos7-cascadelake/gcc-12.2.0/netlib-lapack-3.10.1-xjw3q4abrpdihbyvx72em7l4wrzxm3zp - FALSE - - - - 128M - threads - - - RIKEN-CCS Fugaku: Fujitsu A64FX 48 cores/node. fn01sv.* diff --git a/cime_config/machines/config_workflow.xml b/cime_config/machines/config_workflow.xml index 85119c6e026e..9c6b5d07d075 100644 --- a/cime_config/machines/config_workflow.xml +++ b/cime_config/machines/config_workflow.xml @@ -40,7 +40,8 @@ case.run - case.get_value("PIO_TYPENAME_ATM").startswith('adios') or \ + (os.environ.get('SPIO_ENABLE_ADIOSBP2NC_CONVERSION', '').lower() in ('true', '1')) and \ + (case.get_value("PIO_TYPENAME_ATM").startswith('adios') or \ case.get_value("PIO_TYPENAME_CPL").startswith('adios') or \ case.get_value("PIO_TYPENAME_OCN").startswith('adios') or \ case.get_value("PIO_TYPENAME_WAV").startswith('adios') or \ @@ -49,7 +50,7 @@ case.get_value("PIO_TYPENAME_ROF").startswith('adios') or \ case.get_value("PIO_TYPENAME_LND").startswith('adios') or \ case.get_value("PIO_TYPENAME_ESP").startswith('adios') or \ - case.get_value("PIO_TYPENAME_IAC").startswith('adios') + case.get_value("PIO_TYPENAME_IAC").startswith('adios')) 0:30:00 diff --git a/cime_config/machines/syslog.alvarez b/cime_config/machines/syslog.alvarez-cpu similarity index 100% rename from cime_config/machines/syslog.alvarez rename to cime_config/machines/syslog.alvarez-cpu diff --git a/cime_config/machines/syslog.alvarez-gpu b/cime_config/machines/syslog.alvarez-gpu new file mode 100755 index 000000000000..e3cede7a4545 --- /dev/null +++ b/cime_config/machines/syslog.alvarez-gpu @@ -0,0 +1,94 @@ +#!/bin/csh -f +# alvarez syslog script: +# mach_syslog + +set sample_interval = $1 +set jid = $2 +set lid = $3 +set run = $4 +set timing = $5 +set dir = $6 + +# Wait until job task-to-node mapping information is output before saving output file. +# Target length was determined empirically (maximum number of lines before job mapping +# information starts + number of nodes), and it may need to be adjusted in the future. +# (Note that calling script 'touch'es the e3sm log file before spawning this script, so that 'wc' does not fail.) +set nnodes = `scontrol show jobid $jid | grep -F NumNodes | sed 's/ *NumNodes=\([0-9]*\) .*/\1/' ` +@ target_lines = 150 + $nnodes +sleep 10 +set outlth = `wc \-l $run/e3sm.log.$lid | sed 's/ *\([0-9]*\) *.*/\1/' ` +while ($outlth < $target_lines) + sleep 60 + set outlth = `wc \-l $run/e3sm.log.$lid | sed 's/ *\([0-9]*\) *.*/\1/' ` +end + +set TimeLimit = `scontrol show jobid $jid | grep -F TimeLimit | sed 's/^ *RunTime=.*TimeLimit=\([0-9]*:[0-9]*:[0-9]*\) .*/\1/' ` +set limit_hours = `echo $TimeLimit | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` +set limit_mins = `echo $TimeLimit | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` +set limit_secs = `echo $TimeLimit | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` +if ("X$limit_hours" == "X") set limit_hours = 0 +if ("X$limit_mins" == "X") set limit_mins = 0 +if ("X$limit_secs" == "X") set limit_secs = 0 +@ limit = 3600 * $limit_hours + 60 * $limit_mins + $limit_secs + +set RunTime = `scontrol show jobid $jid | grep -F RunTime | sed 's/^ *RunTime=\([0-9]*:[0-9]*:[0-9]*\) .*/\1/' ` +set runt_hours = `echo $RunTime | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` +set runt_mins = `echo $RunTime | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` +set runt_secs = `echo $RunTime | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` +if ("X$runt_hours" == "X") set runt_hours = 0 +if ("X$runt_mins" == "X") set runt_mins = 0 +if ("X$runt_secs" == "X") set runt_secs = 0 +@ runt = 3600 * $runt_hours + 60 * $runt_mins + $runt_secs + +@ remaining = $limit - $runt +cat > $run/Walltime.Remaining < $dir/squeuef.$lid.$remaining + squeue -s | grep -v -F extern > $dir/squeues.$lid.$remaining + # squeue -t R -o "%.10i %R" > $dir/squeueR.$lid.$remaining +endif + +while ($remaining > 0) + echo "Wallclock time remaining: $remaining" >> $dir/atm.log.$lid.step + grep -Fa -e "nstep" -e "model date" $run/*atm.log.$lid | tail -n 4 >> $dir/atm.log.$lid.step + echo "Wallclock time remaining: $remaining" >> $dir/lnd.log.$lid.step + grep -Fa -e "timestep" -e "model date" $run/*lnd.log.$lid | tail -n 4 >> $dir/lnd.log.$lid.step + echo "Wallclock time remaining: $remaining" >> $dir/ocn.log.$lid.step + grep -Fa -e "timestep" -e "Step number" -e "model date" $run/*ocn.log.$lid | tail -n 4 >> $dir/ocn.log.$lid.step + echo "Wallclock time remaining: $remaining" >> $dir/ice.log.$lid.step + grep -Fa -e "timestep" -e "istep" -e "model date" $run/*ice.log.$lid | tail -n 4 >> $dir/ice.log.$lid.step + echo "Wallclock time remaining: $remaining" >> $dir/rof.log.$lid.step + grep -Fa "model date" $run/*rof.log.$lid | tail -n 4 >> $dir/rof.log.$lid.step + grep -Fa "model date" $run/*cpl.log.$lid > $dir/cpl.log.$lid.step-all + echo "Wallclock time remaining: $remaining" >> $dir/cpl.log.$lid.step + tail -n 4 $dir/cpl.log.$lid.step-all >> $dir/cpl.log.$lid.step + /bin/cp --preserve=timestamps -u $timing/* $dir + # sqs -w -a | grep "^[0-9]* *R *"> $dir/sqswr.$lid.$remaining + squeue -t R -o "%.10i %.15P %.20j %.10u %.7a %.2t %.6D %.8C %.10M %.10l" > $dir/squeuef.$lid.$remaining + squeue -s | grep -v -F extern > $dir/squeues.$lid.$remaining + # squeue -t R -o "%.10i %R" > $dir/squeueR.$lid.$remaining + chmod a+r $dir/* + # sleep $sample_interval + set sleep_remaining = $sample_interval + while ($sleep_remaining > 120) + sleep 120 + @ sleep_remaining = $sleep_remaining - 120 + end + sleep $sleep_remaining + set RunTime = `scontrol show jobid $jid | grep -F RunTime | sed 's/^ *RunTime=\([0-9]*:[0-9]*:[0-9]*\) .*/\1/' ` + set runt_hours = `echo $RunTime | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set runt_mins = `echo $RunTime | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + set runt_secs = `echo $RunTime | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` + if ("X$runt_hours" == "X") set runt_hours = 0 + if ("X$runt_mins" == "X") set runt_mins = 0 + if ("X$runt_secs" == "X") set runt_secs = 0 + @ runt = 3600 * $runt_hours + 60 * $runt_mins + $runt_secs + @ remaining = $limit - $runt + cat > $run/Walltime.Remaining << EOF2 +$remaining $sample_interval +EOF2 + +end diff --git a/cime_config/testmods_dirs/allactive/nlmaps/nlmaps_check.py b/cime_config/testmods_dirs/allactive/nlmaps/nlmaps_check.py index f7dd61afb9e6..704df10d6608 100755 --- a/cime_config/testmods_dirs/allactive/nlmaps/nlmaps_check.py +++ b/cime_config/testmods_dirs/allactive/nlmaps/nlmaps_check.py @@ -69,8 +69,8 @@ def main(case_dir): if not ln_ok: # Another set of special cases that are OK. mass = abs(float(ln.split()[3])) - ln_ok = (('fin-mass 17/38' in ln and mass < 1e-34 and relerr < 1e-4) or - ('fin-mass 3/24' in ln and mass < 1e-16 and relerr < 1e-3)) + ln_ok = (('fin-mass 17/38' in ln and mass < 1e-16) or + ('fin-mass 3/24' in ln and mass < 1e-16)) if not ln_ok: special_case = False print(ln) diff --git a/cime_config/testmods_dirs/config_pes_tests.xml b/cime_config/testmods_dirs/config_pes_tests.xml index c48133653e8f..8fd0d25d361b 100644 --- a/cime_config/testmods_dirs/config_pes_tests.xml +++ b/cime_config/testmods_dirs/config_pes_tests.xml @@ -229,16 +229,16 @@ - tests+anvil: --compset GMPAS-JRA1p5-DIB-PISMF, 8 nodes + tests+anvil: --compset GMPAS-JRA1p5-DIB-PISMF, 12 nodes - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 + -12 + -12 + -12 + -12 + -12 + -12 + -12 + -12 @@ -355,7 +355,7 @@ - + GIS 20km (low-res) testing config 128 diff --git a/cime_config/tests.py b/cime_config/tests.py index ad531f60c8e6..32e995ecf5f3 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -148,6 +148,8 @@ "SMS.ne30pg2_r05_IcoswISC30E3r5_gis20.BGWCYCL1850.allactive-gis20km", "SMS.ne30pg2_r05_IcoswISC30E3r5_gis4to40.BGWCYCL1850.allactive-gis20km", "SMS.ne30_oECv3_gis.IGELM_MLI.elm-extrasnowlayers", + "ERS_Ld5.TL319_oQU240wLI_gis4to40.MPAS_FOLISIO_JRA1p5.mpaso-jra_1958", + "ERS_Ld5.TL319_oQU240wLI_ais8to30.MPAS_FOLISIO_JRA1p5.mpaso-jra_1958", ) }, @@ -268,6 +270,7 @@ "tests" : ( "SMS_Ln5.ne30pg2_r05_IcoswISC30E3r5.F2010.eam-wcprod_F2010", "SMS_Ld1.ne30pg2_r05_IcoswISC30E3r5.F20TR.eam-wcprod_F20TR", + "SMS_Lh4.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-prod", ) }, @@ -299,7 +302,6 @@ "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-freshwater_tracers", "ERS_Ld5_D.T62_oQU240.GMPAS-IAF.mpaso-conservation_check", "ERS_Ld5_PS.ne30pg2_r05_IcoswISC30E3r5.CRYO1850-DISMF.mpaso-scaled_dib_dismf", - "ERS_Ld5.TL319_oQU240wLI_gis20.MPAS_LISIO_JRA1p5.mpaso-ocn_glc_tf_coupling", "SMS_PS.ne30pg2_r05_IcoswISC30E3r5.WCYCL1850.mpaso-frazil_ice_porosity", ) }, @@ -697,24 +699,31 @@ }, "e3sm_eamxx_v1" : { - "time" : "03:00:00", - "inherit" : ("e3sm_eamxx_v1_lowres", "e3sm_eamxx_v1_medres", "e3sm_eamxx_v1_mpassi"), + "inherit" : ("e3sm_eamxx_v1_lowres", "e3sm_eamxx_v1_lowres_debug", + "e3sm_eamxx_v1_medres", "e3sm_eamxx_v1_mpassi_debug"), + }, + "e3sm_eamxx_v1_release" : { # same as e3sm_eamxx_v1 but without debug tests + "inherit" : ("e3sm_eamxx_v1_lowres", + "e3sm_eamxx_v1_medres"), }, - "e3sm_eamxx_v1_lowres" : { "time" : "01:00:00", "inherit" : ("e3sm_eamxx_mam4xx_lowres"), "tests" : ( - "ERP_D_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1", "ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.eamxx-output-preset-2", - "SMS_D_Ln9.ne4_ne4.F2010-SCREAMv1-noAero.eamxx-output-preset-3", "ERP_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-output-preset-4", - "ERS_D_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-rad_frequency_2--eamxx-output-preset-5", "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels--eamxx-output-preset-5", "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels_p3--eamxx-output-preset-5", "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels_shoc--eamxx-output-preset-5", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs", + ) + }, + "e3sm_eamxx_v1_lowres_debug" : { + "time" : "01:00:00", + "tests" : ( + "ERP_D_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1", + "SMS_D_Ln9.ne4_ne4.F2010-SCREAMv1-noAero.eamxx-output-preset-3", + "ERS_D_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-rad_frequency_2--eamxx-output-preset-5", ) }, @@ -749,6 +758,7 @@ "REP_Ld5.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-L128--eamxx-output-preset-6", "SMS.ne30pg2_EC30to60E2r2.WCYCLXX2010", "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-L128--eamxx-sl_nsubstep2", + "ERS.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-prod", ) }, @@ -760,7 +770,7 @@ ) }, - "e3sm_eamxx_v1_mpassi" : { + "e3sm_eamxx_v1_mpassi_debug" : { "time" : "01:00:00", "tests" : ( # "ERP_D_Ln9.ne4_oQU240.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off", @@ -795,25 +805,40 @@ "e3sm_eamxx_mam4xx_lowres" : { "time" : "01:00:00", "tests" : ( - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-optics", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-aci", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-wetscav", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-drydep", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-aero_microphysics", - "SMS_D_Ln5.ne30pg2_oECv3.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-remap_emiss_ne4_ne30", - "ERS.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-optics", - "ERS.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-wetscav", - "ERS.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-aero_microphysics", - "ERS.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-drydep", - "ERS.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs" + "REP_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-optics", + "REP_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-aci", + "REP_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-wetscav", + "REP_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-drydep", + "REP_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-aero_microphysics", + "REP_Ln5.ne30pg2_oECv3.F2010-EAMxx-MAM4xx.eamxx-mam4xx-remap_emiss_ne4_ne30", + "REP_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-optics", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-aci", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-wetscav", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-drydep", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-aero_microphysics", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx" + ) + }, + + "e3sm_eamxx_mam4xx_lowres_debug" : { + "time" : "01:00:00", + "tests" : ( + "SMS_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-optics", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-aci", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-wetscav", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-drydep", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx.eamxx-mam4xx-aero_microphysics", + "SMS_D_Ln5.ne30pg2_oECv3.F2010-EAMxx-MAM4xx.eamxx-mam4xx-remap_emiss_ne4_ne30", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-EAMxx-MAM4xx" ) }, "e3sm_eamxx_mam4xx_long_runtime" : { "time" : "03:00:00", "tests" : ( - "SMS_D_Lm2.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs", - "SMS_Ly1.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs" + "SMS_D_Lm2.ne4pg2_oQU480.F2010-EAMxx-MAM4xx-MPASSI", + "SMS_Ly1.ne4pg2_oQU480.F2010-EAMxx-MAM4xx" ) }, @@ -860,8 +885,10 @@ "e3sm_gpucxx" : { "tests" : ( - "SMS_Ln9.ne4pg2_ne4pg2.F2010-MMF1", - "ERP_Ln9.ne4pg2_ne4pg2.F2010-SCREAMv1", + "SMS_Ln9.ne4pg2_ne4pg2.F2010-MMF1", + "ERP_Ln9.ne4pg2_ne4pg2.F2010-SCREAMv1", + "ERS.ne4pg2_oQU480.F2010-EAMxx-MAM4xx", + "ERS.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-prod", ) }, diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index f0e6298d6850..0eacdbd35ec2 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -164,6 +164,20 @@ macro(build_model COMP_CLASS COMP_NAME) endif() endif() + #------------------------------------------------------------------------------- + # WW3 needs some special handling of files based on the switches provided + #------------------------------------------------------------------------------- + if (COMP_NAME STREQUAL "ww3") + include(${PROJECT_SOURCE_DIR}/ww3/src/ww3_utils.cmake) + # cull the sources lists based on switches + cull_sources_from_switches("${SOURCES}" "${GEN_F90_SOURCES}") + # reset the local variables based on the culled lists + set(SOURCES ${SOURCES_CULLED}) + + list(LENGTH SOURCES ORIGINAL_LENGTH) + #message(FATAL_ERROR "ORIGINAL_LENGTH=${ORIGINAL_LENGTH}") + endif() + #------------------------------------------------------------------------------- # create list of component libraries - hard-wired for current e3sm components #------------------------------------------------------------------------------- @@ -312,6 +326,22 @@ macro(build_model COMP_CLASS COMP_NAME) target_include_directories(${TARGET_NAME} PRIVATE "${PETSC_INCLUDES}") endif() endif() + if (COMP_NAME STREQUAL "ww3") + + set(WW3_SRC_DIR "${PROJECT_SOURCE_DIR}/ww3/src/WW3/model/src") + + #------------------------- + # Determine compile definitions for wav + #------------------------- + foreach(switch ${switches}) + target_compile_definitions("${TARGET_NAME}" PUBLIC W3_${switch}) + endforeach() + + set_property(SOURCE "${WW3_SRC_DIR}/w3initmd.F90" APPEND PROPERTY COMPILE_DEFINITIONS "__WW3_SWITCHES__=\'\'") + + #add_executable(ww3_ounf "${WW3_SRC_DIR}/ww3_ounf.F90") + #target_link_libraries(ww3_ounf "${TARGET_NAME}") + endif() if (USE_KOKKOS) target_link_libraries (${TARGET_NAME} PRIVATE Kokkos::kokkos) endif () diff --git a/components/cmake/modules/FindHDF5.cmake b/components/cmake/modules/FindHDF5.cmake new file mode 100644 index 000000000000..cf1abe60efec --- /dev/null +++ b/components/cmake/modules/FindHDF5.cmake @@ -0,0 +1,46 @@ +# - Try to find HDF5 +# +# CMake's built-in FindHDF5 module may fail with certain compilers, so +# we provide a custom module that avoids relying on compiler wrappers. +# +# Once done, this will define: +# +# The "hdf5" target +# + +if (TARGET hdf5) + return() +endif() + +set(HDF5_ROOT $ENV{HDF5_ROOT}) + +if (NOT EXISTS "${HDF5_ROOT}/lib" AND NOT EXISTS "${HDF5_ROOT}/lib64") + message(FATAL_ERROR "HDF5_ROOT does not contain a lib or lib64 directory") +endif() + +# Preserve original CMake find library suffixes +set(ORIGINAL_CMAKE_FIND_LIBRARY_SUFFIXES "${CMAKE_FIND_LIBRARY_SUFFIXES}") + +if (HDF5_USE_STATIC_LIBRARIES) + set(CMAKE_FIND_LIBRARY_SUFFIXES .a) +else() + set(CMAKE_FIND_LIBRARY_SUFFIXES .so .a) +endif() + +find_library(HDF5_LIBRARIES NAMES hdf5 HINTS "${HDF5_ROOT}/lib" "${HDF5_ROOT}/lib64") +find_library(HDF5_HL_LIBRARIES NAMES hdf5_hl HINTS "${HDF5_ROOT}/lib" "${HDF5_ROOT}/lib64") + +# Restore original CMake find library suffixes +set(CMAKE_FIND_LIBRARY_SUFFIXES "${ORIGINAL_CMAKE_FIND_LIBRARY_SUFFIXES}") + +if (NOT EXISTS "${HDF5_ROOT}/include") + message(FATAL_ERROR "HDF5_ROOT does not contain an include directory") +endif() + +find_path(HDF5_INCLUDE_DIR hdf5.h HINTS "${HDF5_ROOT}/include") + +# Create the interface library, and set target properties +# For static libraries, link with HDF5_HL_LIBRARIES before HDF5_LIBRARIES +add_library(hdf5 INTERFACE) +target_link_libraries(hdf5 INTERFACE ${HDF5_HL_LIBRARIES} ${HDF5_LIBRARIES}) +target_include_directories(hdf5 INTERFACE "${HDF5_INCLUDE_DIR}") diff --git a/components/cmake/modules/FindPIO.cmake b/components/cmake/modules/FindPIO.cmake index 5589dff0ed04..a8d4e3ff6ee2 100644 --- a/components/cmake/modules/FindPIO.cmake +++ b/components/cmake/modules/FindPIO.cmake @@ -35,7 +35,7 @@ if (DEFINED ENV{HDF5_ROOT}) if (DEFINED ENV{HDF5_USE_STATIC_LIBRARIES}) set(HDF5_USE_STATIC_LIBRARIES On) endif() - find_package(HDF5 REQUIRED COMPONENTS C HL) + find_package(HDF5 REQUIRED) endif() # Not all machines/PIO installations use ADIOS but, for now, @@ -60,7 +60,7 @@ else() endif() if (DEFINED ENV{HDF5_ROOT}) - list(APPEND PIOLIBS ${HDF5_HL_LIBRARIES} ${HDF5_LIBRARIES}) + list(APPEND PIOLIBS hdf5) endif() # Create the interface library, and set target properties diff --git a/components/eam/cime_config/config_pes.xml b/components/eam/cime_config/config_pes.xml index 7913a4e9c453..bb287efcf4d9 100644 --- a/components/eam/cime_config/config_pes.xml +++ b/components/eam/cime_config/config_pes.xml @@ -140,7 +140,7 @@ - + eam: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0 @@ -170,21 +170,6 @@ - - - eam+gcp: default - - 30 - 30 - 30 - 16 - 16 - 16 - 30 - 30 - - - eam+lawrencium-lr3: default, 2 nodes @@ -293,7 +278,7 @@ - + pm-cpu: any compset on ne4pg2 grid @@ -843,32 +828,7 @@ - - - - gcp10 -compset A_WCYCL* -res ne30pg2_oECv3 or ne30pg2_r05_EC30to60E2r2 without MPASO on 8 nodes - - 240 - 240 - 240 - 240 - 240 - 240 - - - 2 - 2 - 2 - 2 - 2 - 1 - - - - + @@ -922,7 +882,7 @@ - + pm-cpu: ne30pg2_r05_IcoswISC30E3r5, 1 node, 128x1 128 @@ -1209,7 +1169,7 @@ - + --res conusx4v1_r05_oECv3 --compset F2010 @@ -1222,7 +1182,7 @@ - + pm-cpu/gcp: eam, 2 nodes: --res conusx4v1_r05_oECv3 --compset F2010 @@ -1285,7 +1245,7 @@ - + pm-cpu: ne120pg2 F-compset with MPASSI on 43 nodes 128x1 ~1 sypd 128 diff --git a/components/eam/docs/tech-guide/zm.md b/components/eam/docs/tech-guide/zm.md index 2e3c5b9b6070..f710195145b3 100644 --- a/components/eam/docs/tech-guide/zm.md +++ b/components/eam/docs/tech-guide/zm.md @@ -14,7 +14,7 @@ The convective microphysics scheme is based on the work of Song and Zhang (2011) ### Mass flux adjustment -The convective mass flux adjustment (MAdj) is designed to represent the dynamical effects of large-scale vertical motion on convection. With MAdj, convection is enhanced (suppressed) when there is large-scale ascending (descending) motion at the planetary boundary layer top. The coupling of convection with the large-scale circulation significantly improves the simulation of climate variability across multiple scales from diurnal cycle, convectively coupled equatorial waves, to Madden-Julian oscillations (Song et al., 2023).[@song_incorporating_2023] +The convective mass flux adjustment (MAdj) is designed to represent the dynamical effects of large-scale vertical motion on convection. With MAdj, convection is enhanced (suppressed) when there is large-scale ascending (descending) motion at the planetary boundary layer top. The coupling of convection with the large-scale circulation significantly improves the simulation of internal variability across multiple scales from diurnal cycle, convectively coupled equatorial waves, to Madden-Julian oscillations (Song et al., 2023).[@song_incorporating_2023] ### MCSP diff --git a/components/eam/src/physics/cam/conditional_diag_main.F90 b/components/eam/src/physics/cam/conditional_diag_main.F90 index c683354b83fd..2a92d1485684 100644 --- a/components/eam/src/physics/cam/conditional_diag_main.F90 +++ b/components/eam/src/physics/cam/conditional_diag_main.F90 @@ -380,7 +380,7 @@ end subroutine apply_masking !======================================================== subroutine get_values( arrayout, varname, state, pbuf, cam_in, cam_out ) - use ppgrid, only: pcols,pver + use ppgrid, only: pcols,pver,pverp use physics_types, only: physics_state use camsrfexch, only: cam_in_t, cam_out_t use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field @@ -595,14 +595,14 @@ subroutine get_values( arrayout, varname, state, pbuf, cam_in, cam_out ) arrayout(:ncol,:) ) ! out case ('CAPE') - call compute_cape_diags( state, pbuf, pcols, pver, cape ) ! 4xin, 1xout + call compute_cape_diags( state, pbuf, pcols, pver, pverp, cape ) ! 5xin, 1xout arrayout(:,1) = cape(:) case ('dCAPE') arrayout(:,:) = 0._r8 - call compute_cape_diags( state, pbuf, pcols, pver, cape, dcape ) ! 4xin, 2xout + call compute_cape_diags( state, pbuf, pcols, pver, pverp, cape, dcape ) ! 5xin, 2xout arrayout(:,1:3) = dcape(:,1:3) ! 1=dCAPE, 2=dCAPEp, 3=dCAPEe diff --git a/components/eam/src/physics/cam/gw/gw_common.F90 b/components/eam/src/physics/cam/gw/gw_common.F90 index 100d6611ebb3..75ee0f89bfff 100644 --- a/components/eam/src/physics/cam/gw/gw_common.F90 +++ b/components/eam/src/physics/cam/gw/gw_common.F90 @@ -4,7 +4,7 @@ module gw_common ! This module contains code common to different gravity wave ! parameterizations. ! -use gw_utils, only: r8 +use gw_utils, only: r8, btype implicit none private @@ -27,9 +27,15 @@ module gw_common public :: gravit public :: rair +! These only need to be public for unit testing +public :: gwd_compute_stress_profiles_and_diffusivities +public :: gwd_project_tau +public :: gwd_compute_tendencies_from_stress_divergence +public :: gwd_precalc_rhoi + ! This flag preserves answers for vanilla CAM by making a few changes (e.g. ! order of operations) when only orographic waves are on. -logical, public :: orographic_only = .false. +logical(btype), public :: orographic_only = .false. ! Number of levels in the atmosphere. integer, protected :: pver = 0 @@ -45,11 +51,11 @@ module gw_common ! Whether or not molecular diffusion is being done, and bottom level where ! it is done. -logical, protected :: do_molec_diff = .false. +logical(btype), protected :: do_molec_diff = .false. integer, protected :: nbot_molec = huge(1) ! Whether or not to enforce an upper boundary condition of tau = 0. -logical :: tau_0_ubc = .false. +logical(btype) :: tau_0_ubc = .false. ! Index the cardinal directions. integer, parameter :: west = 1 @@ -107,15 +113,16 @@ module gw_common !========================================================================== subroutine gw_common_init(pver_in, pgwv_in, dc_in, cref_in, & - do_molec_diff_in, tau_0_ubc_in, nbot_molec_in, ktop_in, kbotbg_in, & + orographic_only_in, do_molec_diff_in, tau_0_ubc_in, nbot_molec_in, ktop_in, kbotbg_in, & fcrit2_in, kwv_in, gravit_in, rair_in, alpha_in, errstring) integer, intent(in) :: pver_in integer, intent(in) :: pgwv_in real(r8), intent(in) :: dc_in real(r8), intent(in) :: cref_in(-pgwv_in:) - logical, intent(in) :: do_molec_diff_in - logical, intent(in) :: tau_0_ubc_in + logical(btype), intent(in) :: orographic_only_in + logical(btype), intent(in) :: do_molec_diff_in + logical(btype), intent(in) :: tau_0_ubc_in integer, intent(in) :: nbot_molec_in integer, intent(in) :: ktop_in integer, intent(in) :: kbotbg_in @@ -137,6 +144,7 @@ subroutine gw_common_init(pver_in, pgwv_in, dc_in, cref_in, & allocate(cref(-pgwv:pgwv), stat=ierr, errmsg=errstring) if (ierr /= 0) return cref = cref_in + orographic_only = orographic_only_in do_molec_diff = do_molec_diff_in tau_0_ubc = tau_0_ubc_in nbot_molec = nbot_molec_in @@ -544,7 +552,7 @@ subroutine gwd_compute_tendencies_from_stress_divergence(ncol, ngwv, do_taper, d integer, intent(in) :: ncol, ngwv ! Whether or not to apply the polar taper. - logical, intent(in) :: do_taper + logical(btype), intent(in) :: do_taper ! Time step. real(r8), intent(in) :: dt ! Tendency efficiency. @@ -744,10 +752,8 @@ subroutine gwd_precalc_rhoi(ncol, ngwv, dt, tend_level, pmid, pint, t, gwut, ubm ! Calculate tendency on each constituent. do m = 1, size(q,3) - call gw_diff_tend(ncol, pver, kbotbg, ktop, q(:,:,m), dt, & decomp, qtgw(:,:,m)) - enddo ! Calculate tendency from diffusing dry static energy (dttdf). @@ -799,7 +805,7 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & ! wave propagation up to a certain level, but then allow wind tendencies ! and adjustments to tau below that level. ! Whether or not to apply the polar taper. - logical, intent(in) :: do_taper + logical(btype), intent(in) :: do_taper ! Time step. real(r8), intent(in) :: dt @@ -857,7 +863,6 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & !------------------------------------------------------------------------ ! Initialize gravity wave drag tendencies to zero. - utgw = 0._r8 vtgw = 0._r8 taucd = 0._r8 diff --git a/components/eam/src/physics/cam/gw/gw_convect.F90 b/components/eam/src/physics/cam/gw/gw_convect.F90 index f86c87bdf820..8e3027e33442 100644 --- a/components/eam/src/physics/cam/gw/gw_convect.F90 +++ b/components/eam/src/physics/cam/gw/gw_convect.F90 @@ -4,9 +4,11 @@ module gw_convect ! This module handles gravity waves from convection, and was extracted from ! gw_drag in May 2013. ! +#ifndef SCREAM_CONFIG_IS_CMAKE use cam_logfile, only: iulog use spmd_utils, only: masterproc -use gw_utils, only: r8 +#endif +use gw_utils, only: r8, btype use gw_common, only: pver, pgwv implicit none @@ -32,7 +34,10 @@ module gw_convect !========================================================================== subroutine gw_convect_init( plev_src_wind, mfcc_in, errstring) + ! Need to figure out what to do about pref_edge +#ifndef SCREAM_CONFIG_IS_CMAKE use ref_pres, only: pref_edge +#endif real(r8), intent(in) :: plev_src_wind ! reference pressure value [Pa] to set k_src_wind (previously hardcoded to 70000._r8) real(r8), intent(in) :: mfcc_in(:,:,:) ! Source spectra to keep as table character(len=*), intent(out) :: errstring ! Report any errors from this routine @@ -41,11 +46,15 @@ subroutine gw_convect_init( plev_src_wind, mfcc_in, errstring) errstring = "" +#ifndef SCREAM_CONFIG_IS_CMAKE do k = 0, pver if ( pref_edge(k+1) < plev_src_wind ) k_src_wind = k+1 - end do + end do +#endif +#ifndef SCREAM_CONFIG_IS_CMAKE if (masterproc) write (iulog,*) 'gw_convect: steering flow level = ',k_src_wind +#endif ! First dimension is maxh. maxh = size(mfcc_in,1) @@ -60,121 +69,29 @@ end subroutine gw_convect_init !========================================================================== -subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & - zm, src_level, tend_level, tau, ubm, ubi, xv, yv, c, & - hdepth, maxq0_out, maxq0_conversion_factor, hdepth_scaling_factor, & - hdepth_min, storm_speed_min, & - use_gw_convect_old) -!----------------------------------------------------------------------- -! Driver for multiple gravity wave drag parameterization. -! -! The parameterization is assumed to operate only where water vapor -! concentrations are negligible in determining the density. -! -! Beres, J.H., M.J. Alexander, and J.R. Holton, 2004: "A method of -! specifying the gravity wave spectrum above convection based on latent -! heating properties and background wind". J. Atmos. Sci., Vol 61, No. 3, -! pp. 324-337. -! -!----------------------------------------------------------------------- - use gw_common, only: dc, cref +subroutine gw_convect_project_winds(ncol, u, v, xv, yv, ubm, ubi) + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp -!------------------------------Arguments-------------------------------- - ! Column and gravity wave spectrum dimensions. - integer, intent(in) :: ncol, ngwv - ! Column latitudes [rad]. - real(r8), intent(in) :: lat(ncol) + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol ! Midpoint zonal/meridional winds. real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) - ! Heating rate due to convection. - real(r8), intent(in) :: netdt(:,:) - ! Midpoint altitudes. - real(r8), intent(in) :: zm(ncol,pver) - - ! Heating conversion factor - real(r8), intent(in) :: maxq0_conversion_factor - - ! Scaling factor for the heating depth - real(r8), intent(in) :: hdepth_scaling_factor - - ! minimum hdepth for for spectrum lookup table - real(r8), intent(in) :: hdepth_min - - ! minimum convective storm speed - real(r8), intent(in) :: storm_speed_min - - ! switch for restoring legacy method - logical, intent(in) :: use_gw_convect_old - - ! Indices of top gravity wave source level and lowest level where wind - ! tendencies are allowed. - integer, intent(out) :: src_level(ncol) - integer, intent(out) :: tend_level(ncol) - ! Wave Reynolds stress. - real(r8), intent(out) :: tau(ncol,-pgwv:pgwv,0:pver) - ! Projection of wind at midpoints and interfaces. - real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,0:pver) ! Unit vectors of source wind (zonal and meridional components). real(r8), intent(out) :: xv(ncol), yv(ncol) - ! Phase speeds. - real(r8), intent(out) :: c(ncol,-pgwv:pgwv) - ! Heating depth and maximum heating in each column. - real(r8), intent(out) :: hdepth(ncol), maxq0_out(ncol) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,0:pver) -!---------------------------Local Storage------------------------------- - ! Column and level indices. - integer :: i, k + !---------------------------Local Storage------------------------------- + ! level indices. + integer :: k ! Zonal/meridional source wind real(r8) :: u_src(ncol), v_src(ncol) - ! 3.14... - real(r8), parameter :: pi = 4._r8*atan(1._r8) - - ! Maximum heating rate. - real(r8) :: maxq0(ncol) - - ! Bottom/top heating range index. - integer :: mini(ncol), maxi(ncol) - ! Min/max wavenumber for critical level filtering. - integer :: Umini,Umaxi - ! Mean wind in heating region. - real(r8) :: uh(ncol) - ! Min/max projected wind value in each column. - real(r8) :: Umin(ncol), Umax(ncol) - ! Source level tau for a column. - real(r8) :: tau0(-PGWV:PGWV) - ! Speed of convective cells relative to storm. - integer :: storm_speed(ncol) - ! Index to shift spectra relative to ground. - integer :: shift - - ! fixed parameters (we may want to expose these in the namelist for tuning) - real(r8), parameter :: tau_avg_length = 100e3 ! spectrum averaging length [m] - real(r8), parameter :: heating_altitude_max = 20e3 ! max altitude [m] to check for max heating - - ! note: the heating_altitude_max is probably not needed because there is - ! rarely any convective heating above this level and the performance impact - ! of skipping the iteration over higher levels is likely negilible. - - integer :: ndepth_pos - integer :: ndepth_tot - - !---------------------------------------------------------------------- - ! Initialize tau array - !---------------------------------------------------------------------- - - tau = 0.0_r8 - hdepth = 0.0_r8 - maxq0 = 0.0_r8 - tau0 = 0.0_r8 - - !------------------------------------------------------------------------ - ! Determine source layer wind and unit vectors, then project winds. - !------------------------------------------------------------------------ ! source wind speed and direction u_src = u(:,k_src_wind) @@ -194,6 +111,13 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & ubi(:,1:pver-1) = midpoint_interp(ubm) +end subroutine gw_convect_project_winds + +!========================================================================== + +subroutine gw_heating_depth(ncol, maxq0_conversion_factor, hdepth_scaling_factor, & + use_gw_convect_old, zm, netdt, mini, maxi, hdepth, maxq0_out, maxq0) + !----------------------------------------------------------------------- ! Calculate heating depth. ! @@ -201,61 +125,95 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & ! which heating rate is continuously positive. !----------------------------------------------------------------------- + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol + + ! Heating conversion factor + real(r8), intent(in) :: maxq0_conversion_factor + + ! Scaling factor for the heating depth + real(r8), intent(in) :: hdepth_scaling_factor + + ! switch for restoring legacy method + logical(btype), intent(in) :: use_gw_convect_old + + ! Midpoint altitudes. + real(r8), intent(in) :: zm(ncol,pver) + + ! Heating rate due to convection. + real(r8), intent(in) :: netdt(:,:) + + ! Bottom/top heating range index. + integer, intent(out) :: mini(ncol), maxi(ncol) + + ! Heating depth and maximum heating in each column. + real(r8), intent(out) :: hdepth(ncol), maxq0_out(ncol) + + ! Maximum heating rate. + real(r8), intent(out) :: maxq0(ncol) + + !---------------------------Local Storage------------------------------- + real(r8), parameter :: heating_altitude_max = 20e3 ! max altitude [m] to check for max heating + + ! Column and level indices. + integer :: i, k + ! Find indices for the top and bottom of the heating range. mini = 0 maxi = 0 if (use_gw_convect_old) then - !--------------------------------------------------------------------- - ! original version used in CAM4/5/6 and EAMv1/2/3 - do k = pver, 1, -1 - do i = 1, ncol - if (mini(i) == 0) then - ! Detect if we are outside the maximum range (where z = 20 km). - if (zm(i,k) >= heating_altitude_max) then - mini(i) = k - maxi(i) = k - else - ! First spot where heating rate is positive. - if (netdt(i,k) > 0.0_r8) mini(i) = k - end if - else if (maxi(i) == 0) then - ! Detect if we are outside the maximum range (z = 20 km). - if (zm(i,k) >= heating_altitude_max) then - maxi(i) = k - else - ! First spot where heating rate is no longer positive. - if (.not. (netdt(i,k) > 0.0_r8)) maxi(i) = k - end if - end if - end do - ! When all done, exit - if (all(maxi /= 0)) exit - end do - !--------------------------------------------------------------------- + !--------------------------------------------------------------------- + ! original version used in CAM4/5/6 and EAMv1/2/3 + do k = pver, 1, -1 + do i = 1, ncol + if (mini(i) == 0) then + ! Detect if we are outside the maximum range (where z = 20 km). + if (zm(i,k) >= heating_altitude_max) then + mini(i) = k + maxi(i) = k + else + ! First spot where heating rate is positive. + if (netdt(i,k) > 0.0_r8) mini(i) = k + end if + else if (maxi(i) == 0) then + ! Detect if we are outside the maximum range (z = 20 km). + if (zm(i,k) >= heating_altitude_max) then + maxi(i) = k + else + ! First spot where heating rate is no longer positive. + if (.not. (netdt(i,k) > 0.0_r8)) maxi(i) = k + end if + end if + end do + ! When all done, exit + if (all(maxi /= 0)) exit + end do + !--------------------------------------------------------------------- else - !--------------------------------------------------------------------- - ! cleaner version that addresses bug in original where heating max and - ! depth were too low whenever heating <=0 occurred in the middle of - ! the heating profile (ex. at the melting level) - do i = 1, ncol - do k = pver, 1, -1 - if ( zm(i,k) < heating_altitude_max ) then - if ( netdt(i,k) > 0.0_r8 ) then - ! Set mini as first spot where heating rate is positive - if ( mini(i)==0 ) mini(i) = k - ! Set maxi to current level - maxi(i) = k - end if - else - ! above the max check if indices were found - if ( mini(i)==0 ) mini(i) = k - if ( maxi(i)==0 ) maxi(i) = k - end if - end do - end do - !--------------------------------------------------------------------- - end if + !--------------------------------------------------------------------- + ! cleaner version that addresses bug in original where heating max and + ! depth were too low whenever heating <=0 occurred in the middle of + ! the heating profile (ex. at the melting level) + do i = 1, ncol + do k = pver, 1, -1 + if ( zm(i,k) < heating_altitude_max ) then + if ( netdt(i,k) > 0.0_r8 ) then + ! Set mini as first spot where heating rate is positive + if ( mini(i)==0 ) mini(i) = k + ! Set maxi to current level + maxi(i) = k + end if + else + ! above the max check if indices were found + if ( mini(i)==0 ) mini(i) = k + if ( maxi(i)==0 ) maxi(i) = k + end if + end do + end do + !--------------------------------------------------------------------- + end if ! Heating depth in km. @@ -274,13 +232,46 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & end do !output max heating rate in K/day - maxq0_out = maxq0*24._r8*3600._r8 + maxq0_out = maxq0 * 24._r8 * 3600._r8 ! Multipy by conversion factor maxq0 = maxq0 * maxq0_conversion_factor - ! Taking ubm at assumed source level to be the storm speed, - ! find the cell speed where the storm speed is > storm_speed_min +end subroutine gw_heating_depth + +!========================================================================== + +subroutine gw_storm_speed(ncol, storm_speed_min, ubm, mini, maxi, & + storm_speed, uh, Umin, Umax) + + use gw_common, only: dc + + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol + + ! minimum convective storm speed + real(r8), intent(in) :: storm_speed_min + + ! Projection of wind at midpoints and interfaces. + real(r8), intent(in) :: ubm(ncol,pver) + + ! Bottom/top heating range index. + integer, intent(in) :: mini(ncol), maxi(ncol) + + ! Speed of convective cells relative to storm. + integer, intent(out) :: storm_speed(ncol) + + ! Mean wind in heating region. + real(r8), intent(out) :: uh(ncol) + + ! Min/max projected wind value in each column. + real(r8), intent(out) :: Umin(ncol), Umax(ncol) + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: k + storm_speed = int(sign(max(abs(ubm(:,k_src_wind))-storm_speed_min, 0._r8), ubm(:,k_src_wind))) uh = 0._r8 @@ -306,11 +297,72 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & end where end do - !----------------------------------------------------------------------- - ! Gravity wave sources - !----------------------------------------------------------------------- - ! Start loop over all columns. - !----------------------------------------------------------------------- +end subroutine gw_storm_speed + +!========================================================================== + +subroutine gw_convect_gw_sources(ncol, ngwv, lat, hdepth_min, hdepth, mini, maxi, netdt, uh, storm_speed, & + maxq0, Umin, Umax, tau) + + use gw_common, only: dc + + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol, ngwv + + ! Column latitudes [rad]. + real(r8), intent(in) :: lat(ncol) + + ! minimum hdepth for for spectrum lookup table + real(r8), intent(in) :: hdepth_min + + ! Heating depth and maximum heating in each column. + real(r8), intent(in) :: hdepth(ncol) + + ! Bottom/top heating range index. + integer, intent(in) :: mini(ncol), maxi(ncol) + + ! Heating rate due to convection. + real(r8), intent(in) :: netdt(:,:) + + ! Mean wind in heating region. + real(r8), intent(in) :: uh(ncol) + + ! Speed of convective cells relative to storm. + integer, intent(in) :: storm_speed(ncol) + + ! Maximum heating rate. + real(r8), intent(in) :: maxq0(ncol) + + ! Min/max projected wind value in each column. + real(r8), intent(in) :: Umin(ncol), Umax(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-pgwv:pgwv,0:pver) + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k + + integer :: ndepth_pos, ndepth_tot + + ! Min/max wavenumber for critical level filtering. + integer :: Umini,Umaxi + + ! Index to shift spectra relative to ground. + integer :: shift + + ! 3.14... + real(r8), parameter :: pi = 4._r8*atan(1._r8) + + ! fixed parameters (we may want to expose these in the namelist for tuning) + real(r8), parameter :: tau_avg_length = 100e3 ! spectrum averaging length [m] + + ! Source level tau for a column. + real(r8) :: tau0(-PGWV:PGWV) + + tau0 = 0.0_r8 + do i=1,ncol !--------------------------------------------------------------------- @@ -357,9 +409,124 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & enddo +end subroutine gw_convect_gw_sources + +subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & + zm, src_level, tend_level, tau, ubm, ubi, xv, yv, c, & + hdepth, maxq0_out, maxq0_conversion_factor, hdepth_scaling_factor, & + hdepth_min, storm_speed_min, & + use_gw_convect_old) +!----------------------------------------------------------------------- +! Driver for multiple gravity wave drag parameterization. +! +! The parameterization is assumed to operate only where water vapor +! concentrations are negligible in determining the density. +! +! Beres, J.H., M.J. Alexander, and J.R. Holton, 2004: "A method of +! specifying the gravity wave spectrum above convection based on latent +! heating properties and background wind". J. Atmos. Sci., Vol 61, No. 3, +! pp. 324-337. +! +!----------------------------------------------------------------------- + use gw_common, only: cref + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol, ngwv + + ! Column latitudes [rad]. + real(r8), intent(in) :: lat(ncol) + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Heating rate due to convection. + real(r8), intent(in) :: netdt(:,:) + ! Midpoint altitudes. + real(r8), intent(in) :: zm(ncol,pver) + + ! Heating conversion factor + real(r8), intent(in) :: maxq0_conversion_factor + + ! Scaling factor for the heating depth + real(r8), intent(in) :: hdepth_scaling_factor + + ! minimum hdepth for for spectrum lookup table + real(r8), intent(in) :: hdepth_min + + ! minimum convective storm speed + real(r8), intent(in) :: storm_speed_min + + ! switch for restoring legacy method + logical(btype), intent(in) :: use_gw_convect_old + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-pgwv:pgwv,0:pver) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,0:pver) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-pgwv:pgwv) + + ! Heating depth and maximum heating in each column. + real(r8), intent(out) :: hdepth(ncol), maxq0_out(ncol) + + !---------------------------Local Storage------------------------------- + ! Maximum heating rate. + real(r8) :: maxq0(ncol) + + ! Bottom/top heating range index. + integer :: mini(ncol), maxi(ncol) + ! Mean wind in heating region. + real(r8) :: uh(ncol) + ! Min/max projected wind value in each column. + real(r8) :: Umin(ncol), Umax(ncol) + ! Speed of convective cells relative to storm. + integer :: storm_speed(ncol) + + ! note: the heating_altitude_max is probably not needed because there is + ! rarely any convective heating above this level and the performance impact + ! of skipping the iteration over higher levels is likely negilible. + + !---------------------------------------------------------------------- + ! Initialize tau array + !---------------------------------------------------------------------- + + tau = 0.0_r8 + hdepth = 0.0_r8 + maxq0 = 0.0_r8 + + !------------------------------------------------------------------------ + ! Determine source layer wind and unit vectors, then project winds. + !------------------------------------------------------------------------ + + call gw_convect_project_winds(ncol, u, v, xv, yv, ubm, ubi) + + !----------------------------------------------------------------------- + ! Calculate heating depth. + ! + ! Heating depth is defined as the first height range from the bottom in + ! which heating rate is continuously positive. + !----------------------------------------------------------------------- + call gw_heating_depth(ncol, maxq0_conversion_factor, hdepth_scaling_factor, & + use_gw_convect_old, zm, netdt, mini, maxi, hdepth, maxq0_out, maxq0) + + !----------------------------------------------------------------------- + ! Taking ubm at assumed source level to be the storm speed, + ! find the cell speed where the storm speed is > storm_speed_min !----------------------------------------------------------------------- - ! End loop over all columns. + call gw_storm_speed(ncol, storm_speed_min, ubm, mini, maxi, & + storm_speed, uh, Umin, Umax) + + !----------------------------------------------------------------------- + ! Gravity wave sources !----------------------------------------------------------------------- + call gw_convect_gw_sources(ncol, ngwv, lat, hdepth_min, hdepth, mini, maxi, netdt, uh, storm_speed, & + maxq0, Umin, Umax, tau) ! Output the source level. src_level = maxi diff --git a/components/eam/src/physics/cam/gw/gw_diffusion.F90 b/components/eam/src/physics/cam/gw/gw_diffusion.F90 index 0d6e9bfb3a5e..2a1706d5a426 100644 --- a/components/eam/src/physics/cam/gw/gw_diffusion.F90 +++ b/components/eam/src/physics/cam/gw/gw_diffusion.F90 @@ -121,7 +121,6 @@ subroutine gw_ediff(ncol, pver, ngwv, kbot, ktop, tend_level, & ! in vd_lu_decomp they are expected as midpoints. call vd_lu_decomp(ncol, pver, ncol, & zero, egwdffi, tmpi2, rdpm, dt, gravit, zero, ktop+1, kbot+1, decomp) - end subroutine gw_ediff !========================================================================== @@ -149,7 +148,6 @@ subroutine gw_diff_tend(ncol, pver, kbot, ktop, q, dt, decomp, dq) ! ! Author: Sassi - Jan 2001 !-------------------------------------------------------------------------- - use vdiff_lu_solver, only: vd_lu_solve !---------------------------Input Arguments-------------------------------- @@ -189,7 +187,6 @@ subroutine gw_diff_tend(ncol, pver, kbot, ktop, q, dt, decomp, dq) ! Evaluate tendency to be reported back. dq = (qnew-q) / dt - end subroutine gw_diff_tend end module gw_diffusion diff --git a/components/eam/src/physics/cam/gw/gw_drag.F90 b/components/eam/src/physics/cam/gw/gw_drag.F90 index 72c7008f3e2e..2d01dbc1ac5f 100644 --- a/components/eam/src/physics/cam/gw/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw/gw_drag.F90 @@ -234,7 +234,7 @@ subroutine gw_init(pbuf2d) use ref_pres, only: pref_edge use physconst, only: gravit, rair - use gw_common, only: gw_common_init, orographic_only + use gw_common, only: gw_common_init use gw_oro, only: gw_oro_init use gw_front, only: gw_front_init use gw_convect, only: gw_convect_init @@ -263,6 +263,10 @@ subroutine gw_init(pbuf2d) ! Interpolated Newtonian cooling coefficients. real(r8) :: alpha(0:pver) + ! This flag preserves answers for vanilla CAM by making a few changes (e.g. + ! order of operations) when only orographic waves are on. + logical :: orographic_only + ! Levels of pre-calculated Newtonian cooling (1/day). integer, parameter :: nalph=66 real(r8) :: alpha0(nalph) = [ & @@ -385,7 +389,7 @@ subroutine gw_init(pbuf2d) history_amwg_out = history_amwg ) ! Initialize subordinate modules. - call gw_common_init(pver, pgwv, dc, cref, do_molec_diff, tau_0_ubc, & + call gw_common_init(pver, pgwv, dc, cref, orographic_only, do_molec_diff, tau_0_ubc, & nbot_molec, ktop, kbotbg, fcrit2, kwv, gravit, rair, alpha, & errstring) if (trim(errstring) /= "") call endrun("gw_common_init: "//errstring) diff --git a/components/eam/src/physics/cam/gw/gw_front.F90 b/components/eam/src/physics/cam/gw/gw_front.F90 index c1c8d81cadcd..a2f44523fb8c 100644 --- a/components/eam/src/physics/cam/gw/gw_front.F90 +++ b/components/eam/src/physics/cam/gw/gw_front.F90 @@ -5,7 +5,7 @@ module gw_front ! from gw_drag in May 2013. ! -use gw_utils, only: r8 +use gw_utils, only: r8, btype use gw_common, only: pver, pgwv, cref implicit none @@ -15,6 +15,10 @@ module gw_front public :: gw_front_init public :: gw_cm_src +! Only public for testing +public :: gw_front_project_winds +public :: gw_front_gw_sources + ! Tuneable settings. ! Frontogenesis function critical threshold. @@ -87,60 +91,35 @@ subroutine gw_front_init(taubgnd, frontgfc_in, kfront_in, errstring) end subroutine gw_front_init !========================================================================== -subroutine gw_cm_src(ncol, ngwv, kbot, u, v, frontgf, & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) +subroutine gw_front_project_winds(ncol, kbot, u, v, xv, yv, ubm, ubi) + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp - !----------------------------------------------------------------------- - ! Driver for multiple gravity wave drag parameterization. - ! - ! The parameterization is assumed to operate only where water vapor - ! concentrations are negligible in determining the density. - !----------------------------------------------------------------------- !------------------------------Arguments-------------------------------- ! Column and gravity wave spectrum dimensions. - integer, intent(in) :: ncol, ngwv + integer, intent(in) :: ncol ! Index of source interface. integer, intent(in) :: kbot ! Midpoint zonal/meridional winds. real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) - ! Frontogenesis function. - real(r8), intent(in) :: frontgf(:,:) - ! Indices of top gravity wave source level and lowest level where wind - ! tendencies are allowed. - integer, intent(out) :: src_level(ncol) - integer, intent(out) :: tend_level(ncol) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) - ! Wave Reynolds stress. - real(r8), intent(out) :: tau(ncol,-pgwv:pgwv,0:pver) ! Projection of wind at midpoints and interfaces. real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,0:pver) - ! Unit vectors of source wind (zonal and meridional components). - real(r8), intent(out) :: xv(ncol), yv(ncol) - ! Phase speeds. - real(r8), intent(out) :: c(ncol,-pgwv:pgwv) !---------------------------Local Storage------------------------------- ! Column and wavenumber indices. - integer :: k, l - - ! Whether or not to launch waves in this column. - logical :: launch_wave(ncol) + integer :: k ! Zonal/meridional wind averaged over source region. real(r8) :: usrc(ncol), vsrc(ncol) - !------------------------------------------------------------------------ - ! Determine the source layer wind and unit vectors, then project winds. - !------------------------------------------------------------------------ - ! Just use the source level interface values for the source wind speed ! and direction (unit vector). - src_level = kbot - tend_level = kbot usrc = 0.5_r8*(u(:,kbot+1)+u(:,kbot)) vsrc = 0.5_r8*(v(:,kbot+1)+v(:,kbot)) @@ -158,9 +137,29 @@ subroutine gw_cm_src(ncol, ngwv, kbot, u, v, frontgf, & ubi(:,1:kbot-1) = midpoint_interp(ubm(:,1:kbot)) - !----------------------------------------------------------------------- - ! Gravity wave sources - !----------------------------------------------------------------------- +end subroutine gw_front_project_winds + +!========================================================================== +subroutine gw_front_gw_sources(ncol, ngwv, kbot, frontgf, tau) + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol, ngwv + + ! Index of source interface. + integer, intent(in) :: kbot + + ! Frontogenesis function. + real(r8), intent(in) :: frontgf(:,:) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-pgwv:pgwv,0:pver) + + !---------------------------Local Storage------------------------------- + ! Column and wavenumber indices. + integer :: l + + ! Whether or not to launch waves in this column. + logical(btype) :: launch_wave(ncol) tau = 0._r8 @@ -175,9 +174,60 @@ subroutine gw_cm_src(ncol, ngwv, kbot, u, v, frontgf, & end where end do +end subroutine gw_front_gw_sources + +!========================================================================== +subroutine gw_cm_src(ncol, ngwv, kbot, u, v, frontgf, & + src_level, tend_level, tau, ubm, ubi, xv, yv, c) + !----------------------------------------------------------------------- + ! Driver for multiple gravity wave drag parameterization. + ! + ! The parameterization is assumed to operate only where water vapor + ! concentrations are negligible in determining the density. + !----------------------------------------------------------------------- + + !------------------------------Arguments-------------------------------- + ! Column and gravity wave spectrum dimensions. + integer, intent(in) :: ncol, ngwv + + ! Index of source interface. + integer, intent(in) :: kbot + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Frontogenesis function. + real(r8), intent(in) :: frontgf(:,:) + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-pgwv:pgwv,0:pver) + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,0:pver) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-pgwv:pgwv) + + !------------------------------------------------------------------------ + ! Determine the source layer wind and unit vectors, then project winds. + !------------------------------------------------------------------------ + call gw_front_project_winds(ncol, kbot, u, v, xv, yv, ubm, ubi) + + !----------------------------------------------------------------------- + ! Gravity wave sources + !----------------------------------------------------------------------- + call gw_front_gw_sources(ncol, ngwv, kbot, frontgf, tau) + + src_level = kbot + tend_level = kbot + ! Set phase speeds as reference speeds plus the wind speed at the source ! level. - c = spread(cref, 1, ncol) + spread(abs(ubi(:,kbot)),2,2*ngwv+1) + c = spread(cref, 1, ncol) + spread(abs(ubi(:,kbot)),2,2*pgwv+1) end subroutine gw_cm_src diff --git a/components/eam/src/physics/cam/gw/gw_utils.F90 b/components/eam/src/physics/cam/gw/gw_utils.F90 index cf7727f6d68e..4436fa13bd8d 100644 --- a/components/eam/src/physics/cam/gw/gw_utils.F90 +++ b/components/eam/src/physics/cam/gw/gw_utils.F90 @@ -4,12 +4,27 @@ module gw_utils ! This module contains utility code for the gravity wave modules. ! +#ifdef SCREAM_CONFIG_IS_CMAKE + use iso_c_binding, only: c_double, c_float, c_bool +#endif + implicit none private save -! Real kind for gravity wave parameterization. -integer, public, parameter :: r8 = selected_real_kind(12) +#ifdef SCREAM_CONFIG_IS_CMAKE +#include "eamxx_config.f" +# ifdef SCREAM_DOUBLE_PRECISION + integer,parameter,public :: r8 = c_double ! 8 byte real, compatible with c type double +# else + integer,parameter,public :: r8 = c_float ! 4 byte real, compatible with c type float +# endif + integer,parameter,public :: btype = c_bool ! boolean type, compatible with c +#else + ! Real kind for gravity wave parameterization. + integer, public, parameter :: r8 = selected_real_kind(12) + integer,parameter,public :: btype = kind(.true.) ! native logical +#endif ! Public interface public :: get_unit_vector diff --git a/components/eam/src/physics/cam/hetfrz_classnuc_cam.F90 b/components/eam/src/physics/cam/hetfrz_classnuc_cam.F90 index 1bfe8a3c45bc..02737d71f7ca 100644 --- a/components/eam/src/physics/cam/hetfrz_classnuc_cam.F90 +++ b/components/eam/src/physics/cam/hetfrz_classnuc_cam.F90 @@ -1305,7 +1305,7 @@ subroutine get_aer_num(ii, kk, ncnst, aer, aer_cb, rhoair,& #if ((defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) && defined RAIN_EVAP_TO_COARSE_AERO ) dst3_num_imm = dmc_imm/(ssmc_imm+dmc_imm+bcmc_imm+pommc_imm+soamc_imm+mommc_imm) & * aer_cb(ii,kk,num_coarse)*1.0e-6_r8 ! #/cm^3 -#elif (defined MODAL_AERO_4MODE_MOM) +#elif (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) dst3_num_imm = dmc_imm/(ssmc_imm+dmc_imm+mommc_imm) * aer_cb(ii,kk,num_coarse)*1.0e-6_r8 ! #/cm^3 #elif (defined RAIN_EVAP_TO_COARSE_AERO) dst3_num_imm = dmc_imm/(ssmc_imm+dmc_imm+bcmc_imm+pommc_imm+soamc_imm) & @@ -1475,7 +1475,7 @@ subroutine get_aer_num(ii, kk, ncnst, aer, aer_cb, rhoair,& aer(ii,kk,pom_coarse)/(specdens_pom*rhoair) + & aer(ii,kk,soa_coarse)/(specdens_soa*rhoair) + & aer(ii,kk,mom_coarse)/(specdens_mom*rhoair) -#elif (defined MODAL_AERO_4MODE_MOM) +#elif (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) vol_shell(3) = aer(ii,kk,so4_coarse)/(specdens_so4*rhoair) + & aer(ii,kk,mom_coarse)/(specdens_mom*rhoair) #elif (defined RAIN_EVAP_TO_COARSE_AERO) @@ -1603,7 +1603,7 @@ subroutine get_aer_num(ii, kk, ncnst, aer, aer_cb, rhoair,& #if ((defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) && defined RAIN_EVAP_TO_COARSE_AERO ) awcam(3) = (dst3_num*1.0e6_r8)/aer(ii,kk,num_coarse)* ( aer(ii,kk,so4_coarse) + & aer(ii,kk,mom_coarse) + aer(ii,kk,bc_coarse) + aer(ii,kk,pom_coarse) + aer(ii,kk,soa_coarse) ) *1.0e9_r8 -#elif (defined MODAL_AERO_4MODE_MOM) +#elif (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) awcam(3) = (dst3_num*1.0e6_r8)/aer(ii,kk,num_coarse)* ( aer(ii,kk,so4_coarse) + & aer(ii,kk,mom_coarse) ) *1.0e9_r8 #elif (defined RAIN_EVAP_TO_COARSE_AERO) @@ -1617,12 +1617,12 @@ subroutine get_aer_num(ii, kk, ncnst, aer, aer_cb, rhoair,& end if if (awcam(3) > 0._r8) then -#if (defined MODAL_AERO_4MODE_MOM && defined RAIN_EVAP_TO_COARSE_AERO ) +#if ( (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) && defined RAIN_EVAP_TO_COARSE_AERO ) awfacm(3) = ( aer(ii,kk,bc_coarse) + aer(ii,kk,soa_coarse) + & aer(ii,kk,pom_coarse) + aer(ii,kk,mom_coarse) )/ & ( aer(ii,kk,soa_coarse) + aer(ii,kk,pom_coarse) + & aer(ii,kk,so4_coarse) + aer(ii,kk,bc_coarse) + aer(ii,kk,mom_coarse) ) -#elif (defined MODAL_AERO_4MODE_MOM) +#elif (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) awfacm(3) = ( aer(ii,kk,mom_coarse) ) / & ( aer(ii,kk,so4_coarse) + aer(ii,kk,mom_coarse) ) #elif (defined RAIN_EVAP_TO_COARSE_AERO) diff --git a/components/eam/src/physics/cam/misc_diagnostics.F90 b/components/eam/src/physics/cam/misc_diagnostics.F90 index 0f8dfcada971..581834e5d9f0 100644 --- a/components/eam/src/physics/cam/misc_diagnostics.F90 +++ b/components/eam/src/physics/cam/misc_diagnostics.F90 @@ -155,7 +155,7 @@ subroutine relhum_ice_percent( ncol, pver, tair, pair, qv, rhi_percent ) end subroutine relhum_ice_percent -subroutine compute_cape_diags( state, pbuf, pcols, pver, cape_out, dcape_out ) +subroutine compute_cape_diags( state, pbuf, pcols, pver, pverp, cape_out, dcape_out ) !------------------------------------------------------------------------------------------- ! Purpose: ! - CAPE, the convecitve available potential energy @@ -171,17 +171,19 @@ subroutine compute_cape_diags( state, pbuf, pcols, pver, cape_out, dcape_out ) use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field use physconst, only: cpair, gravit, rair, latvap - use zm_conv, only: buoyan_dilute, limcnv + use zm_conv, only: zm_const, zm_param + use zm_conv_cape, only: compute_dilute_cape type(physics_state),intent(in),target:: state type(physics_buffer_desc),pointer :: pbuf(:) integer, intent(in) :: pver + integer, intent(in) :: pverp integer, intent(in) :: pcols real(r8), intent(out) :: cape_out(pcols) real(r8),optional, intent(out) :: dcape_out(pcols,3) - ! local variables used for providing the same input to different calls of subroutine buoyan_dilute + ! local variables used for providing the same input to different calls of subroutine compute_dilute_cape real(r8) :: pmid_in_hPa(pcols,pver) real(r8) :: pint_in_hPa(pcols,pver+1) @@ -196,30 +198,28 @@ subroutine compute_cape_diags( state, pbuf, pcols, pver, cape_out, dcape_out ) logical :: iclosure = .true. ! set to .true. to avoid interference with trig_dcape - ! variables that distinguish different calls of buoyan_dilute + ! variables that distinguish different calls of compute_dilute_cape real(r8),pointer :: qv_new(:,:) ! new qv from current state real(r8),pointer :: temp_new(:,:) ! new temp from current state logical :: use_old_parcel_tq ! whether or not to use old launching level and parcel T, q when calculating CAPE - integer :: mx_new(pcols) ! index of launching level in new environment, calculated by buoyan_dilute - real(r8) :: q_mx_new(pcols) ! new specific humidity at new launching level, calculated by buoyan_dilute - real(r8) :: t_mx_new(pcols) ! new temperature at new launching level, calculated by buoyan_dilute + integer :: mx_new(pcols) ! index of launching level in new environment, calculated by compute_dilute_cape + real(r8) :: q_mx_new(pcols) ! new specific humidity at new launching level, calculated by compute_dilute_cape + real(r8) :: t_mx_new(pcols) ! new temperature at new launching level, calculated by compute_dilute_cape integer, pointer :: mx_old(:) ! old launching level from pbuf real(r8),pointer :: q_mx_old(:) ! old qv at launching level from pbuf real(r8),pointer :: t_mx_old(:) ! old temp at launching level from pbuf - ! variables returned by buoyan_dilute but not needed here + ! variables returned by compute_dilute_cape but not needed here real(r8) :: ztp(pcols,pver) ! parcel temperatures. real(r8) :: zqstp(pcols,pver) ! grid slice of parcel temp. saturation mixing ratio. real(r8) :: ztl(pcols) ! parcel temperature at lcl. integer :: zlcl(pcols) ! base level index of deep cumulus convection. integer :: zlel(pcols) ! index of highest theoretical convective plume. - integer :: zlon(pcols) ! index of onset level for deep convection. - integer :: zmx(pcols) ! launching level index ! CAPE calculated using different combinations of environmental profiles and parcel properties @@ -248,13 +248,13 @@ subroutine compute_cape_diags( state, pbuf, pcols, pver, cape_out, dcape_out ) !----------------------------------- ! Time-independent quantities !----------------------------------- - msg = limcnv - 1 ! limcnv is the top interface level limit for convection + msg = zm_param%limcnv - 1 ! limcnv is the top pressure interface level to limit deep convection idx = pbuf_get_index('tpert') ; call pbuf_get_field( pbuf, idx, tpert ) ! Surface elevation (m) is needed to calculate height above sea level (m) ! Note that zm (and zi) stored in state are height above surface. - ! The layer midpoint height provided to buoyan_dilute is height above sea level. + ! The layer midpoint height provided to compute_dilute_cape is height above sea level. zs(1:ncol) = state%phis(1:ncol)/gravit @@ -291,21 +291,20 @@ subroutine compute_cape_diags( state, pbuf, pcols, pver, cape_out, dcape_out ) ! and T, qv values at (new) launching level !------------------------------------------------------------------------ iclosure = .true. - call buoyan_dilute(lchnk ,ncol, &! in - qv_new, temp_new, &! in !! - pmid_in_hPa, zmid_above_sealevel, &! in - pint_in_hPa, &! in - ztp, zqstp, ztl, &! out - latvap, &! in - cape_new_pcl_new_env, &! out !! - pblt, &! in - zlcl, zlel, zlon, &! out - mx_new, &! out !! - rair, gravit, cpair, msg, tpert, &! in - iclosure, &! in - use_input_parcel_tq_in = .false., &! in !! - q_mx = q_mx_new, &! out !! - t_mx = t_mx_new )! out !! + call compute_dilute_cape( pcols, ncol, pver, pverp, & + zm_param%num_cin, msg, & + qv_new, temp_new, & + zmid_above_sealevel, & + pmid_in_hPa, pint_in_hPa, & + pblt, tpert, & + ztp, zqstp, mx_new, & + ztl, zlcl, zlel, & + cape_new_pcl_new_env, & + zm_const, zm_param, & + iclosure, & + use_input_tq_mx = .false., & + q_mx = q_mx_new, & + t_mx = t_mx_new ) cape_out(:ncol) = cape_new_pcl_new_env(:ncol) @@ -318,31 +317,28 @@ subroutine compute_cape_diags( state, pbuf, pcols, pver, cape_out, dcape_out ) !----------------------------------------------------------------- ! dCAPE is the difference between the new CAPE calculated above ! and the old CAPE retrieved from pbuf - dcape_out(:ncol,1) = cape_new_pcl_new_env(:ncol) - cape_old_pcl_old_env(:ncol) !----------------------------------------------------------------- ! Calculate cape_old_pcl_new_env using ! - new state (T, qv profiles) ! - old launching level and parcel T, qv - iclosure = .true. - call buoyan_dilute(lchnk ,ncol, &! in - qv_new, temp_new, &! in !!! - pmid_in_hPa, zmid_above_sealevel, &! in - pint_in_hPa, &! in - ztp, zqstp, ztl, &! out - latvap, &! in - cape_old_pcl_new_env, &! out !!! - pblt, &! in - zlcl, zlel, zlon, &! out - zmx, &! out - rair, gravit, cpair, msg, tpert, &! in - iclosure, &! in - dcapemx = mx_old, &! in !!! - use_input_parcel_tq_in = .true., &! in !!! - q_mx = q_mx_old, &! in !!! - t_mx = t_mx_old )! in !!! + call compute_dilute_cape( pcols, ncol, pver, pverp, & + zm_param%num_cin, msg, & + qv_new, temp_new, & + zmid_above_sealevel, & + pmid_in_hPa, pint_in_hPa, & + pblt, tpert, & + ztp, zqstp, mx_new, & + ztl, zlcl, zlel, & + cape_old_pcl_new_env, & + zm_const, zm_param, & + iclosure, & + dcapemx = mx_old, & + use_input_tq_mx = .true., & + q_mx = q_mx_old, & + t_mx = t_mx_old ) ! dCAPEp = CAPE(new parcel, new env) - CAPE( old parcel, new env) dcape_out(:ncol,2) = cape_new_pcl_new_env(:ncol) - cape_old_pcl_new_env(:ncol) diff --git a/components/eam/src/physics/cam/nucleate_ice_cam.F90 b/components/eam/src/physics/cam/nucleate_ice_cam.F90 index 5883d7b2e45d..eeefba80f145 100644 --- a/components/eam/src/physics/cam/nucleate_ice_cam.F90 +++ b/components/eam/src/physics/cam/nucleate_ice_cam.F90 @@ -777,11 +777,9 @@ subroutine nucleate_ice_cam_calc( & else ! 3-mode -- needs weighting for dust since dust and seasalt ! are combined in the "coarse" mode type -#if (defined MODAL_AERO_4MODE_MOM && defined RAIN_EVAP_TO_COARSE_AERO ) +#if ((defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) && defined RAIN_EVAP_TO_COARSE_AERO ) wght = dmc/(ssmc + dmc + so4mc + bcmc + pommc + soamc + mommc) -#elif (defined MODAL_AERO_5MODE && defined RAIN_EVAP_TO_COARSE_AERO) - wght = dmc/(ssmc + dmc + so4mc + bcmc + pommc + soamc + mommc) -#elif (defined MODAL_AERO_4MODE_MOM) +#elif (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) wght = dmc/(ssmc + dmc + so4mc + mommc) #elif (defined RAIN_EVAP_TO_COARSE_AERO) wght = dmc/(ssmc + dmc + so4mc + bcmc + pommc + soamc) diff --git a/components/eam/src/physics/cam/vdiff_lu_solver.F90 b/components/eam/src/physics/cam/vdiff_lu_solver.F90 index 08614bafb62b..ca4ac2bb554b 100644 --- a/components/eam/src/physics/cam/vdiff_lu_solver.F90 +++ b/components/eam/src/physics/cam/vdiff_lu_solver.F90 @@ -5,6 +5,10 @@ module vdiff_lu_solver ! This module was created solely to share vd_lu_decomp and vd_lu_solve ! between gw_drag and diffusion_solver. +#ifdef SCREAM_CONFIG_IS_CMAKE + use gw_utils, only: r8 +#endif + implicit none private save @@ -16,7 +20,10 @@ module vdiff_lu_solver public :: lu_decomp ! 8-byte real. + +#ifndef SCREAM_CONFIG_IS_CMAKE integer, parameter :: r8 = selected_real_kind(12) +#endif ! Type to hold the sparse matrix decomposition from vd_lu_decomp. type :: lu_decomp @@ -219,6 +226,8 @@ subroutine vd_lu_solve(pcols, pver, ncol, & ! Main Computation Begins ! ! ----------------------- ! + zf = 0.0_r8 + ! Calculate zf(k). Terms zf(k) and ze(k) are required in solution of ! tridiagonal matrix defined by implicit diffusion equation. ! Note that only levels ntop through nbot need be solved for. @@ -270,6 +279,12 @@ pure function lu_decomp_alloc(ncol, pver) result(new_decomp) allocate(new_decomp%dnom(ncol,pver)) allocate(new_decomp%ze(ncol,pver)) + ! Initialize to zero + new_decomp%ca = 0.0_r8 + new_decomp%cc = 0.0_r8 + new_decomp%dnom = 0.0_r8 + new_decomp%ze = 0.0_r8 + end function lu_decomp_alloc ! LU decomposition deallocation. diff --git a/components/eam/src/physics/cam/zm_aero.F90 b/components/eam/src/physics/cam/zm_aero.F90 new file mode 100644 index 000000000000..747d923a5a2f --- /dev/null +++ b/components/eam/src/physics/cam/zm_aero.F90 @@ -0,0 +1,247 @@ +module zm_aero + !---------------------------------------------------------------------------- + ! Purpose: microphysics state structure definition and methods for ZM + ! Original Author: Xialiang Song and Guang Zhang, June 2010 + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + public :: zm_aero_t ! structure to hold aerosol state information for ZM microphysics + public :: zm_aero_init ! aerosol stype initialization + +!=================================================================================================== + +! generic 2D pointer type for zm_aero_t +type, public :: ptr2d + real(r8), pointer :: val(:,:) +end type ptr2d + +! structure to hold aerosol state information for ZM microphysics +type :: zm_aero_t + + ! Aerosol treatment + character(len=5) :: scheme ! either 'bulk' or 'modal' + + ! Bulk aerosols + integer :: nbulk = 0 ! number of bulk aerosols affecting climate + integer :: idxsul = -1 ! index in aerosol list for sulfate + integer :: idxdst1 = -1 ! index in aerosol list for dust1 + integer :: idxdst2 = -1 ! index in aerosol list for dust2 + integer :: idxdst3 = -1 ! index in aerosol list for dust3 + integer :: idxdst4 = -1 ! index in aerosol list for dust4 + integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHI) + + real(r8), allocatable :: num_to_mass_aer(:) ! conversion of mmr to number conc for bulk aerosols + type(ptr2d), allocatable :: mmr_bulk(:) ! array of pointers to bulk aerosol mmr + real(r8), allocatable :: mmrg_bulk(:,:,:) ! gathered bulk aerosol mmr + + ! Modal aerosols + integer :: nmodes = 0 ! number of modes + integer, allocatable :: nspec(:) ! number of species in each mode + type(ptr2d), allocatable :: num_a(:) ! number mixing ratio of modes (interstitial phase) + type(ptr2d), allocatable :: mmr_a(:,:) ! species mmr in each mode (interstitial phase) + real(r8), allocatable :: numg_a(:,:,:) ! gathered number mixing ratio of modes (interstitial phase) + real(r8), allocatable :: mmrg_a(:,:,:,:) ! gathered species mmr in each mode (interstitial phase) + real(r8), allocatable :: voltonumblo(:) ! volume to number conversion (lower bound) for each mode + real(r8), allocatable :: voltonumbhi(:) ! volume to number conversion (upper bound) for each mode + real(r8), allocatable :: specdens(:,:) ! density of modal species + real(r8), allocatable :: spechygro(:,:) ! hygroscopicity of modal species + + integer :: mode_accum_idx = -1 ! index of accumulation mode + integer :: mode_aitken_idx = -1 ! index of aitken mode + integer :: mode_coarse_idx = -1 ! index of coarse mode + integer :: coarse_dust_idx = -1 ! index of dust in coarse mode + integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode + + integer :: coarse_so4_idx = -1 ! index of so4 in coarse mode +#if (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) + integer :: coarse_mom_idx = -1 ! index of mom in coarse mode +#endif + +#if (defined RAIN_EVAP_TO_COARSE_AERO) + integer :: coarse_bc_idx = -1 ! index of bc in coarse mode + integer :: coarse_pom_idx = -1 ! index of pom in coarse mode + integer :: coarse_soa_idx = -1 ! index of soa in coarse mode +#endif + + type(ptr2d), allocatable :: dgnum(:) ! mode dry radius + real(r8), allocatable :: dgnumg(:,:,:) ! gathered mode dry radius + + real(r8) :: sigmag_aitken + +end type zm_aero_t + +!=================================================================================================== +contains +!=================================================================================================== + +subroutine zm_aero_init(nmodes, nbulk, aero) + !---------------------------------------------------------------------------- + ! Purpose: Initialize the zm_aero_t object for modal aerosols + !---------------------------------------------------------------------------- + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_props, rad_cnst_get_aer_props + use physconst, only: pi + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: nmodes + integer, intent(in ) :: nbulk + type(zm_aero_t), intent(inout) :: aero + !---------------------------------------------------------------------------- + ! Local variables + character(len=*), parameter :: routine = 'zm_aero_init' + character(len=20), allocatable :: aername(:) + character(len=32) :: str32 + integer :: iaer, l, m + integer :: nspecmx ! max number of species in a mode + real(r8) :: sigmag + real(r8) :: dgnumlo + real(r8) :: dgnumhi + real(r8) :: alnsg + !---------------------------------------------------------------------------- + aero%nmodes = nmodes + aero%nbulk = nbulk + + if (nmodes > 0) then + + ! Initialize the modal aerosol information + aero%scheme = 'modal' + + ! Get number of species in each mode, and find max. + allocate(aero%nspec(aero%nmodes)) + nspecmx = 0 + do m = 1, aero%nmodes + call rad_cnst_get_info(0, m, nspec=aero%nspec(m), mode_type=str32) + nspecmx = max(nspecmx, aero%nspec(m)) + ! save mode index for specified mode types + select case (trim(str32)) + case ('accum') + aero%mode_accum_idx = m + case ('aitken') + aero%mode_aitken_idx = m + case ('coarse') + aero%mode_coarse_idx = m + end select + end do + + ! Check that required mode types were found + if (aero%mode_accum_idx == -1 .or. & + aero%mode_aitken_idx == -1 .or. & + aero%mode_coarse_idx == -1) then + write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & + aero%mode_accum_idx, aero%mode_aitken_idx, aero%mode_coarse_idx + call endrun(routine//': ERROR required mode type not found') + end if + + ! find indices for the dust and seasalt species in the coarse mode + do l = 1, aero%nspec(aero%mode_coarse_idx) + call rad_cnst_get_info(0, aero%mode_coarse_idx, l, spec_type=str32) + select case (trim(str32)) + case ('dust') + aero%coarse_dust_idx = l + case ('seasalt') + aero%coarse_nacl_idx = l + case ('sulfate') + aero%coarse_so4_idx = l +#if ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE ) + case ('m-organic') + aero%coarse_mom_idx = l +#endif +#if ( defined RAIN_EVAP_TO_COARSE_AERO ) + case ('black-c') + aero%coarse_bc_idx = l + case ('p-organic') + aero%coarse_pom_idx = l + case ('s-organic') + aero%coarse_soa_idx = l +#endif + end select + end do + + ! Check that required modal species types were found + if (aero%coarse_dust_idx == -1 .or. & + aero%coarse_nacl_idx == -1 .or. & + aero%coarse_so4_idx == -1) then + write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & + aero%coarse_dust_idx, aero%coarse_nacl_idx, aero%coarse_so4_idx + call endrun(routine//': ERROR required mode-species type not found') + end if + +#if ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE ) + if (aero%coarse_mom_idx == -1) then + write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & + aero%coarse_mom_idx + call endrun(routine//': ERROR required mode-species type not found') + end if +#endif + +#if ( defined RAIN_EVAP_TO_COARSE_AERO ) + if (aero%coarse_bc_idx == -1 .or. & + aero%coarse_pom_idx == -1 .or. & + aero%coarse_soa_idx == -1) then + write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & + aero%coarse_bc_idx, aero%coarse_pom_idx, aero%coarse_soa_idx + call endrun(routine//': ERROR required mode-species type not found') + end if +#endif + + allocate( & + aero%num_a(nmodes), & + aero%mmr_a(nspecmx,nmodes), & + aero%numg_a(pcols,pver,nmodes), & + aero%mmrg_a(pcols,pver,nspecmx,nmodes), & + aero%voltonumblo(nmodes), & + aero%voltonumbhi(nmodes), & + aero%specdens(nspecmx,nmodes), & + aero%spechygro(nspecmx,nmodes), & + aero%dgnum(nmodes), & + aero%dgnumg(pcols,pver,nmodes) ) + + do m = 1, nmodes + ! Properties of modes + call rad_cnst_get_mode_props( 0, m, sigmag=sigmag, dgnumlo=dgnumlo, dgnumhi=dgnumhi ) + alnsg = log(sigmag) + aero%voltonumblo(m) = 1 / ( (pi/6.0_r8)*(dgnumlo**3)*exp(4.5_r8*alnsg**2) ) + aero%voltonumbhi(m) = 1 / ( (pi/6.0_r8)*(dgnumhi**3)*exp(4.5_r8*alnsg**2) ) + ! save sigmag of aitken mode + if (m == aero%mode_aitken_idx) aero%sigmag_aitken = sigmag + ! Properties of modal species + do l = 1, aero%nspec(m) + call rad_cnst_get_aer_props(0, m, l, & + density_aer = aero%specdens(l,m), & + hygro_aer = aero%spechygro(l,m)) + end do + end do + + else if (nbulk > 0) then + + aero%scheme = 'bulk' + + ! Properties needed for BAM number concentration calcs. + allocate( & + aername(nbulk), & + aero%num_to_mass_aer(nbulk), & + aero%mmr_bulk(nbulk), & + aero%mmrg_bulk(pcols,pver,nbulk) ) + + do iaer = 1, aero%nbulk + call rad_cnst_get_aer_props(0, iaer, & + aername = aername(iaer), & + num_to_mass_aer = aero%num_to_mass_aer(iaer) ) + ! Look for sulfate aerosol in this list (Bulk aerosol only) + if (trim(aername(iaer)) == 'SULFATE') aero%idxsul = iaer + if (trim(aername(iaer)) == 'DUST1') aero%idxdst1 = iaer + if (trim(aername(iaer)) == 'DUST2') aero%idxdst2 = iaer + if (trim(aername(iaer)) == 'DUST3') aero%idxdst3 = iaer + if (trim(aername(iaer)) == 'DUST4') aero%idxdst4 = iaer + if (trim(aername(iaer)) == 'BCPHI') aero%idxbcphi = iaer + end do + + end if + +end subroutine zm_aero_init + +!=================================================================================================== + +end module zm_aero diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 3da8291fb90f..eb0e6e99897c 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -23,7 +23,11 @@ module zm_conv cpwv, cpliq, rh2o use cam_abortutils, only: endrun use cam_logfile, only: iulog - use zm_microphysics, only: zm_mphy, zm_aero_t + use zm_conv_cape, only: compute_dilute_cape + use zm_conv_types, only: zm_const_t, zm_param_t + use zm_conv_util, only: qsat_hpa ! remove after moving cldprp to new module + use zm_aero, only: zm_aero_t + use zm_microphysics, only: zm_mphy use zm_microphysics_state, only: zm_microp_st, zm_microp_st_alloc, zm_microp_st_dealloc, zm_microp_st_ini, zm_microp_st_gb implicit none @@ -40,7 +44,6 @@ module zm_conv public trigdcape_ull ! true if to use dcape-ULL trigger public trig_dcape_only ! true if to use dcape only trigger public trig_ull_only ! true if to ULL along with default CAPE-based trigger - public buoyan_dilute ! subroutine that calculates CAPE public zm_microp ! true for convective microphysics public MCSP ! true if running MCSP public MCSP_heat_coeff ! MCSP coefficient setting degree of dry static energy transport @@ -51,7 +54,9 @@ module zm_conv ! ! PUBLIC: data ! - public limcnv ! top interface level limit for convection + + type(zm_const_t), public :: zm_const ! derived type to hold ZM constants + type(zm_param_t), public :: zm_param ! derived type to hold ZM tunable parameters ! ! Private data @@ -81,7 +86,7 @@ module zm_conv real(r8) :: zmconv_MCSP_heat_coeff = 0._r8 real(r8) :: zmconv_MCSP_moisture_coeff = 0._r8 real(r8) :: zmconv_MCSP_uwind_coeff = 0._r8 - real(r8) :: zmconv_MCSP_vwind_coeff = 0._r8 + real(r8) :: zmconv_MCSP_vwind_coeff = 0._r8 real(r8) rl ! wg latent heat of vaporization. real(r8) cpres ! specific heat at constant pressure in j/kg-degk. @@ -93,19 +98,13 @@ module zm_conv logical :: trig_dcape_only = .false. !true to use DCAPE trigger, ULL not used logical :: trig_ull_only = .false. !true to use ULL along with default CAPE-based trigger - real(r8) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke real(r8) :: c0_lnd ! set from namelist input zmconv_c0_lnd real(r8) :: c0_ocn ! set from namelist input zmconv_c0_ocn - real(r8) :: dmpdz = unset_r8 ! Parcel fractional mass entrainment rate (/m) real(r8) :: alfa_scalar ! maximum downdraft mass flux fraction - real(r8) :: tiedke_add = unset_r8 logical :: zm_microp = .false. ! switch for convective microphysics logical :: clos_dyn_adj = .false. ! true if apply mass flux adjustment to CAPE closure - logical :: tpert_fix = .false. ! true if apply tpert only to PBL-rooted convection - integer :: num_cin = unset_int !number of negative buoyancy regions that are allowed before the conv. top and CAPE calc are completed - integer :: mx_bot_lyr_adj = unset_int !bottom layer adjustment for setting "launching" level(mx) (to be at maximum moist static energy). real(r8) tau ! convective time scale real(r8),parameter :: c1 = 6.112_r8 real(r8),parameter :: c2 = 17.67_r8 @@ -124,9 +123,8 @@ module zm_conv real(r8) :: grav ! = gravit real(r8) :: cp ! = cpres = cpair - integer,protected :: limcnv ! top interface level limit for convection + ! integer,protected :: limcnv ! upper pressure interface level to limit deep convection - real(r8) :: tp_fac = unset_r8 real(r8) :: auto_fac = unset_r8 real(r8) :: accr_fac = unset_r8 real(r8) :: micro_dcs= unset_r8 @@ -137,12 +135,15 @@ module zm_conv real(r8) :: MCSP_uwind_coeff = unset_r8 real(r8) :: MCSP_vwind_coeff = unset_r8 +!=================================================================================================== contains +!=================================================================================================== subroutine zmconv_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit + use zm_conv_types, only: zm_param_mpi_broadcast use mpishorthand character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -184,20 +185,24 @@ subroutine zmconv_readnl(nlfile) trig_ull_only = zmconv_trig_ull_only zm_microp = zmconv_microp clos_dyn_adj = zmconv_clos_dyn_adj - tpert_fix = zmconv_tpert_fix - tiedke_add = zmconv_tiedke_add - num_cin = zmconv_cape_cin - mx_bot_lyr_adj = zmconv_mx_bot_lyr_adj - dmpdz = zmconv_dmpdz - tp_fac = zmconv_tp_fac auto_fac = zmconv_auto_fac accr_fac = zmconv_accr_fac micro_dcs = zmconv_micro_dcs MCSP_heat_coeff = zmconv_MCSP_heat_coeff MCSP_moisture_coeff = zmconv_MCSP_moisture_coeff MCSP_uwind_coeff = zmconv_MCSP_uwind_coeff - MCSP_vwind_coeff = zmconv_MCSP_vwind_coeff - + MCSP_vwind_coeff = zmconv_MCSP_vwind_coeff + + ! set zm_param values + zm_param%trig_dcape = trigdcape_ull .or. trig_dcape_only + zm_param%trig_ull = trigdcape_ull .or. trig_ull_only + zm_param%tiedke_add = zmconv_tiedke_add + zm_param%dmpdz = zmconv_dmpdz + zm_param%num_cin = zmconv_cape_cin + zm_param%tpert_fix = zmconv_tpert_fix + zm_param%tpert_fac = zmconv_tp_fac + zm_param%mx_bot_lyr_adj = zmconv_mx_bot_lyr_adj + if( abs(MCSP_heat_coeff)+abs(MCSP_moisture_coeff)+abs(MCSP_uwind_coeff)+abs(MCSP_vwind_coeff) > 0._r8 ) then MCSP = .true. else @@ -234,8 +239,8 @@ subroutine zmconv_readnl(nlfile) write(iulog,*)'**** ZM scheme uses cloud-base mass flux adjustment:',clos_dyn_adj end if - if(tpert_fix) then - write(iulog,*)'**** ZM scheme uses tpert_fix:',tpert_fix + if(zm_param%tpert_fix) then + write(iulog,*)'**** ZM scheme uses tpert_fix:',zm_param%tpert_fix end if end if @@ -245,18 +250,12 @@ subroutine zmconv_readnl(nlfile) call mpibcast(c0_ocn, 1, mpir8, 0, mpicom) call mpibcast(ke, 1, mpir8, 0, mpicom) call mpibcast(tau, 1, mpir8, 0, mpicom) - call mpibcast(dmpdz, 1, mpir8, 0, mpicom) call mpibcast(alfa_scalar, 1, mpir8, 0, mpicom) call mpibcast(trigdcape_ull, 1, mpilog, 0, mpicom) call mpibcast(trig_dcape_only, 1, mpilog, 0, mpicom) call mpibcast(trig_ull_only, 1, mpilog, 0, mpicom) call mpibcast(zm_microp, 1, mpilog, 0, mpicom) call mpibcast(clos_dyn_adj, 1, mpilog, 0, mpicom) - call mpibcast(tpert_fix, 1, mpilog, 0, mpicom) - call mpibcast(tiedke_add, 1, mpir8, 0, mpicom) - call mpibcast(num_cin, 1, mpiint, 0, mpicom) - call mpibcast(mx_bot_lyr_adj, 1, mpiint, 0, mpicom) - call mpibcast(tp_fac, 1, mpir8, 0, mpicom) call mpibcast(auto_fac, 1, mpir8, 0, mpicom) call mpibcast(accr_fac, 1, mpir8, 0, mpicom) call mpibcast(micro_dcs, 1, mpir8, 0, mpicom) @@ -264,7 +263,10 @@ subroutine zmconv_readnl(nlfile) call mpibcast(MCSP_heat_coeff, 1, mpir8, 0, mpicom) call mpibcast(MCSP_moisture_coeff,1, mpir8, 0, mpicom) call mpibcast(MCSP_uwind_coeff, 1, mpir8, 0, mpicom) - call mpibcast(MCSP_vwind_coeff, 1, mpir8, 0, mpicom) + call mpibcast(MCSP_vwind_coeff, 1, mpir8, 0, mpicom) + + call zm_param_mpi_broadcast(zm_param) + #endif end subroutine zmconv_readnl @@ -273,6 +275,7 @@ end subroutine zmconv_readnl subroutine zm_convi(limcnv_in, no_deep_pbl_in) use dycore, only: dycore_is, get_resolution + use zm_conv_types, only: zm_const_set_to_global integer, intent(in) :: limcnv_in ! top interface level limit for convection logical, intent(in), optional :: no_deep_pbl_in ! no_deep_pbl = .true. eliminates ZM convection entirely within PBL @@ -281,7 +284,7 @@ subroutine zm_convi(limcnv_in, no_deep_pbl_in) character(len=32) :: hgrid ! horizontal grid specifier ! Initialization of ZM constants - limcnv = limcnv_in + zm_param%limcnv = limcnv_in tfreez = tmelt eps1 = epsilo rl = latvap @@ -302,11 +305,14 @@ subroutine zm_convi(limcnv_in, no_deep_pbl_in) hgrid = get_resolution() + ! set zm_const using global values + call zm_const_set_to_global(zm_const) + if ( masterproc ) then write(iulog,*) 'tuning parameters zm_convi: tau',tau write(iulog,*) 'tuning parameters zm_convi: c0_lnd',c0_lnd, ', c0_ocn', c0_ocn write(iulog,*) 'tuning parameters zm_convi: ke',ke - write(iulog,*) 'tuning parameters zm_convi: dmpdz',dmpdz + write(iulog,*) 'tuning parameters zm_convi: dmpdz',zm_param%dmpdz write(iulog,*) 'tuning parameters zm_convi: alfa',alfa_scalar write(iulog,*) 'tuning parameters zm_convi: no_deep_pbl',no_deep_pbl endif @@ -663,7 +669,7 @@ subroutine zm_convr(lchnk ,ncol , & ! ! Set internal variable "msg" (convection limit) to "limcnv-1" ! - msg = limcnv - 1 + msg = zm_param%limcnv - 1 ! ! initialize necessary arrays. ! zero out variables not used in cam @@ -803,31 +809,30 @@ subroutine zm_convr(lchnk ,ncol , & ! DCAPE is the difference in CAPE between the two calls using the same launch level iclosure = .true. - call buoyan_dilute(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,maxi , & - rgas ,grav ,cpres ,msg , & - tpert ,iclosure ) - + call compute_dilute_cape( pcols, ncol, pver, pverp, & + zm_param%num_cin, msg, & + q, t, z, p, pf, & + pblt, tpert, & + tp, qstp, maxi, tl, & + lcl, lel, cape, & + zm_const, zm_param, & + iclosure ) if (trigdcape_ull .or. trig_dcape_only) dcapemx(:ncol) = maxi(:ncol) - !DCAPE-ULL - if ( .not.is_first_step() .and. (trigdcape_ull.or.trig_dcape_only) ) then - + ! Calculate dcape trigger condition + if ( .not.is_first_step() .and. zm_param%trig_dcape ) then iclosure = .false. - call buoyan_dilute( lchnk ,ncol , & - q_star ,t_star ,p ,z ,pf , & - tpm1 ,qstpm1 ,tlm1 ,rl ,capem1 , & - pblt ,lclm1 ,lelm1 ,lonm1 ,maxim1 , & - rgas ,grav ,cpres ,msg , & - tpert ,iclosure, dcapemx ) - + call compute_dilute_cape( pcols, ncol, pver, pverp, & + zm_param%num_cin, msg, & + q_star, t_star, z, p, pf, & + pblt, tpert, & + tpm1, qstpm1, maxim1, tlm1, & + lclm1, lelm1, capem1, & + zm_const, zm_param, & + iclosure, dcapemx ) dcape(:ncol) = (cape(:ncol)-capem1(:ncol))/(delt*2._r8) - endif - ! ! determine whether grid points will undergo some deep convection ! (ideep=1) or not (ideep=0), based on values of cape,lcl,lel @@ -987,7 +992,7 @@ subroutine zm_convr(lchnk ,ncol , & cmeg ,maxg ,lelg ,jt ,jlcl , & maxg ,j0 ,jd ,rl ,lengath , & rgas ,grav ,cpres ,msg , & - pflxg ,evpg ,cug ,rprdg ,limcnv , & + pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & aero ,qhat ,lambdadpcug,mudpcug ,sprdg ,frzg , & qldeg ,qideg ,qsdeg ,ncdeg ,nideg ,nsdeg, & @@ -2090,15 +2095,15 @@ subroutine cldprp(lchnk , & ! represent subgrid temperature perturbation. If PBL temperature perturbation (tpert) ! is used to represent subgrid temperature perturbation, tiedke_add may need to be ! removed. In addition, current calculation of PBL temperature perturbation is not - ! accurate enough so that a new tunable parameter tp_fac was introduced. This introduced + ! accurate enough so that a new tunable parameter tpert_fac was introduced. This introduced ! new uncertainties into the ZM scheme. The original code of ZM scheme will be used ! when tpert_fix=.true. - if(tpert_fix) then - hu(i,k) = hmn(i,mx(i)) + cp*tiedke_add - su(i,k) = s(i,mx(i)) + tiedke_add + if(zm_param%tpert_fix) then + hu(i,k) = hmn(i,mx(i)) + cp*zm_param%tiedke_add + su(i,k) = s(i,mx(i)) + zm_param%tiedke_add else - hu(i,k) = hmn(i,mx(i)) + cp*(tiedke_add+tp_fac*tpertg(i)) - su(i,k) = s(i,mx(i)) + tiedke_add+tp_fac*tpertg(i) + hu(i,k) = hmn(i,mx(i)) + cp*(zm_param%tiedke_add+zm_param%tpert_fac*tpertg(i)) + su(i,k) = s(i,mx(i)) + zm_param%tiedke_add+zm_param%tpert_fac*tpertg(i) end if end if end do @@ -2213,7 +2218,7 @@ subroutine cldprp(lchnk , & end do do i = 1,il2g totpcp(i) = 0._r8 - if (zm_microp) hu(i,jb(i)) = hmn(i,jb(i)) + cp*tiedke_add + if (zm_microp) hu(i,jb(i)) = hmn(i,jb(i)) + cp*zm_param%tiedke_add end do ! @@ -3086,847 +3091,4 @@ subroutine q1q2_pjr(lchnk , & return end subroutine q1q2_pjr - -subroutine buoyan_dilute(lchnk ,ncol , &! in - q_in ,t_in ,p ,z ,pf , &! in - tp ,qstp ,tl ,rl ,cape , &! rl = in, others = out - pblt ,lcl ,lel ,lon ,mx , &! pblt = in; others = out - rd ,grav ,cp ,msg , &! in - tpert ,iclosure, &! in - dcapemx , use_input_parcel_tq_in, &! in, optional - q_mx ,t_mx )! in, optional - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculates CAPE the lifting condensation level and the convective top -! where buoyancy is first -ve. -! -! Method: Calculates the parcel temperature based on a simple constant -! entraining plume model. CAPE is integrated from buoyancy. -! 09/09/04 - Simplest approach using an assumed entrainment rate for -! testing (dmpdp). -! 08/04/05 - Swap to convert dmpdz to dmpdp -! -! SCAM Logical Switches - DILUTE:RBN - Now Disabled -! --------------------- -! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. -! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. -! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. -! -! References: -! Raymond and Blythe (1992) JAS -! -! Author: -! Richard Neale - September 2004 -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: q_in(pcols,pver) ! spec. humidity - real(r8), intent(in) :: t_in(pcols,pver) ! temperature - real(r8), intent(in) :: p(pcols,pver) ! pressure - real(r8), intent(in) :: z(pcols,pver) ! height - real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces - - integer, intent(in) :: pblt(pcols) ! index of pbl depth - - real(r8), intent(in) :: rl - real(r8), intent(in) :: rd - real(r8), intent(in) :: cp - real(r8), intent(in) :: grav - integer, intent(in) :: msg - real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes - logical, intent(in) :: iclosure ! true for normal procedure, otherwise use dcapemx from 1st call - - integer, intent(in), optional :: dcapemx(pcols) - - logical, intent(in), optional :: use_input_parcel_tq_in ! if .true., use input values of dcapemx, q_mx, t_mx - real(r8),intent(inout), optional :: q_mx(pcols) ! in the CAPE calculation - real(r8),intent(inout), optional :: t_mx(pcols) -! -! output arguments -! - real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature - real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel (only above lcl, just q below). - real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl - real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. - - integer, intent(out) :: lcl(pcols) ! - integer, intent(out) :: lel(pcols) ! - integer, intent(out) :: lon(pcols) ! level of onset of deep convection - integer, intent(out) :: mx(pcols) ! level of max moist static energy -! -!--------------------------Local Variables------------------------------ -! - logical :: use_input_parcel_tq - real(r8) :: q(pcols,pver) ! spec. humidity - real(r8) :: t(pcols,pver) ! temperature - - real(r8) capeten(pcols,num_cin) ! provisional value of cape - real(r8) tv(pcols,pver) ! - real(r8) tpv(pcols,pver) ! - real(r8) buoy(pcols,pver) - real(r8) a1(pcols) - real(r8) a2(pcols) - real(r8) estp(pcols) - real(r8) pl(pcols) - real(r8) plexp(pcols) - real(r8) hmax(pcols) - real(r8) hmn(pcols) - real(r8) y(pcols) - - logical plge600(pcols) - integer knt(pcols) - integer lelten(pcols,num_cin) - -! DCAPE-ULL - integer pblt600(pcols) - integer top_k(pcols) - - real(r8) e - integer i - integer k - integer n - integer bot_layer - -#ifdef PERGRO - real(r8) rhd -#endif -! -!----------------------------------------------------------------------- -! - if (PRESENT(use_input_parcel_tq_in)) then - use_input_parcel_tq = use_input_parcel_tq_in - else - use_input_parcel_tq = .false. - end if - - if ( use_input_parcel_tq .and. & - ((.not.PRESENT(t_mx)) .or. & - (.not.PRESENT(q_mx)) .or. & - (.not.PRESENT(dcapemx)) ) ) then - call endrun('buoyan_dilute :: use_input_parcel_tq = .t. but dcapemx, t_mx or q_mx is not provided') - end if - - !------------------------------------------------------------------------------------ - ! Copy the incoming temperature and specific humidity values to work arrays. - ! The latter will be used in the buoyancy calculation. - !----------------------------------------------------------------------------------- - t(:ncol,:) = t_in(:ncol,:) - q(:ncol,:) = q_in(:ncol,:) - - - if (use_input_parcel_tq) then - !------------------------------------------------------------------------------------ - ! We expect - ! (1) the incoming array dcapemx contains previously identified launching level index, and - ! (2) the arrays q_mx and t_mx contain q and T values at the old launching level - ! at the time when the old launching level was identified. - ! Copy the old values to work arrays for calculations in the rest of this subroutine - !------------------------------------------------------------------------------------ - - mx(:ncol) = dcapemx(:ncol) - - do i=1,ncol - q(i,mx(i)) = q_mx(i) - t(i,mx(i)) = t_mx(i) - end do - - else ! initialize the mx array - - mx(:) = pver - - end if - -!----------------------------------------------------------------------- - - do n = 1,num_cin - do i = 1,ncol - lelten(i,n) = pver - capeten(i,n) = 0._r8 - end do - end do -! - do i = 1,ncol - lon(i) = pver - knt(i) = 0 - lel(i) = pver - cape(i) = 0._r8 - hmax(i) = 0._r8 - end do - - tp(:ncol,:) = t(:ncol,:) - qstp(:ncol,:) = q(:ncol,:) - -!DCAPE-ULL - if (trigdcape_ull .or. trig_ull_only) then - pblt600(:ncol) = 1 - do k = pver - 1,msg + 1,-1 - do i = 1,ncol - if ((p(i,k).le.600._r8) .and. (p(i,k+1).gt.600._r8)) pblt600(i) = k - end do - end do - endif - -!!! RBN - Initialize tv and buoy for output. -!!! tv=tv : tpv=tpv : qstp=q : buoy=0. - tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) - tpv(:ncol,:) = tv(:ncol,:) - buoy(:ncol,:) = 0._r8 -! -! set "launching" level(mx) to be at maximum moist static energy. -! search for this level stops at planetary boundary layer top. -! - bot_layer = pver - mx_bot_lyr_adj - -! DCAPE-ULL - if ((trigdcape_ull .or. trig_dcape_only ).and. (.not. iclosure)) then - !------------------------------------------------------ - ! Use max moist static energy level that is passed in - !------------------------------------------------------ - if (.not.PRESENT(dcapemx)) call endrun('** ZM CONV buoyan_dilute: dcapemx not present **') - mx(:ncol) = dcapemx(:ncol) - - elseif (.not.use_input_parcel_tq) then - !---------------------------------------------- - ! Search for max moist static energy level - !---------------------------------------------- - if (trigdcape_ull .or. trig_ull_only) then !DCAPE-ULL - top_k(:ncol) = pblt600(:ncol) - else - top_k(:ncol) = pblt(:ncol) - end if - -#ifdef PERGRO - do k = bot_layer,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) -! -! Reset max moist static energy level when relative difference exceeds 1.e-4 -! - rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i)) - - if (k >= top_k(i) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then - hmax(i) = hmn(i) - mx(i) = k - end if - - end do - end do -#else - do k = bot_layer,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - - if (k >= top_k(i) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then - hmax(i) = hmn(i) - mx(i) = k - end if - - end do - end do -#endif - - end if - -!-------------------------------------- -! Save launching level T, q for output -!-------------------------------------- - if ( .not.use_input_parcel_tq .and. PRESENT(q_mx) .and. PRESENT(t_mx) ) then - do i=1,ncol - q_mx(i) = q(i,mx(i)) - t_mx(i) = t(i,mx(i)) - end do - end if - -! LCL dilute calculation - initialize to mx(i) -! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute -! Original code actually sets LCL as level above wher condensate forms. -! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. - - do i = 1,ncol ! Initialise LCL variables. - lcl(i) = mx(i) - tl(i) = t(i,mx(i)) - pl(i) = p(i,mx(i)) - end do - -! -! main buoyancy calculation. -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! -!!! RBN 9/9/04 !!! - call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, tpert, pblt, tp, tpv, qstp, pl, tl, lcl) - - -! If lcl is above the nominal level of non-divergence (600 mbs), -! no deep convection is permitted (ensuing calculations -! skipped and cape retains initialized value of zero). -! - do i = 1,ncol - plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. - end do - -! -! Main buoyancy calculation. -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k <= mx(i) .and. plge600(i)) then ! Define buoy from launch level to cloud top. - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add ! +0.5K or not? - else - qstp(i,k) = q(i,k) - tp(i,k) = t(i,k) - tpv(i,k) = tv(i,k) - endif - end do - end do - - - -!------------------------------------------------------------------------------- - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - -! - do k = msg + 2,pver - do i = 1,ncol - if (k < lcl(i) .and. plge600(i)) then - if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then - knt(i) = min(num_cin,knt(i) + 1) - lelten(i,knt(i)) = k - end if - end if - end do - end do -! -! calculate convective available potential energy (cape). -! - do n = 1,num_cin - do k = msg + 1,pver - do i = 1,ncol - if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then - capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) - end if - end do - end do - end do -! -! find maximum cape from all possible tentative capes from -! one sounding, -! and use it as the final cape, april 26, 1995 -! - do n = 1,num_cin - do i = 1,ncol - if (capeten(i,n) > cape(i)) then - cape(i) = capeten(i,n) - lel(i) = lelten(i,n) - end if - end do - end do -! -! put lower bound on cape for diagnostic purposes. -! - do i = 1,ncol - cape(i) = max(cape(i), 0._r8) - end do -! - return -end subroutine buoyan_dilute - -subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, tpert, pblt, tp, tpv, qstp, pl, tl, lcl) -! Routine to determine -! 1. Tp - Parcel temperature -! 2. qstp - Saturated mixing ratio at the parcel temperature. - -!-------------------- -implicit none -!-------------------- - -integer, intent(in) :: lchnk -integer, intent(in) :: ncol -integer, intent(in) :: msg - -integer, intent(in), dimension(pcols) :: klaunch(pcols) - -real(r8), intent(in), dimension(pcols,pver) :: p -real(r8), intent(in), dimension(pcols,pver) :: t -real(r8), intent(in), dimension(pcols,pver) :: q -real(r8), intent(in), dimension(pcols) :: tpert ! PBL temperature perturbation. -integer, intent(in), dimension(pcols) :: pblt ! index of pbl depth - -real(r8), intent(inout), dimension(pcols,pver) :: tp ! Parcel temp. -real(r8), intent(inout), dimension(pcols,pver) :: qstp ! Parcel water vapour (sat value above lcl). -real(r8), intent(inout), dimension(pcols) :: tl ! Actual temp of LCL. -real(r8), intent(inout), dimension(pcols) :: pl ! Actual pressure of LCL. - -integer, intent(inout), dimension(pcols) :: lcl ! Lifting condesation level (first model level with saturation). - -real(r8), intent(out), dimension(pcols,pver) :: tpv ! Define tpv within this routine. - -!-------------------- - -! Have to be careful as s is also dry static energy. - - -! If we are to retain the fact that CAM loops over grid-points in the internal -! loop then we need to dimension sp,atp,mp,xsh2o with ncol. - - -real(r8) tmix(pcols,pver) ! Tempertaure of the entraining parcel. -real(r8) qtmix(pcols,pver) ! Total water of the entraining parcel. -real(r8) qsmix(pcols,pver) ! Saturated mixing ratio at the tmix. -real(r8) smix(pcols,pver) ! Entropy of the entraining parcel. -real(r8) xsh2o(pcols,pver) ! Precipitate lost from parcel. -real(r8) ds_xsh2o(pcols,pver) ! Entropy change due to loss of condensate. -real(r8) ds_freeze(pcols,pver) ! Entropy change sue to freezing of precip. - -real(r8) mp(pcols) ! Parcel mass flux. -real(r8) qtp(pcols) ! Parcel total water. -real(r8) sp(pcols) ! Parcel entropy. - -real(r8) sp0(pcols) ! Parcel launch entropy. -real(r8) qtp0(pcols) ! Parcel launch total water. -real(r8) mp0(pcols) ! Parcel launch relative mass flux. - -real(r8) tpertg(pcols) - -real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. -real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). -!real(r8) dmpdpc ! In cloud parcel mass entrainment rate (/mb). -!real(r8) dmpdz ! Parcel fractional mass entrainment rate (/m) -real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. -real(r8) senv ! Environmental entropy at each grid point. -real(r8) qtenv ! Environmental total water " " ". -real(r8) penv ! Environmental total pressure " " ". -real(r8) tenv ! Environmental total temperature " " ". -real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. -real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. -real(r8) dp ! Layer thickness (center to center) -real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! -real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). - -real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) -real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) -real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. - -integer rcall ! Number of ientropy call for errors recording -integer nit_lheat ! Number of iterations for condensation/freezing loop. -integer i,k,ii ! Loop counters. - -!====================================================================== -! SUMMARY -! -! 9/9/04 - Assumes parcel is initiated from level of maxh (klaunch) -! and entrains at each level with a specified entrainment rate. -! -! 15/9/04 - Calculates lcl(i) based on k where qsmix is first < qtmix. -! -!====================================================================== -! -! Set some values that may be changed frequently. -! - -nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. - - -!dmpdpc = 3.e-2_r8 ! In cloud entrainment rate (/mb). -lwmax = 1.e-3_r8 ! Need to put formula in for this. -tscool = 0.0_r8 ! Temp at which water loading freezes in the cloud. - -qtmix=0._r8 -smix=0._r8 - -qtenv = 0._r8 -senv = 0._r8 -tenv = 0._r8 -penv = 0._r8 - -qtp0 = 0._r8 -sp0 = 0._r8 -mp0 = 0._r8 - -qtp = 0._r8 -sp = 0._r8 -mp = 0._r8 - -new_q = 0._r8 -new_s = 0._r8 - - -! The original ZM scheme only treats PBL-rooted convection. PBL temperature perturbation (tpert) was -! used to increase the parcel temperatue at launch level, which is in PBL. -! The dcape_ull or ull triggr enables ZM scheme to treat elevated convection with launch level above PBL. -! If parcel launch level is above PBL top, tempeature perturbation in PBL should not be able to influence -! it. In this situation, the temporary varaible tpertg is reset to zero. -do i=1,ncol - tpertg(i)=tpert(i) - if ( tpert_fix .and. klaunch(i) qtmix(i,k+1)) then - lcl(i) = k - qxsk = qtmix(i,k) - qsmix(i,k) - qxskp1 = qtmix(i,k+1) - qsmix(i,k+1) - dqxsdp = (qxsk - qxskp1)/dp - pl(i) = p(i,k+1) - qxskp1/dqxsdp ! pressure level of actual lcl. - dsdp = (smix(i,k) - smix(i,k+1))/dp - dqtdp = (qtmix(i,k) - qtmix(i,k+1))/dp - slcl = smix(i,k+1) + dsdp* (pl(i)-p(i,k+1)) - qtlcl = qtmix(i,k+1) + dqtdp*(pl(i)-p(i,k+1)) - - tfguess = tmix(i,k) - rcall = 3 - call ientropy (rcall,i,lchnk,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) - -! write(iulog,*)' ' -! write(iulog,*)' p',p(i,k+1),pl(i),p(i,lcl(i)) -! write(iulog,*)' t',tmix(i,k+1),tl(i),tmix(i,lcl(i)) -! write(iulog,*)' s',smix(i,k+1),slcl,smix(i,lcl(i)) -! write(iulog,*)'qt',qtmix(i,k+1),qtlcl,qtmix(i,lcl(i)) -! write(iulog,*)'qs',qsmix(i,k+1),qslcl,qsmix(i,lcl(i)) - - endif -! - end if ! k < klaunch - - - end do ! Levels loop -end do ! Columns loop - -!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! Could stop now and test with this as it will provide some estimate of buoyancy -!! without the effects of freezing/condensation taken into account for tmix. - -!! So we now have a profile of entropy and total water of the entraining parcel -!! Varying with height from the launch level klaunch parcel=environment. To the -!! top allowed level for the existence of convection. - -!! Now we have to adjust these values such that the water held in vaopor is < or -!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of -!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously -!! provides latent heating to the mixed parcel and so this has to be added back -!! to it. But does this also increase qsmix as well? Also freezing processes - - -xsh2o = 0._r8 -ds_xsh2o = 0._r8 -ds_freeze = 0._r8 - -!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Iterate solution twice for accuracy - - - -do k = pver, msg+1, -1 - do i=1,ncol - -! Initialize variables at k=klaunch - - if (k == klaunch(i)) then - -! Set parcel values at launch level assume no liquid water. - - tp(i,k) = tmix(i,k) - qstp(i,k) = q(i,k) - tpv(i,k) = (tp(i,k) + tp_fac*tpertg(i)) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) - - end if - - if (k < klaunch(i)) then - -! Initiaite loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. - -! Iterate nit_lheat times for s,qt changes. - - do ii=0,nit_lheat-1 - -! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). - - xsh2o(i,k) = max (0._r8, qtmix(i,k) - qsmix(i,k) - lwmax) - -! Contribution to ds from precip loss of condensate (Accumulated change from smix).(-ve) - - ds_xsh2o(i,k) = ds_xsh2o(i,k+1) - cpliq * log (tmix(i,k)/tfreez) * max(0._r8,(xsh2o(i,k)-xsh2o(i,k+1))) -! -! Entropy of freezing: latice times amount of water involved divided by T. -! - - if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) == 0._r8) then ! One off freezing of condensate. - ds_freeze(i,k) = (latice/tmix(i,k)) * max(0._r8,qtmix(i,k)-qsmix(i,k)-xsh2o(i,k)) ! Gain of LH - end if - - if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) /= 0._r8) then ! Continual freezing of additional condensate. - ds_freeze(i,k) = ds_freeze(i,k+1)+(latice/tmix(i,k)) * max(0._r8,(qsmix(i,k+1)-qsmix(i,k))) - end if - -! Adjust entropy and accordingly to sum of ds (be careful of signs). - - new_s = smix(i,k) + ds_xsh2o(i,k) + ds_freeze(i,k) - -! Adjust liquid water and accordingly to xsh2o. - - new_q = qtmix(i,k) - xsh2o(i,k) - -! Invert entropy to get updated Tmix and qsmix of parcel. - - tfguess = tmix(i,k) - rcall =4 - call ientropy (rcall,i,lchnk,new_s, p(i,k), new_q, tmix(i,k), qsmix(i,k), tfguess) - - end do ! Iteration loop for freezing processes. - -! tp - Parcel temp is temp of mixture. -! tpv - Parcel v. temp should be density temp with new_q total water. - - tp(i,k) = tmix(i,k) - -! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) - - if (new_q > qsmix(i,k)) then ! Super-saturated so condensate present - reduces buoyancy. - qstp(i,k) = qsmix(i,k) - else ! Just saturated/sub-saturated - no condensate virtual effects. - qstp(i,k) = new_q - end if - - tpv(i,k) = (tp(i,k)+tp_fac*tpertg(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) - - end if ! k < klaunch - - end do ! Loop for columns - -end do ! Loop for vertical levels. - - -return -end subroutine parcel_dilute - -!----------------------------------------------------------------------------------------- -real(r8) function entropy(TK,p,qtot) -!----------------------------------------------------------------------------------------- -! -! TK(K),p(mb),qtot(kg/kg) -! from Raymond and Blyth 1992 -! - real(r8), intent(in) :: p,qtot,TK - real(r8) :: qv,qst,e,est,L - real(r8), parameter :: pref = 1000._r8 - -L = rl - (cpliq - cpwv)*(TK-tfreez) ! T IN CENTIGRADE - -call qsat_hPa(TK, p, est, qst) - -qv = min(qtot,qst) ! Partition qtot into vapor part only. -e = qv*p / (eps1 +qv) - -entropy = (cpres + qtot*cpliq)*log( TK/tfreez) - rgas*log( (p-e)/pref ) + & - L*qv/TK - qv*rh2o*log(qv/qst) - -end FUNCTION entropy - -! -!----------------------------------------------------------------------------------------- -SUBROUTINE ientropy (rcall,icol,lchnk,s,p,qt,T,qst,Tfg) -!----------------------------------------------------------------------------------------- -! -! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). -! Inverts entropy, pressure and total water qt -! for T and saturated vapor mixing ratio -! - - use phys_grid, only: get_rlon_p, get_rlat_p - - integer, intent(in) :: icol, lchnk, rcall - real(r8), intent(in) :: s, p, Tfg, qt - real(r8), intent(out) :: qst, T - real(r8) :: est, this_lat,this_lon - real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol - integer :: i - - logical :: converged - - ! Max number of iteration loops. - integer, parameter :: LOOPMAX = 100 - real(r8), parameter :: EPS = 3.e-8_r8 - - converged = .false. - - ! Invert the entropy equation -- use Brent's method - ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. - - T = Tfg ! Better first guess based on Tprofile from conv. - - a = Tfg-10 !low bracket - b = Tfg+10 !high bracket - - fa = entropy(a, p, qt) - s - fb = entropy(b, p, qt) - s - - c=b - fc=fb - tol=0.001_r8 - - converge: do i=0, LOOPMAX - if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & - (fb < 0.0_r8 .and. fc < 0.0_r8)) then - c=a - fc=fa - d=b-a - ebr=d - end if - if (abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - end if - - tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol - xm=0.5_r8*(c-b) - converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) - if (converged) exit converge - - if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then - sbr=fb/fa - if (a == c) then - pbr=2.0_r8*xm*sbr - qbr=1.0_r8-sbr - else - qbr=fa/fc - rbr=fb/fc - pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) - qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) - end if - if (pbr > 0.0_r8) qbr=-qbr - pbr=abs(pbr) - if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then - ebr=d - d=pbr/qbr - else - d=xm - ebr=d - end if - else - d=xm - ebr=d - end if - a=b - fa=fb - b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) - - fb = entropy(b, p, qt) - s - - end do converge - - T = b - call qsat_hPa(T, p, est, qst) - - if (.not. converged) then - this_lat = get_rlat_p(lchnk, icol)*57.296_r8 - this_lon = get_rlon_p(lchnk, icol)*57.296_r8 - write(iulog,*) '*** ZM_CONV: IENTROPY: Failed and about to exit, info follows ****' - write(iulog,100) 'ZM_CONV: IENTROPY. Details: call#,lchnk,icol= ',rcall,lchnk,icol, & - ' lat: ',this_lat,' lon: ',this_lon, & - ' P(mb)= ', p, ' Tfg(K)= ', Tfg, ' qt(g/kg) = ', 1000._r8*qt, & - ' qst(g/kg) = ', 1000._r8*qst,', s(J/kg) = ',s - call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') - end if - -100 format (A,I1,I4,I4,7(A,F6.2)) - -end SUBROUTINE ientropy - -! Wrapper for qsat_water that does translation between Pa and hPa -! qsat_water uses Pa internally, so get it right, need to pass in Pa. -! Afterward, set es back to hPa. -elemental subroutine qsat_hPa(t, p, es, qm) - use wv_saturation, only: qsat_water - - ! Inputs - real(r8), intent(in) :: t ! Temperature (K) - real(r8), intent(in) :: p ! Pressure (hPa) - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) - real(r8), intent(out) :: qm ! Saturation mass mixing ratio - ! (vapor mass over dry mass, kg/kg) - - call qsat_water(t, p*100._r8, es, qm) - - es = es*0.01_r8 - -end subroutine qsat_hPa - end module zm_conv diff --git a/components/eam/src/physics/cam/zm_conv_cape.F90 b/components/eam/src/physics/cam/zm_conv_cape.F90 new file mode 100644 index 000000000000..f5a9e53301e9 --- /dev/null +++ b/components/eam/src/physics/cam/zm_conv_cape.F90 @@ -0,0 +1,643 @@ +module zm_conv_cape + !---------------------------------------------------------------------------- + ! Purpose: CAPE calculation methods for ZM deep convection scheme + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_abortutils, only: endrun + use zm_conv_util, only: entropy, ientropy, qsat_hPa + use zm_conv_types, only: zm_const_t, zm_param_t + + implicit none + private + + public :: compute_dilute_cape ! calculate convective available potential energy (CAPE) with dilute parcel ascent + + real(r8), parameter :: lcl_pressure_threshold = 600._r8 ! if LCL pressure is lower => no convection and cape is zero + real(r8), parameter :: ull_upper_launch_pressure = 600._r8 ! upper search limit for unrestricted launch level (ULL) + real(r8), parameter :: pergro_rhd_threshold = -1.e-4_r8 ! MSE difference threshold for perturbation growth test +!=================================================================================================== +contains +!=================================================================================================== + +subroutine compute_dilute_cape( pcols, ncol, pver, pverp, & + num_cin, num_msg, & + sp_humidity_in, temperature_in, & + zmid, pmid, pint, pblt, tpert, & + parcel_temp, parcel_qsat, msemax_klev, & + lcl_temperature, lcl_klev, & + eql_klev, cape, & + zm_const, zm_param, & + iclosure, dcapemx, & + use_input_tq_mx, q_mx, t_mx ) + !---------------------------------------------------------------------------- + ! Purpose: calculate convective available potential energy (CAPE), lifting + ! condensation level (LCL), and convective top with dilute parcel ascent + ! Method: parcel temperature based on a plume model with constant entrainment + ! Original Author: Richard Neale - September 2004 + ! References: + ! Raymond, D. J., and A. M. Blyth, 1986: A Stochastic Mixing Model for + ! Nonprecipitating Cumulus Clouds. J. Atmos. Sci., 43, 2708–2718 + ! Raymond, D. J., and A. M. Blyth, 1992: Extension of the Stochastic Mixing + ! Model to Cumulonimbus Clouds. J. Atmos. Sci., 49, 1968–1983 + !---------------------------------------------------------------------------- + implicit none + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: pcols ! number of atmospheric columns (max) + integer, intent(in ) :: ncol ! number of atmospheric columns (actual) + integer, intent(in ) :: pver ! number of mid-point vertical levels + integer, intent(in ) :: pverp ! number of interface vertical levels + integer, intent(in ) :: num_cin ! num of negative buoyancy regions that are allowed before the conv. top and CAPE calc are completed + integer, intent(in ) :: num_msg ! index of highest level convection is allowed + real(r8), dimension(pcols,pver), intent(in ) :: sp_humidity_in ! specific humidity + real(r8), dimension(pcols,pver), intent(in ) :: temperature_in ! temperature + real(r8), dimension(pcols,pver), intent(in ) :: zmid ! altitude/height at mid-levels + real(r8), dimension(pcols,pver), intent(in ) :: pmid ! pressure at mid-levels + real(r8), dimension(pcols,pverp), intent(in ) :: pint ! pressure at interfaces + integer, dimension(pcols), intent(in ) :: pblt ! index of pbl top used as upper limit index of max MSE search + real(r8), dimension(pcols), intent(in ) :: tpert ! perturbation temperature by pbl processes + real(r8), dimension(pcols,pver), intent( out) :: parcel_temp ! parcel temperature + real(r8), dimension(pcols,pver), intent(inout) :: parcel_qsat ! parcel saturation mixing ratio + integer, dimension(pcols), intent(inout) :: msemax_klev ! index of max MSE at parcel launch level + real(r8), dimension(pcols), intent( out) :: lcl_temperature ! lifting condensation level (LCL) temperature + integer, dimension(pcols), intent(inout) :: lcl_klev ! index of lifting condensation level (i.e. cloud bottom) + integer, dimension(pcols), intent(inout) :: eql_klev ! index of equilibrium level (i.e. cloud top) + real(r8), dimension(pcols), intent(inout) :: cape ! convective available potential energy + type(zm_const_t), intent(in ) :: zm_const ! derived type to hold ZM constants + type(zm_param_t), intent(in ) :: zm_param ! derived type to hold ZM tunable parameters + logical, intent(in ) :: iclosure ! true for normal procedure, otherwise use dcapemx from 1st call + integer, dimension(pcols), optional, intent(in ) :: dcapemx ! values of msemax_klev from previous call for dcape closure + logical, optional, intent(in ) :: use_input_tq_mx ! if .true., use input values of dcapemx, q_mx, t_mx in the CAPE calculation + real(r8), dimension(pcols), optional, intent(inout) :: q_mx ! specified sp humidity to apply at level of max MSE if use_input_tq_mx=.true. + real(r8), dimension(pcols), optional, intent(inout) :: t_mx ! specified temperature to apply at level of max MSE if use_input_tq_mx=.true. + !---------------------------------------------------------------------------- + ! Local variables + real(r8), dimension(pcols,pver) :: sp_humidity ! local version of specific humidity + real(r8), dimension(pcols,pver) :: temperature ! local version of temperature + real(r8), dimension(pcols,pver) :: tv ! virtual temperature + real(r8), dimension(pcols,pver) :: parcel_vtemp ! parcel virtual temperature + real(r8), dimension(pcols) :: lcl_pmid ! lifting condensation level (LCL) pressure + real(r8), dimension(pcols) :: mse_max_val ! value of max MSE at parcel launch level + integer, dimension(pcols) :: pblt_ull ! upper limit index of max MSE search for ULL + integer, dimension(pcols) :: msemax_top_k ! upper limit index of max MSE search + + integer :: i, k ! loop iterators + logical :: pergro_active ! flag for perturbation growth test (pergro) + logical :: use_input_tq_mx_loc ! flag to use input parcel temperature and specific humidity + !---------------------------------------------------------------------------- + ! set flag for perturbation growth test +#ifdef PERGRO + pergro_active = .true. +#else + pergro_active = .false. +#endif + !---------------------------------------------------------------------------- + use_input_tq_mx_loc = .false. + if (present(use_input_tq_mx)) use_input_tq_mx_loc = use_input_tq_mx + + if ( use_input_tq_mx_loc .and. & + ((.not.present(t_mx)) .or. & + (.not.present(q_mx)) .or. & + (.not.present(dcapemx)) ) ) then + call endrun('compute_dilute_cape: use_input_tq_mx = .true. but dcapemx, t_mx or q_mx is not provided') + end if + + !---------------------------------------------------------------------------- + ! Copy the incoming temperature and specific humidity values to local arrays + temperature(:ncol,:) = temperature_in(:ncol,:) + sp_humidity(:ncol,:) = sp_humidity_in(:ncol,:) + + !---------------------------------------------------------------------------- + ! initialize msemax_klev and potentially modify T/q + if (use_input_tq_mx_loc) then + ! note - in this case we expect: + ! (1) the incoming array dcapemx contains prev identified launching level index, and + ! (2) the arrays q_mx and t_mx contain q and T values at the old launching level + ! at the time when the old launching level was identified. + ! Copy the old values to work arrays for calculations in the rest of this subroutine + msemax_klev(:ncol) = dcapemx(:ncol) + do i=1,ncol + sp_humidity(i,msemax_klev(i)) = q_mx(i) + temperature(i,msemax_klev(i)) = t_mx(i) + end do + else + msemax_klev(:) = pver + end if + + !---------------------------------------------------------------------------- + ! Initialize parcel properties + parcel_temp(1:ncol,1:pver) = temperature(1:ncol,1:pver) + parcel_qsat(1:ncol,1:pver) = sp_humidity(1:ncol,1:pver) + tv (1:ncol,1:pver) = temperature(1:ncol,1:pver) & + * ( 1._r8+zm_const%zvir*sp_humidity(1:ncol,1:pver) ) & + / ( 1._r8+sp_humidity(1:ncol,1:pver) ) + parcel_vtemp (1:ncol,1:pver) = tv(1:ncol,1:pver) + + !---------------------------------------------------------------------------- + ! Find new upper bound for parcel starting level - unrestricted launch level (ULL) + if (zm_param%trig_ull) then + pblt_ull(:) = 1 + do k = pver-1, num_msg+1, -1 + do i = 1,ncol + if ( (pmid(i,k) .le.ull_upper_launch_pressure) .and. & + (pmid(i,k+1).gt.ull_upper_launch_pressure) ) then + pblt_ull(i) = k + end if + end do + end do + endif + + !---------------------------------------------------------------------------- + ! Set level of max moist static energy for parcel initialization + if ( zm_param%trig_dcape .and. (.not.iclosure) ) then + ! Use max moist static energy level that is passed in + if (.not.present(dcapemx)) call endrun('** ZM CONV compute_dilute_cape: dcapemx not present **') + msemax_klev(1:ncol) = dcapemx(1:ncol) + elseif (.not.use_input_tq_mx_loc) then + if ( zm_param%trig_ull) msemax_top_k(:ncol) = pblt_ull(:ncol) + if (.not.zm_param%trig_ull) msemax_top_k(:ncol) = pblt(:ncol) + call find_mse_max( pcols, ncol, pver, num_msg, msemax_top_k, pergro_active, & + temperature, zmid, sp_humidity, zm_const, zm_param, & + msemax_klev, mse_max_val ) + end if + + !---------------------------------------------------------------------------- + do i=1,ncol + ! Save launching level T, q for output + if ( .not.use_input_tq_mx_loc .and. present(q_mx) .and. present(t_mx) ) then + q_mx(i) = sp_humidity(i,msemax_klev(i)) + t_mx(i) = temperature(i,msemax_klev(i)) + end if + ! save LCL values for compute_dilute_parcel() + lcl_klev(i) = msemax_klev(i) + lcl_pmid(i) = pmid(i,msemax_klev(i)) + lcl_temperature(i) = temperature(i,msemax_klev(i)) + end do + + !---------------------------------------------------------------------------- + ! entraining parcel calculation + call compute_dilute_parcel( pcols, ncol, pver, num_msg, msemax_klev, & + pmid, temperature, sp_humidity, tpert, pblt, & + zm_const, zm_param, & + parcel_temp, parcel_vtemp, parcel_qsat, & + lcl_pmid, lcl_temperature, lcl_klev ) + + !---------------------------------------------------------------------------- + ! calculate CAPE + call compute_cape_from_parcel( pcols, ncol, pver, pverp, num_cin, num_msg, & + temperature, tv, zmid, sp_humidity, pint, & + msemax_klev, lcl_pmid, lcl_klev, & + zm_const, zm_param, & + parcel_qsat, parcel_temp, parcel_vtemp, & + eql_klev, cape ) + + !---------------------------------------------------------------------------- + return + +end subroutine compute_dilute_cape + +!=================================================================================================== + +subroutine find_mse_max( pcols, ncol, pver, num_msg, msemax_top_k, pergro_active, & + temperature, zmid, sp_humidity, zm_const, zm_param, & + msemax_klev, mse_max_val) + !---------------------------------------------------------------------------- + ! Purpose: find level of max moist static energy for parcel initialization + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: pcols ! number of atmospheric columns (max) + integer, intent(in ) :: ncol ! number of atmospheric columns (actual) + integer, intent(in ) :: pver ! number of mid-point vertical levels + integer, intent(in ) :: num_msg ! number of missing moisture levels at the top of model + integer, dimension(pcols), intent(in ) :: msemax_top_k ! upper limit index of max MSE search + logical, intent(in ) :: pergro_active ! flag for perturbation growth test (pergro) + real(r8), dimension(pcols,pver), intent(in ) :: temperature ! environement temperature + real(r8), dimension(pcols,pver), intent(in ) :: zmid ! height/altitude at mid-levels + real(r8), dimension(pcols,pver), intent(in ) :: sp_humidity ! specific humidity + type(zm_const_t), intent(in ) :: zm_const ! derived type to hold ZM constants + type(zm_param_t), intent(in ) :: zm_param ! derived type to hold ZM tunable parameters + integer, dimension(pcols), intent(inout) :: msemax_klev ! index of max MSE at parcel launch level + real(r8), dimension(pcols), intent(inout) :: mse_max_val ! value of max MSE at parcel launch level + !---------------------------------------------------------------------------- + ! Local variables + integer :: i,k ! loop iterators + integer :: bot_layer ! lower limit to search for parcel launch level + real(r8) :: pergro_rhd ! relative MSE (h) difference for perturbation growth test (pergro) + real(r8), dimension(pcols) :: mse_env ! env moist static energy + !---------------------------------------------------------------------------- + ! initialize values + mse_max_val(1:ncol) = 0._r8 + bot_layer = pver - zm_param%mx_bot_lyr_adj ! set lower limit to search for launch level with max MSE + !---------------------------------------------------------------------------- + do k = bot_layer, num_msg+1, -1 + do i = 1,ncol + ! calculate moist static energy + mse_env(i) = zm_const%cpair*temperature(i,k) + zm_const%grav*zmid(i,k) + zm_const%latvap*sp_humidity(i,k) + if (pergro_active) then + ! Reset max moist static energy level when relative difference exceeds 1.e-4 + pergro_rhd = (mse_env(i) - mse_max_val(i))/(mse_env(i) + mse_max_val(i)) + if (k >= msemax_top_k(i) .and. pergro_rhd > pergro_rhd_threshold) then + mse_max_val(i) = mse_env(i) + msemax_klev(i) = k + end if + else + ! find level and value of max moist static energy + if (k >= msemax_top_k(i) .and. mse_env(i) > mse_max_val(i)) then + mse_max_val(i) = mse_env(i) + msemax_klev(i) = k + end if + end if + end do + end do + !---------------------------------------------------------------------------- +end subroutine find_mse_max + +!=================================================================================================== + +subroutine compute_dilute_parcel( pcols, ncol, pver, num_msg, klaunch, & + pmid, temperature, sp_humidity, tpert, pblt, & + zm_const, zm_param, & + parcel_temp, parcel_vtemp, parcel_qsat, & + lcl_pmid, lcl_temperature, lcl_klev ) + !---------------------------------------------------------------------------- + ! Purpose: Calculate thermodynamic properties of an entraining air parcel + ! lifted from the PBL using fractional mass entrainment rate + ! specified by zm_param%dmpdz + !---------------------------------------------------------------------------- + implicit none + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: pcols ! number of atmospheric columns (max) + integer, intent(in ) :: ncol ! number of atmospheric columns (actual) + integer, intent(in ) :: pver ! number of mid-point vertical levels + integer, intent(in ) :: num_msg ! number of missing moisture levels at the top of model + integer, dimension(pcols), intent(in ) :: klaunch ! index of parcel launch level based on max MSE + real(r8), dimension(pcols,pver), intent(in ) :: pmid ! ambient env pressure at cell center + real(r8), dimension(pcols,pver), intent(in ) :: temperature ! ambient env temperature at cell center + real(r8), dimension(pcols,pver), intent(in ) :: sp_humidity ! ambient env specific humidity at cell center + real(r8), dimension(pcols), intent(in ) :: tpert ! PBL temperature perturbation + integer, dimension(pcols), intent(in ) :: pblt ! index of pbl depth + type(zm_const_t), intent(in ) :: zm_const ! derived type to hold ZM constants + type(zm_param_t), intent(in ) :: zm_param ! derived type to hold ZM tunable parameters + real(r8), dimension(pcols,pver), intent(inout) :: parcel_temp ! Parcel temperature + real(r8), dimension(pcols,pver), intent(inout) :: parcel_vtemp ! Parcel virtual temperature + real(r8), dimension(pcols,pver), intent(inout) :: parcel_qsat ! Parcel water vapour (sat value above lcl) + real(r8), dimension(pcols) , intent(inout) :: lcl_pmid ! lifting condensation level (LCL) pressure + real(r8), dimension(pcols) , intent(inout) :: lcl_temperature ! lifting condensation level (LCL) temperature + integer, dimension(pcols) , intent(inout) :: lcl_klev ! lifting condensation level (LCL) vertical index + !---------------------------------------------------------------------------- + ! Local variables + integer i,k,ii ! loop iterators + + real(r8), dimension(pcols,pver) :: tmix ! tempertaure of the entraining parcel. + real(r8), dimension(pcols,pver) :: qtmix ! total water of the entraining parcel. + real(r8), dimension(pcols,pver) :: qsmix ! saturated mixing ratio at the tmix. + real(r8), dimension(pcols,pver) :: smix ! entropy of the entraining parcel. + real(r8), dimension(pcols,pver) :: xsh2o ! precipitate lost from parcel. + real(r8), dimension(pcols,pver) :: ds_xsh2o ! entropy change due to loss of condensate. + real(r8), dimension(pcols,pver) :: ds_freeze ! entropy change sue to freezing of precip. + + real(r8), dimension(pcols) :: mp ! parcel mass flux + real(r8), dimension(pcols) :: qtp ! parcel total water + real(r8), dimension(pcols) :: sp ! parcel entropy + real(r8), dimension(pcols) :: sp0 ! parcel launch entropy + real(r8), dimension(pcols) :: qtp0 ! parcel launch total water + real(r8), dimension(pcols) :: mp0 ! parcel launch relative mass [0-1] + + real(r8), dimension(pcols) :: tpert_loc ! gather parcel temperature perturbation + + real(r8) dmpdp ! parcel fractional mass entrainment rate [1/mb] + real(r8) dpdz ! hydrstatic relation + real(r8) dzdp ! inverse hydrstatic relation + real(r8) senv ! environmental entropy + real(r8) qtenv ! environmental total water + real(r8) penv ! environmental total pressure + real(r8) tenv ! environmental total temperature + real(r8) new_s ! hold value for entropy after condensation/freezing adjustments + real(r8) new_q ! hold value for total water after condensation/freezing adjustments + real(r8) dp ! layer thickness (center to center) + real(r8) tfguess ! first guess for entropy inversion + real(r8) tscool ! super cooled temperature offset from freezing temperature when cloud water loading freezes + + real(r8) qxsk ! LCL excess water @ k + real(r8) qxskp1 ! LCL excess water @ k+1 + real(r8) dsdp ! LCL entropy gradient @ k + real(r8) dqtdp ! LCL total water gradient @ k + real(r8) dqxsdp ! LCL excess water gradient @ k+1 + real(r8) slcl ! LCL entropy + real(r8) qtlcl ! LCL total water + real(r8) qslcl ! LCL saturated vapor mixing ratio + + integer rcall ! ientropy call id for error message + + integer, parameter :: nit_lheat = 2 ! Number of iterations for condensation/freezing loop + real(r8), parameter :: lwmax = 1.e-3_r8 ! maximum condesate that can be held in cloud before rainout + + !---------------------------------------------------------------------------- + ! initialize values + tscool = 0._r8 + qtmix = 0._r8 + smix = 0._r8 + qtenv = 0._r8 + senv = 0._r8 + tenv = 0._r8 + penv = 0._r8 + qtp0 = 0._r8 + sp0 = 0._r8 + mp0 = 0._r8 + qtp = 0._r8 + sp = 0._r8 + mp = 0._r8 + new_q = 0._r8 + new_s = 0._r8 + !---------------------------------------------------------------------------- + ! The original ZM scheme only treated PBL-rooted convection. A PBL temperature + ! perturbation (tpert) was then used to increase the parcel temperatue at launch + ! level, which is in PBL. The dcape_ull or ull triggr enables ZM scheme to treat + ! elevated convection with launch level above PBL. If parcel launch level is + ! above PBL top, tempeature perturbation in PBL should not be able to influence + ! it. In this situation, the temporary variable tpert_loc is reset to zero. + do i=1,ncol + tpert_loc(i) = tpert(i) + if ( zm_param%tpert_fix .and. klaunch(i)qtmix(i,k+1) ) then + lcl_klev(i) = k + qxsk = qtmix(i,k) - qsmix(i,k) + qxskp1 = qtmix(i,k+1) - qsmix(i,k+1) + dqxsdp = (qxsk - qxskp1)/dp + lcl_pmid(i) = pmid(i,k+1) - qxskp1/dqxsdp + dsdp = (smix(i,k) - smix(i,k+1))/dp + dqtdp = (qtmix(i,k) - qtmix(i,k+1))/dp + slcl = smix(i,k+1) + dsdp* (lcl_pmid(i)-pmid(i,k+1)) + qtlcl = qtmix(i,k+1) + dqtdp*(lcl_pmid(i)-pmid(i,k+1)) + tfguess = tmix(i,k) + rcall = 3 + call ientropy( rcall, slcl, lcl_pmid(i), qtlcl, lcl_temperature(i), qslcl, tfguess, zm_const ) + endif + + end if ! k < klaunch + + end do ! i = 1,ncol + end do ! k = pver, num_msg+1, -1 + !---------------------------------------------------------------------------- + ! end of entrainment loop + + !---------------------------------------------------------------------------- + ! We now have a profile of entropy and total water of the entraining parcel + ! Varying with height from the launch level klaunch parcel=environment. To the + ! top allowed level for the existence of convection. If we stop now it will + ! provide some estimate of buoyancy without the effects of freezing/condensation. + ! + ! Instead, we will adjust these values such that the water held in vapor is + ! <=qsmix. We assume that the cloud holds a certain amount of condensate (lwmax) + ! and the rest is rained out (xsh2o). This provides latent heating to the + ! mixed parcel and so this has to be added back to it. + + !---------------------------------------------------------------------------- + ! precipitation/freezing loop - iterate twice for accuracy + xsh2o = 0._r8 + ds_xsh2o = 0._r8 + ds_freeze = 0._r8 + do k = pver, num_msg+1, -1 + do i = 1,ncol + + if ( k == klaunch(i) ) then + + ! initialize values at launch level - assume no liquid water + parcel_temp(i,k) = tmix(i,k) + parcel_qsat(i,k) = sp_humidity(i,k) + parcel_vtemp(i,k) = ( parcel_temp(i,k) +zm_param%tpert_fac*tpert_loc(i) ) & + * (1._r8+zm_const%zvir*parcel_qsat(i,k)) / (1._r8+parcel_qsat(i,k)) + + elseif ( k < klaunch(i) ) then + + ! iterate nit_lheat times for s,qt changes + do ii = 0,nit_lheat-1 + + ! rain (xsh2o) is excess condensate, bar lwmax (accumulated loss from qtmix) + xsh2o(i,k) = max (0._r8, qtmix(i,k) - qsmix(i,k) - lwmax) + + ! contribution to ds from precip loss of condensate (accumulated change from smix) + ds_xsh2o(i,k) = ds_xsh2o(i,k+1) - zm_const%cpliq * log (tmix(i,k)/zm_const%tfreez) * max(0._r8,(xsh2o(i,k)-xsh2o(i,k+1))) + + ! calculate entropy of freezing => ( latice x amount of water involved ) / T + + ! one off freezing of condensate + if (tmix(i,k) <= (zm_const%tfreez+tscool) .and. ds_freeze(i,k+1) == 0._r8) then + ! entropy change from latent heat + ds_freeze(i,k) = (zm_const%latice/tmix(i,k)) * max(0._r8,qtmix(i,k)-qsmix(i,k)-xsh2o(i,k)) + end if + + if (tmix(i,k) <= zm_const%tfreez+tscool .and. ds_freeze(i,k+1) /= 0._r8) then + ! continual freezing of additional condensate + ds_freeze(i,k) = ds_freeze(i,k+1)+(zm_const%latice/tmix(i,k)) * max(0._r8,(qsmix(i,k+1)-qsmix(i,k))) + end if + + ! adjust entropy and accordingly to sum of ds (be careful of signs) + new_s = smix(i,k) + ds_xsh2o(i,k) + ds_freeze(i,k) + + ! adjust liquid water and accordingly to xsh2o + new_q = qtmix(i,k) - xsh2o(i,k) + + ! invert entropy to get updated Tmix and qsmix of parcel + tfguess = tmix(i,k) + rcall =4 + call ientropy( rcall, new_s, pmid(i,k), new_q, tmix(i,k), qsmix(i,k), tfguess, zm_const ) + + end do ! iteration loop for freezing processes + + ! parcel temp is temp of mixture + ! parcel virtual temp should be density temp with new_q total water + parcel_temp(i,k) = tmix(i,k) + + ! parcel_vtemp=tprho in the presence of condensate (i.e. when new_q > qsmix) + if (new_q > qsmix(i,k)) then ! super-saturated so condensate present - reduces buoyancy + parcel_qsat(i,k) = qsmix(i,k) + else ! just saturated/sub-saturated - no condensate virtual effects + parcel_qsat(i,k) = new_q + end if + + parcel_vtemp(i,k) = ( parcel_temp(i,k) +zm_param%tpert_fac*tpert_loc(i) ) & + * (1._r8+zm_const%zvir*parcel_qsat(i,k)) / (1._r8+ new_q) + + end if ! k < klaunch + + end do ! i = 1,ncol + end do ! k = pver, num_msg+1, -1 + + !---------------------------------------------------------------------------- + return + +end subroutine compute_dilute_parcel + +!=================================================================================================== + +subroutine compute_cape_from_parcel( pcols, ncol, pver, pverp, num_cin, num_msg, & + temperature, tv, zmid, sp_humidity, pint, & + msemax_klev, lcl_pmid, lcl_klev, & + zm_const, zm_param, & + parcel_qsat, parcel_temp, parcel_vtemp, & + eql_klev, cape ) + !---------------------------------------------------------------------------- + ! Purpose: calculate convective available potential energy (CAPE) + ! from parcel thermodynamic properties from compute_dilute_parcel() + !---------------------------------------------------------------------------- + integer, intent(in ) :: pcols ! number of atmospheric columns (max) + integer, intent(in ) :: ncol ! number of atmospheric columns (actual) + integer, intent(in ) :: pver ! number of mid-point vertical levels + integer, intent(in ) :: pverp ! number of interface vertical levels + integer, intent(in ) :: num_cin ! num of negative buoyancy regions that are allowed before the conv. top and CAPE calc are completed + integer, intent(in ) :: num_msg ! number of missing moisture levels at the top of model + real(r8), dimension(pcols,pver), intent(in ) :: temperature ! temperature + real(r8), dimension(pcols,pver), intent(in ) :: tv ! virtual temperature + real(r8), dimension(pcols,pver), intent(in ) :: zmid ! height/altitude at mid-levels + real(r8), dimension(pcols,pver), intent(in ) :: sp_humidity ! specific humidity + real(r8), dimension(pcols,pverp),intent(in ) :: pint ! pressure at interfaces + integer, dimension(pcols), intent(in ) :: msemax_klev ! index of max MSE at parcel launch level + real(r8), dimension(pcols), intent(in ) :: lcl_pmid ! lifting condensation level (LCL) pressure + integer, dimension(pcols), intent(in ) :: lcl_klev ! lifting condensation level (LCL) index + type(zm_const_t), intent(in ) :: zm_const ! derived type to hold ZM constants + type(zm_param_t), intent(in ) :: zm_param ! derived type to hold ZM tunable parameters + real(r8), dimension(pcols,pver), intent(inout) :: parcel_qsat ! parcel saturation mixing ratio + real(r8), dimension(pcols,pver), intent(inout) :: parcel_temp ! parcel temperature + real(r8), dimension(pcols,pver), intent(inout) :: parcel_vtemp ! parcel virtual temperature + integer, dimension(pcols), intent(inout) :: eql_klev ! index of equilibrium level (i.e. cloud top) + real(r8), dimension(pcols), intent(inout) :: cape ! convective available potential energy + !---------------------------------------------------------------------------- + ! Local variables + integer :: i, k, n ! loop iterators + real(r8), dimension(pcols,pver) :: buoyancy ! parcel buoyancy + real(r8), dimension(pcols,num_cin) :: cape_tmp ! provisional value of cape + integer, dimension(pcols,num_cin) :: eql_klev_tmp ! provisional value of equilibrium level index + integer, dimension(pcols) :: neg_buoyancy_cnt ! counter for levels with negative bounancy + + logical plge600(pcols) ! for testing - remove! + !---------------------------------------------------------------------------- + ! Initialize variables + eql_klev (1:ncol) = pver + eql_klev_tmp (1:ncol,1:num_cin) = pver + cape (1:ncol) = 0._r8 + cape_tmp (1:ncol,1:num_cin) = 0._r8 + buoyancy (1:ncol,1:pver) = 0._r8 + neg_buoyancy_cnt(1:ncol) = 0 + !---------------------------------------------------------------------------- + ! Calculate buoyancy + do k = pver, num_msg+1, -1 + do i=1,ncol + ! Define buoyancy from launch level to equilibrium level + if ( k <= msemax_klev(i) .and. lcl_pmid(i).ge.lcl_pressure_threshold ) then + buoyancy(i,k) = parcel_vtemp(i,k) - tv(i,k) + zm_param%tiedke_add + else + parcel_qsat(i,k) = sp_humidity(i,k) + parcel_temp(i,k) = temperature(i,k) + parcel_vtemp(i,k) = tv(i,k) + endif + end do + end do + + !---------------------------------------------------------------------------- + ! find convective equilibrium level accounting for negative buoyancy levels + do k = num_msg+2, pver + do i = 1,ncol + if ( k < lcl_klev(i) .and. lcl_pmid(i).ge.lcl_pressure_threshold ) then + if ( buoyancy(i,k+1) > 0._r8 .and. & + buoyancy(i,k) <=0._r8 ) then + neg_buoyancy_cnt(i) = min( num_cin, neg_buoyancy_cnt(i)+1 ) + eql_klev_tmp(i,neg_buoyancy_cnt(i)) = k + end if + end if + end do + end do + + !---------------------------------------------------------------------------- + ! integrate buoyancy to obtain possible CAPE values + do n = 1,num_cin + do k = num_msg+1, pver + do i = 1,ncol + if ( lcl_pmid(i).ge.lcl_pressure_threshold .and. & + k <= msemax_klev(i) .and. k > eql_klev_tmp(i,n)) then + cape_tmp(i,n) = cape_tmp(i,n) + zm_const%rdair*buoyancy(i,k)*log(pint(i,k+1)/pint(i,k)) + end if + end do + end do + end do + + !---------------------------------------------------------------------------- + ! find maximum cape from all possible tentative CAPE values + ! and use it as the final cape (April 26, 1995) + do n = 1,num_cin + do i = 1,ncol + if (cape_tmp(i,n) > cape(i)) then + cape(i) = cape_tmp(i,n) + eql_klev(i) = eql_klev_tmp(i,n) + end if + end do + end do + + !---------------------------------------------------------------------------- + ! apply limiter to ensure CAPE is positive + do i = 1,ncol + cape(i) = max(cape(i), 0._r8) + end do + + !---------------------------------------------------------------------------- + return + +end subroutine compute_cape_from_parcel + +!=================================================================================================== + +end module zm_conv_cape diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 42673d56a336..13d417857814 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -22,7 +22,7 @@ module zm_conv_intr use zm_conv, only: MCSP, MCSP_heat_coeff, MCSP_moisture_coeff, MCSP_uwind_coeff, MCSP_vwind_coeff use zm_conv, only: zm_microp use zm_transport, only: zm_transport_tracer, zm_transport_momentum - use zm_microphysics, only: zm_aero_t + use zm_aero, only: zm_aero_t use zm_microphysics_state, only: zm_microp_st implicit none @@ -42,13 +42,8 @@ module zm_conv_intr integer :: dp_cldice_idx ! deep conv cloud ice water (kg/kg) integer :: dlfzm_idx ! detrained convective cloud water mixing ratio integer :: difzm_idx ! detrained convective cloud ice mixing ratio - integer :: dsfzm_idx ! detrained convective snow mixing ratio - integer :: dnlfzm_idx ! detrained convective cloud water num concen - integer :: dnifzm_idx ! detrained convective cloud ice num concen - integer :: dnsfzm_idx ! detrained convective snow num concen integer :: prec_dp_idx ! total surface precipitation rate from deep conv integer :: snow_dp_idx ! frozen surface precipitation rate from deep conv - integer :: wuc_idx ! vertical velocity in deep convection integer :: t_star_idx ! DCAPE temperature from previous time step integer :: q_star_idx ! DCAPE water vapor from previous time step integer :: cld_idx ! cloud fraction @@ -77,16 +72,17 @@ module zm_conv_intr real(r8), parameter :: MCSP_shear_min = 3.0_r8 ! min shear value for MCSP to be active real(r8), parameter :: MCSP_shear_max = 200.0_r8 ! max shear value for MCSP to be active +!=================================================================================================== contains - !=================================================================================================== subroutine zm_conv_register !---------------------------------------------------------------------------- ! Purpose: register fields with the physics buffer !---------------------------------------------------------------------------- - use physics_buffer, only : pbuf_add_field, dtype_r8 + use physics_buffer, only: pbuf_add_field, dtype_r8 use misc_diagnostics,only: dcape_diags_register + use zm_microphysics, only: zm_microphysics_register implicit none integer idx @@ -103,9 +99,6 @@ subroutine zm_conv_register ! deep conv cloud liquid water (kg/kg) call pbuf_add_field('DP_CLDICE','global',dtype_r8,(/pcols,pver/), dp_cldice_idx) - ! vertical velocity (m/s) - call pbuf_add_field('WUC','global',dtype_r8,(/pcols,pver/), wuc_idx) - ! previous time step data for DCAPE calculation if (trigdcape_ull .or. trig_dcape_only) then call pbuf_add_field('T_STAR','global',dtype_r8,(/pcols,pver/), t_star_idx) @@ -118,16 +111,7 @@ subroutine zm_conv_register call pbuf_add_field('DIFZM', 'physpkg', dtype_r8, (/pcols,pver/), difzm_idx) ! Only add the number conc fields if the microphysics is active. - if (zm_microp) then - ! detrained convective cloud water num concen. - call pbuf_add_field('DNLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnlfzm_idx) - ! detrained convective cloud ice num concen. - call pbuf_add_field('DNIFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnifzm_idx) - ! detrained convective snow num concen. - call pbuf_add_field('DNSFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnsfzm_idx) - ! detrained convective snow mixing ratio. - call pbuf_add_field('DSFZM', 'physpkg', dtype_r8, (/pcols,pver/), dsfzm_idx) - end if + if (zm_microp) call zm_microphysics_register() ! Register variables for dCAPE diagnosis and decomposition call dcape_diags_register( pcols ) @@ -138,21 +122,24 @@ end subroutine zm_conv_register subroutine zm_conv_init(pref_edge) !---------------------------------------------------------------------------- - ! Purpose: declare output fields, initialize variables needed by convection + ! Purpose: declare output fields, initialize variables needed by convection !---------------------------------------------------------------------------- - use zm_conv, only: zm_convi - use pmgrid, only: plev,plevp - use spmd_utils, only: masterproc - use error_messages, only: alloc_err - use phys_control, only: phys_deepconv_pbl, phys_getopts - use physics_buffer, only: pbuf_get_index - use rad_constituents, only: rad_cnst_get_info - use zm_microphysics, only: zm_mphyi - + use zm_conv, only: zm_convi + use pmgrid, only: plev,plevp + use spmd_utils, only: masterproc + use error_messages, only: alloc_err + use phys_control, only: phys_deepconv_pbl, phys_getopts + use physics_buffer, only: pbuf_get_index + use rad_constituents, only: rad_cnst_get_info + use zm_microphysics, only: zm_mphyi + use zm_aero, only: zm_aero_init + use zm_microphysics_history, only: zm_microphysics_history_init implicit none - + !---------------------------------------------------------------------------- + ! Arguments real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces - + !---------------------------------------------------------------------------- + ! Local variables logical :: no_deep_pbl ! if true, no deep convection in PBL integer :: limcnv ! top interface level limit for convection logical :: history_budget ! output tendencies and state variables for @@ -160,7 +147,7 @@ subroutine zm_conv_init(pref_edge) integer :: history_budget_histfile_num ! output history file number for budget fields integer i, k, istat character(len=*), parameter :: routine = 'zm_conv_init' - + !---------------------------------------------------------------------------- ! Allocate the basic aero structure outside the zmconv_microp logical ! This allows the aero structure to be passed ! Note that all of the arrays inside this structure are conditionally allocated @@ -213,129 +200,6 @@ subroutine zm_conv_init(pref_edge) call addfld('ZM_depth', horiz_only, 'A', 'Pa', 'ZM convection depth') end if - if (zm_microp) then - - call addfld ('CLDLIQZM',(/ 'lev' /), 'A', 'g/m3', 'ZM cloud liq water') - call addfld ('CLDICEZM',(/ 'lev' /), 'A', 'g/m3', 'ZM cloud ice water') - call addfld ('CLIQSNUM',(/ 'lev' /), 'A', '1', 'ZM cloud liq water sample number') - call addfld ('CICESNUM',(/ 'lev' /), 'A', '1', 'ZM cloud ice water sample number') - call addfld ('QRAINZM' ,(/ 'lev' /), 'A', 'g/m3', 'ZM rain water') - call addfld ('QSNOWZM' ,(/ 'lev' /), 'A', 'g/m3', 'ZM snow') - call addfld ('QGRAPZM' ,(/ 'lev' /), 'A', 'g/m3', 'ZM graupel') - call addfld ('CRAINNUM',(/ 'lev' /), 'A', '1', 'ZM cloud rain water sample number') - call addfld ('CSNOWNUM',(/ 'lev' /), 'A', '1', 'ZM cloud snow sample number') - call addfld ('CGRAPNUM',(/ 'lev' /), 'A', '1', 'ZM cloud graupel sample number') - - call addfld ('DIFZM', (/ 'lev' /), 'A', 'kg/kg/s ', 'ZM detrained ice water') - call addfld ('DLFZM', (/ 'lev' /), 'A', 'kg/kg/s ', 'ZM detrained liq water') - call addfld ('DNIFZM', (/ 'lev' /), 'A', '1/kg/s ', 'ZM detrained ice water num concen') - call addfld ('DNLFZM', (/ 'lev' /), 'A', '1/kg/s ', 'ZM detrained liquid water num concen') - call addfld ('WUZM', (/ 'lev' /), 'A', 'm/s', 'ZM vertical velocity') - call addfld ('WUZMSNUM',(/ 'lev' /), 'A', '1', 'ZM vertical velocity sample number') - - call addfld ('QNLZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud liq water number concen') - call addfld ('QNIZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud ice number concen') - call addfld ('QNRZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud rain water number concen') - call addfld ('QNSZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud snow number concen') - call addfld ('QNGZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud graupel number concen') - - call addfld ('FRZZM', (/ 'lev' /), 'A', 'K/s', 'ZM heating tendency due to freezing') - - call addfld ('AUTOL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to autoconversion of droplets to rain') - call addfld ('ACCRL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to accretion of droplets by rain') - call addfld ('BERGN_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to Bergeron process') - call addfld ('FHTIM_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to immersion freezing') - call addfld ('FHTCT_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to contact freezing') - call addfld ('FHML_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to homogeneous freezing of droplet') - call addfld ('HMPI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to HM process') - call addfld ('ACCSL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to accretion of droplet by snow') - call addfld ('DLF_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to detrainment of droplet') - call addfld ('COND_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to condensation') - - call addfld ('AUTOL_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to autoconversion of droplets to rain') - call addfld ('ACCRL_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to accretion of droplets by rain') - call addfld ('BERGN_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to Bergeron process') - call addfld ('FHTIM_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to immersion freezing') - call addfld ('FHTCT_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to contact freezing') - call addfld ('FHML_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to homogeneous freezing of droplet') - call addfld ('ACCSL_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to accretion of droplet by snow') - call addfld ('ACTIV_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to droplets activation') - call addfld ('DLF_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to detrainment of droplet') - - call addfld ('AUTOI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to autoconversion of ice to snow') - call addfld ('ACCSI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to accretion of ice by snow') - call addfld ('DIF_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to detrainment of cloud ice') - call addfld ('DEPOS_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to deposition') - - call addfld ('NUCLI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to ice nucleation') - call addfld ('AUTOI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to autoconversion of ice to snow') - call addfld ('ACCSI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to accretion of ice by snow') - call addfld ('HMPI_N', (/ 'lev' /), 'A', '1/kg/s' , 'ZM num tendency due to HM process') - call addfld ('DIF_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to detrainment of cloud ice') - call addfld ('TRSPC_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of droplets due to convective transport') - call addfld ('TRSPC_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of droplets due to convective transport') - call addfld ('TRSPI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of ice crystal due to convective transport') - call addfld ('TRSPI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of ice crystal due to convective transport') - - call addfld ('ACCGR_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to collection of rain by graupel') - call addfld ('ACCGL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to collection of droplets by graupel') - call addfld ('ACCGSL_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of droplets by snow') - call addfld ('ACCGSR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of rain by snow') - call addfld ('ACCGIR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of rain by ice') - call addfld ('ACCGRI_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of ice by rain') - call addfld ('ACCGRS_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of snow by rain') - - call addfld ('ACCGSL_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel due to collection of droplets by snow') - call addfld ('ACCGSR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel due to collection of rain by snow') - call addfld ('ACCGIR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel due to collection of rain by ice') - - call addfld ('ACCSRI_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of snow due to collection of ice by rain') - call addfld ('ACCIGL_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of ice mult(splintering) due to acc droplets by graupel') - call addfld ('ACCIGR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of ice mult(splintering) due to acc rain by graupel') - call addfld ('ACCSIR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of snow due to collection of rain by ice') - - call addfld ('ACCIGL_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of ice mult(splintering) due to acc droplets by graupel') - call addfld ('ACCIGR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of ice mult(splintering) due to acc rain by graupel') - call addfld ('ACCSIR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of snow due to collection of rain by ice') - call addfld ('ACCGL_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to collection of droplets by graupel') - call addfld ('ACCGR_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to collection of rain by graupel') - call addfld ('ACCIL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of cloud ice due to collection of droplet by cloud ice') - call addfld ('ACCIL_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of cloud ice due to collection of droplet by cloud ice') - - call addfld ('FALLR_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of rain fallout') - call addfld ('FALLS_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of snow fallout') - call addfld ('FALLG_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel fallout') - call addfld ('FALLR_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of rain fallout') - call addfld ('FALLS_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of snow fallout') - call addfld ('FALLG_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel fallout') - call addfld ('FHMR_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to homogeneous freezing of rain') - - call addfld ('PRECZ_SN',horiz_only , 'A', '#', 'ZM sample num of convective precipitation rate') - - call add_default ('CLDLIQZM', 1, ' ') - call add_default ('CLDICEZM', 1, ' ') - call add_default ('CLIQSNUM', 1, ' ') - call add_default ('CICESNUM', 1, ' ') - call add_default ('DIFZM', 1, ' ') - call add_default ('DLFZM', 1, ' ') - call add_default ('DNIFZM', 1, ' ') - call add_default ('DNLFZM', 1, ' ') - call add_default ('WUZM', 1, ' ') - call add_default ('QRAINZM', 1, ' ') - call add_default ('QSNOWZM', 1, ' ') - call add_default ('QGRAPZM', 1, ' ') - call add_default ('CRAINNUM', 1, ' ') - call add_default ('CSNOWNUM', 1, ' ') - call add_default ('CGRAPNUM', 1, ' ') - call add_default ('QNLZM', 1, ' ') - call add_default ('QNIZM', 1, ' ') - call add_default ('QNRZM', 1, ' ') - call add_default ('QNSZM', 1, ' ') - call add_default ('QNGZM', 1, ' ') - call add_default ('FRZZM', 1, ' ') - - end if - call phys_getopts( history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num, & convproc_do_aer_out = convproc_do_aer, & @@ -387,14 +251,15 @@ subroutine zm_conv_init(pref_edge) nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') prec_dp_idx = pbuf_get_index('PREC_DP') snow_dp_idx = pbuf_get_index('SNOW_DP') - wuc_idx = pbuf_get_index('WUC') lambdadpcu_idx = pbuf_get_index('LAMBDADPCU') mudpcu_idx = pbuf_get_index('MUDPCU') icimrdp_idx = pbuf_get_index('ICIMRDP') - ! Initialization for the microphysics + ! Initialization for convective microphysics if (zm_microp) then + call zm_microphysics_history_init() + call zm_mphyi() ! use old estimate of snow production in zm_conv_evap @@ -416,134 +281,6 @@ subroutine zm_conv_init(pref_edge) end if ! zmconv_microp - !---------------------------------------------------------------------------- - contains - subroutine zm_aero_init(nmodes, nbulk, aero) - ! Initialize the zm_aero_t object for modal aerosols - integer, intent(in) :: nmodes - integer, intent(in) :: nbulk - type(zm_aero_t), intent(out) :: aero - integer :: iaer, l, m - integer :: nspecmx ! max number of species in a mode - character(len=20), allocatable :: aername(:) - character(len=32) :: str32 - real(r8) :: sigmag, dgnumlo, dgnumhi - real(r8) :: alnsg - !------------------------------------------------------------------------- - aero%nmodes = nmodes - aero%nbulk = nbulk - - if (nmodes > 0) then - ! Initialize the modal aerosol information - aero%scheme = 'modal' - - ! Get number of species in each mode, and find max. - allocate(aero%nspec(aero%nmodes)) - nspecmx = 0 - do m = 1, aero%nmodes - call rad_cnst_get_info(0, m, nspec=aero%nspec(m), mode_type=str32) - nspecmx = max(nspecmx, aero%nspec(m)) - ! save mode index for specified mode types - select case (trim(str32)) - case ('accum') - aero%mode_accum_idx = m - case ('aitken') - aero%mode_aitken_idx = m - case ('coarse') - aero%mode_coarse_idx = m - end select - end do - - ! Check that required mode types were found - if (aero%mode_accum_idx == -1 .or. & - aero%mode_aitken_idx == -1 .or. & - aero%mode_coarse_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - aero%mode_accum_idx, aero%mode_aitken_idx, aero%mode_coarse_idx - call endrun(routine//': ERROR required mode type not found') - end if - - ! find indices for the dust and seasalt species in the coarse mode - do l = 1, aero%nspec(aero%mode_coarse_idx) - call rad_cnst_get_info(0, aero%mode_coarse_idx, l, spec_type=str32) - select case (trim(str32)) - case ('dust') - aero%coarse_dust_idx = l - case ('seasalt') - aero%coarse_nacl_idx = l - end select - end do - - ! Check that required modal species types were found - if (aero%coarse_dust_idx == -1 .or. & - aero%coarse_nacl_idx == -1) then - write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & - aero%coarse_dust_idx, aero%coarse_nacl_idx - call endrun(routine//': ERROR required mode-species type not found') - end if - - allocate( & - aero%num_a(nmodes), & - aero%mmr_a(nspecmx,nmodes), & - aero%numg_a(pcols,pver,nmodes), & - aero%mmrg_a(pcols,pver,nspecmx,nmodes), & - aero%voltonumblo(nmodes), & - aero%voltonumbhi(nmodes), & - aero%specdens(nspecmx,nmodes), & - aero%spechygro(nspecmx,nmodes), & - aero%dgnum(nmodes), & - aero%dgnumg(pcols,pver,nmodes) ) - - do m = 1, nmodes - - ! Properties of modes - call rad_cnst_get_mode_props( 0, m, sigmag=sigmag, dgnumlo=dgnumlo, dgnumhi=dgnumhi ) - - alnsg = log(sigmag) - aero%voltonumblo(m) = 1 / ( (pi/6.0_r8)*(dgnumlo**3)*exp(4.5_r8*alnsg**2) ) - aero%voltonumbhi(m) = 1 / ( (pi/6.0_r8)*(dgnumhi**3)*exp(4.5_r8*alnsg**2) ) - - ! save sigmag of aitken mode - if (m == aero%mode_aitken_idx) aero%sigmag_aitken = sigmag - - ! Properties of modal species - do l = 1, aero%nspec(m) - call rad_cnst_get_aer_props(0, m, l, & - density_aer = aero%specdens(l,m), & - hygro_aer = aero%spechygro(l,m)) - end do - - end do - - else if (nbulk > 0) then - - aero%scheme = 'bulk' - - ! Props needed for BAM number concentration calcs. - allocate( & - aername(nbulk), & - aero%num_to_mass_aer(nbulk), & - aero%mmr_bulk(nbulk), & - aero%mmrg_bulk(pcols,plev,nbulk) ) - - do iaer = 1, aero%nbulk - call rad_cnst_get_aer_props(0, iaer, & - aername = aername(iaer), & - num_to_mass_aer = aero%num_to_mass_aer(iaer) ) - ! Look for sulfate aerosol in this list (Bulk aerosol only) - if (trim(aername(iaer)) == 'SULFATE') aero%idxsul = iaer - if (trim(aername(iaer)) == 'DUST1') aero%idxdst1 = iaer - if (trim(aername(iaer)) == 'DUST2') aero%idxdst2 = iaer - if (trim(aername(iaer)) == 'DUST3') aero%idxdst3 = iaer - if (trim(aername(iaer)) == 'DUST4') aero%idxdst4 = iaer - if (trim(aername(iaer)) == 'BCPHI') aero%idxbcphi = iaer - end do - - end if - - end subroutine zm_aero_init - !---------------------------------------------------------------------------- - end subroutine zm_conv_init !=================================================================================================== @@ -553,18 +290,23 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & state, ptend_all, landfrac, pbuf, mu, eu, & du, md, ed, dp, dsubcld, jt, maxg, ideep, lengath ) !---------------------------------------------------------------------------- - use physics_types, only: physics_state, physics_ptend - use physics_types, only: physics_ptend_init - use physics_update_mod, only: physics_update - use physics_types, only: physics_state_copy, physics_state_dealloc - use physics_types, only: physics_ptend_sum, physics_ptend_dealloc - use phys_grid, only: get_lat_p, get_lon_p - use time_manager, only: get_nstep, is_first_step - use physics_buffer, only: pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx - use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1 - use physconst, only: gravit - use time_manager, only: get_curr_date - use interpolate_data, only: vertinterp + ! Purpose: Primary interface with ZM parameterization + !---------------------------------------------------------------------------- + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init + use physics_update_mod, only: physics_update + use physics_types, only: physics_state_copy, physics_state_dealloc + use physics_types, only: physics_ptend_sum, physics_ptend_dealloc + use phys_grid, only: get_lat_p, get_lon_p + use time_manager, only: get_nstep, is_first_step + use physics_buffer, only: pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx + use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1 + use physconst, only: gravit + use time_manager, only: get_curr_date + use interpolate_data, only: vertinterp + use zm_microphysics, only: dnlfzm_idx, dnifzm_idx, dsfzm_idx, dnsfzm_idx, wuc_idx + use zm_microphysics_state, only: zm_microp_st_alloc, zm_microp_st_dealloc + use zm_microphysics_history, only: zm_microphysics_history_out !---------------------------------------------------------------------------- ! Arguments type(physics_state),target, intent(in) :: state ! Physics state variables @@ -667,7 +409,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & real(r8), dimension(pcols,pver) :: sprd real(r8), dimension(pcols,pver) :: frz - real(r8), dimension(pcols) :: precz_snum ! MCSP logical :: doslop @@ -699,80 +440,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & !---------------------------------------------------------------------------- - if (zm_microp) then - allocate( & - microp_st%wu(pcols,pver), & ! vertical velocity - microp_st%qliq(pcols,pver), & ! convective cloud liquid water. - microp_st%qice(pcols,pver), & ! convective cloud ice. - microp_st%qrain(pcols,pver), & ! convective rain water. - microp_st%qsnow(pcols,pver), & ! convective snow. - microp_st%qgraupel(pcols,pver), & ! convective graupel - microp_st%qnl(pcols,pver), & ! convective cloud liquid water num concen. - microp_st%qni(pcols,pver), & ! convective cloud ice num concen. - microp_st%qnr(pcols,pver), & ! convective rain water num concen. - microp_st%qns(pcols,pver), & ! convective snow num concen. - microp_st%qng(pcols,pver), & ! convective graupel num concen. - microp_st%autolm(pcols,pver), & ! mass tendency due to autoconversion of droplets to rain - microp_st%accrlm(pcols,pver), & ! mass tendency due to accretion of droplets by rain - microp_st%bergnm(pcols,pver), & ! mass tendency due to Bergeron process - microp_st%fhtimm(pcols,pver), & ! mass tendency due to immersion freezing - microp_st%fhtctm(pcols,pver), & ! mass tendency due to contact freezing - microp_st%fhmlm (pcols,pver), & ! mass tendency due to homogeneous freezing - microp_st%hmpim (pcols,pver), & ! mass tendency due to HM process - microp_st%accslm(pcols,pver), & ! mass tendency due to accretion of droplets by snow - microp_st%dlfm (pcols,pver), & ! mass tendency due to detrainment of droplet - microp_st%autoln(pcols,pver), & ! num tendency due to autoconversion of droplets to rain - microp_st%accrln(pcols,pver), & ! num tendency due to accretion of droplets by rain - microp_st%bergnn(pcols,pver), & ! num tendency due to Bergeron process - microp_st%fhtimn(pcols,pver), & ! num tendency due to immersion freezing - microp_st%fhtctn(pcols,pver), & ! num tendency due to contact freezing - microp_st%fhmln (pcols,pver), & ! num tendency due to homogeneous freezing - microp_st%accsln(pcols,pver), & ! num tendency due to accretion of droplets by snow - microp_st%activn(pcols,pver), & ! num tendency due to droplets activation - microp_st%dlfn (pcols,pver), & ! num tendency due to detrainment of droplet - microp_st%autoim(pcols,pver), & ! mass tendency due to autoconversion of cloud ice to snow - microp_st%accsim(pcols,pver), & ! mass tendency due to accretion of cloud ice by snow - microp_st%difm (pcols,pver), & ! mass tendency due to detrainment of cloud ice - microp_st%nuclin(pcols,pver), & ! num tendency due to ice nucleation - microp_st%autoin(pcols,pver), & ! num tendency due to autoconversion of cloud ice to snow - microp_st%accsin(pcols,pver), & ! num tendency due to accretion of cloud ice by snow - microp_st%hmpin (pcols,pver), & ! num tendency due to HM process - microp_st%difn (pcols,pver), & ! num tendency due to detrainment of cloud ice - microp_st%cmel (pcols,pver), & ! mass tendency due to condensation - microp_st%cmei (pcols,pver), & ! mass tendency due to deposition - microp_st%trspcm(pcols,pver), & ! LWC tendency due to convective transport - microp_st%trspcn(pcols,pver), & ! droplet num tendency due to convective transport - microp_st%trspim(pcols,pver), & ! IWC tendency due to convective transport - microp_st%trspin(pcols,pver), & ! ice crystal num tendency due to convective transport - microp_st%accgrm(pcols,pver), & ! mass tendency due to collection of rain by graupel - microp_st%accglm(pcols,pver), & ! mass tendency due to collection of droplets by graupel - microp_st%accgslm(pcols,pver), & ! mass tendency of graupel due to collection of droplets by snow - microp_st%accgsrm(pcols,pver), & ! mass tendency of graupel due to collection of rain by snow - microp_st%accgirm(pcols,pver), & ! mass tendency of graupel due to collection of rain by ice - microp_st%accgrim(pcols,pver), & ! mass tendency of graupel due to collection of ice by rain - microp_st%accgrsm(pcols,pver), & ! mass tendency due to collection of snow by rain - microp_st%accgsln(pcols,pver), & ! num tendency of graupel due to collection of droplets by snow - microp_st%accgsrn(pcols,pver), & ! num tendency of graupel due to collection of rain by snow - microp_st%accgirn(pcols,pver), & ! num tendency of graupel due to collection of rain by ice - microp_st%accsrim(pcols,pver), & ! mass tendency of snow due to collection of ice by rain - microp_st%acciglm(pcols,pver), & ! mass tendency of ice mult(splintering) due to acc droplets by graupel - microp_st%accigrm(pcols,pver), & ! mass tendency of ice mult(splintering) due to acc rain by graupel - microp_st%accsirm(pcols,pver), & ! mass tendency of snow due to collection of rain by ice - microp_st%accigln(pcols,pver), & ! num tendency of ice mult(splintering) due to acc droplets by graupel - microp_st%accigrn(pcols,pver), & ! num tendency of ice mult(splintering) due to acc rain by graupel - microp_st%accsirn(pcols,pver), & ! num tendency of snow due to collection of rain by ice - microp_st%accgln(pcols,pver), & ! num tendency due to collection of droplets by graupel - microp_st%accgrn(pcols,pver), & ! num tendency due to collection of rain by graupel - microp_st%accilm(pcols,pver), & ! mass tendency of cloud ice due to collection of droplet by cloud ice - microp_st%acciln(pcols,pver), & ! number conc tendency of cloud ice due to collection of droplet by cloud ice - microp_st%fallrm(pcols,pver), & ! mass tendency of rain fallout - microp_st%fallsm(pcols,pver), & ! mass tendency of snow fallout - microp_st%fallgm(pcols,pver), & ! mass tendency of graupel fallout - microp_st%fallrn(pcols,pver), & ! num tendency of rain fallout - microp_st%fallsn(pcols,pver), & ! num tendency of snow fallout - microp_st%fallgn(pcols,pver), & ! num tendency of graupel fallout - microp_st%fhmrm (pcols,pver) ) ! mass tendency due to homogeneous freezing of rain - end if + if (zm_microp) call zm_microp_st_alloc(microp_st) doslop = .false. doslop_heat = .false. @@ -1065,8 +733,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call outfld('ZMDT ', ftem, pcols, lchnk ) call outfld('ZMDQ ', ptend_loc%q(1,1,1), pcols, lchnk ) - if (zm_microp) call zm_conv_micro_outfld( microp_st, dlf, dif, dnlf, dnif, frz, lchnk, ncol ) - maxgsav(1:ncol) = 0 ! zero if no convection. true mean to be MAXI/FREQZM pcont(1:ncol) = state%ps(1:ncol) pconb(1:ncol) = state%ps(1:ncol) @@ -1132,16 +798,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call outfld('PRECCDZM', prec, pcols, lchnk ) call outfld('PRECZ ', prec, pcols, lchnk ) - if (zm_microp) then - do i = 1,ncol - if (prec(i) .gt. 0) then - precz_snum(i) = 1 - else - precz_snum(i) = 0 - end if - end do - call outfld('PRECZ_SN', precz_snum, pcols, lchnk ) - end if + if (zm_microp) call zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, dnlf, dnif, frz ) ! add tendency from this process to tend from other processes here call physics_ptend_sum(ptend_loc,ptend_all, ncol) @@ -1224,78 +881,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call physics_ptend_dealloc(ptend_loc) if (zm_microp) then - deallocate( & - microp_st%wu, & - microp_st%qliq, & - microp_st%qice, & - microp_st%qrain, & - microp_st%qsnow, & - microp_st%qgraupel, & - microp_st%qnl, & - microp_st%qni, & - microp_st%qnr, & - microp_st%qns, & - microp_st%qng, & - microp_st%autolm, & - microp_st%accrlm, & - microp_st%bergnm, & - microp_st%fhtimm, & - microp_st%fhtctm, & - microp_st%fhmlm , & - microp_st%hmpim , & - microp_st%accslm, & - microp_st%dlfm , & - microp_st%autoln, & - microp_st%accrln, & - microp_st%bergnn, & - microp_st%fhtimn, & - microp_st%fhtctn, & - microp_st%fhmln , & - microp_st%accsln, & - microp_st%activn, & - microp_st%dlfn , & - microp_st%autoim, & - microp_st%accsim, & - microp_st%difm , & - microp_st%nuclin, & - microp_st%autoin, & - microp_st%accsin, & - microp_st%hmpin , & - microp_st%difn , & - microp_st%cmel , & - microp_st%cmei , & - microp_st%trspcm, & - microp_st%trspcn, & - microp_st%trspim, & - microp_st%trspin, & - microp_st%accgrm, & - microp_st%accglm, & - microp_st%accgslm, & - microp_st%accgsrm, & - microp_st%accgirm, & - microp_st%accgrim, & - microp_st%accgrsm, & - microp_st%accgsln, & - microp_st%accgsrn, & - microp_st%accgirn, & - microp_st%accsrim, & - microp_st%acciglm, & - microp_st%accigrm, & - microp_st%accsirm, & - microp_st%accigln, & - microp_st%accigrn, & - microp_st%accsirn, & - microp_st%accgln, & - microp_st%accgrn, & - microp_st%accilm, & - microp_st%acciln, & - microp_st%fallrm, & - microp_st%fallsm, & - microp_st%fallgm, & - microp_st%fallrn, & - microp_st%fallsn, & - microp_st%fallgn, & - microp_st%fhmrm ) + call zm_microp_st_dealloc(microp_st) else deallocate(dnlf, dnif, dsf, dnsf) end if @@ -1307,6 +893,8 @@ end subroutine zm_conv_tend subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf, mu, eu, du, md, ed, dp, & dsubcld, jt, maxg, ideep, lengath, species_class) !---------------------------------------------------------------------------- + ! Purpose: Secondary interface with ZM for additional convective transport + !---------------------------------------------------------------------------- use physics_types, only: physics_state, physics_ptend, physics_ptend_init use time_manager, only: get_nstep use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc @@ -1395,143 +983,4 @@ end subroutine zm_conv_tend_2 !=================================================================================================== -subroutine zm_conv_micro_outfld(microp_st, dlf, dif, dnlf, dnif, frz, lchnk, ncol) - !---------------------------------------------------------------------------- - ! Arguments - type(zm_microp_st),intent(in) :: microp_st ! ZM microphysics data structure - real(r8), intent(in) :: dlf(:,:) ! detrainment of conv cld liq water mixing ratio - real(r8), intent(in) :: dif(:,:) ! detrainment of conv cld ice mixing ratio - real(r8), intent(in) :: dnlf(:,:) ! detrainment of conv cld liq water num concen - real(r8), intent(in) :: dnif(:,:) ! detrainment of conv cld ice num concen - real(r8), intent(in) :: frz(:,:) ! heating rate due to freezing - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of columns in chunk - !---------------------------------------------------------------------------- - ! Local variables - integer :: i,k - real(r8) :: cice_snum(pcols,pver) ! convective cloud ice sample number - real(r8) :: cliq_snum(pcols,pver) ! convective cloud liquid sample number - real(r8) :: crain_snum(pcols,pver) ! convective rain water sample number - real(r8) :: csnow_snum(pcols,pver) ! convective snow sample number - real(r8) :: cgraupel_snum(pcols,pver) ! convective graupel sample number - real(r8) :: wu_snum(pcols,pver) ! vertical velocity sample number - !---------------------------------------------------------------------------- - do k = 1,pver - do i = 1,ncol - if (microp_st%qice(i,k) > 0) cice_snum(i,k) = 1 - if (microp_st%qice(i,k) <= 0) cice_snum(i,k) = 0 - if (microp_st%qliq(i,k) > 0) cliq_snum(i,k) = 1 - if (microp_st%qliq(i,k) <= 0) cliq_snum(i,k) = 0 - if (microp_st%qsnow(i,k) > 0) csnow_snum(i,k) = 1 - if (microp_st%qsnow(i,k) <= 0) csnow_snum(i,k) = 0 - if (microp_st%qrain(i,k) > 0) crain_snum(i,k) = 1 - if (microp_st%qrain(i,k) <= 0) crain_snum(i,k) = 0 - if (microp_st%qgraupel(i,k) > 0) cgraupel_snum(i,k) = 1 - if (microp_st%qgraupel(i,k) <= 0) cgraupel_snum(i,k) = 0 - if (microp_st%wu(i,k) > 0) wu_snum(i,k) = 1 - if (microp_st%wu(i,k) <= 0) wu_snum(i,k) = 0 - end do - end do - - call outfld('CLIQSNUM',cliq_snum , pcols, lchnk ) - call outfld('CICESNUM',cice_snum , pcols, lchnk ) - call outfld('CRAINNUM',crain_snum , pcols, lchnk ) - call outfld('CSNOWNUM',csnow_snum , pcols, lchnk ) - call outfld('CGRAPNUM',cgraupel_snum , pcols, lchnk ) - call outfld('WUZMSNUM',wu_snum , pcols, lchnk ) - - call outfld('DIFZM' ,dif , pcols, lchnk ) - call outfld('DLFZM' ,dlf , pcols, lchnk ) - call outfld('DNIFZM' ,dnif , pcols, lchnk ) - call outfld('DNLFZM' ,dnlf , pcols, lchnk ) - call outfld('FRZZM' ,frz , pcols, lchnk ) - - call outfld('WUZM' ,microp_st%wu , pcols, lchnk ) - - call outfld('CLDLIQZM',microp_st%qliq , pcols, lchnk ) - call outfld('CLDICEZM',microp_st%qice , pcols, lchnk ) - call outfld('QRAINZM' ,microp_st%qrain , pcols, lchnk ) - call outfld('QSNOWZM' ,microp_st%qsnow , pcols, lchnk ) - call outfld('QGRAPZM' ,microp_st%qgraupel , pcols, lchnk ) - - call outfld('QNLZM' ,microp_st%qnl , pcols, lchnk ) - call outfld('QNIZM' ,microp_st%qni , pcols, lchnk ) - call outfld('QNRZM' ,microp_st%qnr , pcols, lchnk ) - call outfld('QNSZM' ,microp_st%qns , pcols, lchnk ) - call outfld('QNGZM' ,microp_st%qng , pcols, lchnk ) - - call outfld('AUTOL_M' ,microp_st%autolm , pcols, lchnk ) - call outfld('ACCRL_M' ,microp_st%accrlm , pcols, lchnk ) - call outfld('BERGN_M' ,microp_st%bergnm , pcols, lchnk ) - call outfld('FHTIM_M' ,microp_st%fhtimm , pcols, lchnk ) - call outfld('FHTCT_M' ,microp_st%fhtctm , pcols, lchnk ) - call outfld('FHML_M' ,microp_st%fhmlm , pcols, lchnk ) - call outfld('HMPI_M' ,microp_st%hmpim , pcols, lchnk ) - call outfld('ACCSL_M' ,microp_st%accslm , pcols, lchnk ) - call outfld('DLF_M' ,microp_st%dlfm , pcols, lchnk ) - - call outfld('AUTOL_N' ,microp_st%autoln , pcols, lchnk ) - call outfld('ACCRL_N' ,microp_st%accrln , pcols, lchnk ) - call outfld('BERGN_N' ,microp_st%bergnn , pcols, lchnk ) - call outfld('FHTIM_N' ,microp_st%fhtimn , pcols, lchnk ) - call outfld('FHTCT_N' ,microp_st%fhtctn , pcols, lchnk ) - call outfld('FHML_N' ,microp_st%fhmln , pcols, lchnk ) - call outfld('ACCSL_N' ,microp_st%accsln , pcols, lchnk ) - call outfld('ACTIV_N' ,microp_st%activn , pcols, lchnk ) - call outfld('DLF_N' ,microp_st%dlfn , pcols, lchnk ) - call outfld('AUTOI_M' ,microp_st%autoim , pcols, lchnk ) - call outfld('ACCSI_M' ,microp_st%accsim , pcols, lchnk ) - call outfld('DIF_M' ,microp_st%difm , pcols, lchnk ) - call outfld('NUCLI_N' ,microp_st%nuclin , pcols, lchnk ) - call outfld('AUTOI_N' ,microp_st%autoin , pcols, lchnk ) - call outfld('ACCSI_N' ,microp_st%accsin , pcols, lchnk ) - call outfld('HMPI_N' ,microp_st%hmpin , pcols, lchnk ) - call outfld('DIF_N' ,microp_st%difn , pcols, lchnk ) - call outfld('COND_M' ,microp_st%cmel , pcols, lchnk ) - call outfld('DEPOS_M' ,microp_st%cmei , pcols, lchnk ) - - call outfld('TRSPC_M' ,microp_st%trspcm , pcols, lchnk ) - call outfld('TRSPC_N' ,microp_st%trspcn , pcols, lchnk ) - call outfld('TRSPI_M' ,microp_st%trspim , pcols, lchnk ) - call outfld('TRSPI_N' ,microp_st%trspin , pcols, lchnk ) - - call outfld('ACCGR_M' ,microp_st%accgrm , pcols, lchnk ) - call outfld('ACCGL_M' ,microp_st%accglm , pcols, lchnk ) - call outfld('ACCGSL_M',microp_st%accgslm , pcols, lchnk ) - call outfld('ACCGSR_M',microp_st%accgsrm , pcols, lchnk ) - call outfld('ACCGIR_M',microp_st%accgirm , pcols, lchnk ) - call outfld('ACCGRI_M',microp_st%accgrim , pcols, lchnk ) - call outfld('ACCGRS_M',microp_st%accgrsm , pcols, lchnk ) - - call outfld('ACCGSL_N',microp_st%accgsln , pcols, lchnk ) - call outfld('ACCGSR_N',microp_st%accgsrn , pcols, lchnk ) - call outfld('ACCGIR_N',microp_st%accgirn , pcols, lchnk ) - - call outfld('ACCSRI_M',microp_st%accsrim , pcols, lchnk ) - call outfld('ACCIGL_M',microp_st%acciglm , pcols, lchnk ) - call outfld('ACCIGR_M',microp_st%accigrm , pcols, lchnk ) - call outfld('ACCSIR_M',microp_st%accsirm , pcols, lchnk ) - - call outfld('ACCIGL_N',microp_st%accigln , pcols, lchnk ) - call outfld('ACCIGR_N',microp_st%accigrn , pcols, lchnk ) - call outfld('ACCSIR_N',microp_st%accsirn , pcols, lchnk ) - call outfld('ACCGL_N' ,microp_st%accgln , pcols, lchnk ) - call outfld('ACCGR_N' ,microp_st%accgrn , pcols, lchnk ) - - call outfld('ACCIL_M' ,microp_st%accilm , pcols, lchnk ) - call outfld('ACCIL_N' ,microp_st%acciln , pcols, lchnk ) - - call outfld('FALLR_M' ,microp_st%fallrm , pcols, lchnk ) - call outfld('FALLS_M' ,microp_st%fallsm , pcols, lchnk ) - call outfld('FALLG_M' ,microp_st%fallgm , pcols, lchnk ) - call outfld('FALLR_N' ,microp_st%fallrn , pcols, lchnk ) - call outfld('FALLS_N' ,microp_st%fallsn , pcols, lchnk ) - call outfld('FALLG_N' ,microp_st%fallgn , pcols, lchnk ) - - call outfld('FHMR_M' ,microp_st%fhmrm , pcols, lchnk ) - -end subroutine zm_conv_micro_outfld - -!=================================================================================================== - end module zm_conv_intr diff --git a/components/eam/src/physics/cam/zm_conv_types.F90 b/components/eam/src/physics/cam/zm_conv_types.F90 new file mode 100644 index 000000000000..504beacb740b --- /dev/null +++ b/components/eam/src/physics/cam/zm_conv_types.F90 @@ -0,0 +1,128 @@ +module zm_conv_types + !---------------------------------------------------------------------------- + ! Purpose: utility methods for ZM deep convection scheme + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + + public :: zm_const_set_to_global ! set zm_const using global values from physconst/shr_const_mod + public :: zm_const_set_for_testing ! set zm_const consistent with shr_const_mod for testing + public :: zm_param_mpi_broadcast ! broadcast parameter values to all MPI ranks + + ! ZM derived types + public :: zm_const_t ! derived type to hold ZM constants + public :: zm_param_t ! derived type to hold ZM tunable parameters + + ! invalid values for parameter initialization + real(r8), parameter :: unset_r8 = huge(1.0_r8) + integer , parameter :: unset_int = huge(1) + +!=================================================================================================== + +type :: zm_const_t + real(r8) :: grav ! gravitational acceleration [m/s2] + real(r8) :: boltz ! Boltzmann's constant [J/K/molecule] + real(r8) :: avogad ! Avogadro's number [molecules/kmole] + real(r8) :: rgas ! Universal gas constant [J/K/kmole] + real(r8) :: mwdair ! molecular weight dry air [kg/kmole] + real(r8) :: mwwv ! molecular weight water vapor [kg/kmole] + real(r8) :: rdair ! gas constant for dry air [J/K/kg] + real(r8) :: rh2o ! gas constant for water vapor [J/K/kg] + real(r8) :: zvir ! virtual temperature parameter [] + real(r8) :: cpair ! specific heat of dry air [J/K/kg] + real(r8) :: cpwv ! specific heat of water vapor [J/K/kg] + real(r8) :: cpliq ! specific heat of liquid water [J/K/kg] + real(r8) :: tfreez ! freezing point of water [K] + real(r8) :: latvap ! latent heat of vaporization [J/kg] + real(r8) :: latice ! latent heat of fusion [J/kg] + real(r8) :: epsilo ! ratio of h2o to dry air molecular weights +end type zm_const_t + +!=================================================================================================== + +type :: zm_param_t + logical :: trig_dcape = .false. ! true if to using DCAPE trigger - based on CAPE generation by the dycor + logical :: trig_ull = .false. ! true if to using the "unrestricted launch level" (ULL) mode + integer :: num_cin = 0 ! num of neg buoyancy regions allowed before the conv top and CAPE calc are completed + integer :: limcnv = 0 ! upper pressure interface level to limit deep convection + logical :: tpert_fix = .false. ! flag to disable using applying tpert to PBL-rooted convection + real(r8) :: tpert_fac = 0 ! tunable temperature perturbation factor + real(r8) :: dmpdz = unset_r8 ! fractional mass entrainment rate [1/m] + real(r8) :: tiedke_add = unset_r8 ! tunable temperature perturbation + integer :: mx_bot_lyr_adj = unset_int ! bot layer index adjustment for launch level search +end type zm_param_t + +!=================================================================================================== +contains +!=================================================================================================== + +subroutine zm_const_set_to_global(zm_const) + !---------------------------------------------------------------------------- + ! Purpose: set zm_const using global values from physconst/shr_const_mod + !---------------------------------------------------------------------------- + use physconst, only: gravit,rair,cpair,cpwv,cpliq,rh2o,tmelt,latvap,latice,epsilo + !---------------------------------------------------------------------------- + type(zm_const_t), intent(inout) :: zm_const + !---------------------------------------------------------------------------- + zm_const%grav = gravit + zm_const%rdair = rair + zm_const%cpair = cpair + zm_const%cpwv = cpwv + zm_const%cpliq = cpliq + zm_const%rh2o = rh2o + zm_const%tfreez = tmelt + zm_const%latvap = latvap + zm_const%latice = latice + zm_const%epsilo = epsilo + zm_const%zvir = 1.608_r8 ! use this instead of physconst value to avoid non-BFB diffs +end subroutine zm_const_set_to_global + +!=================================================================================================== + +subroutine zm_const_set_for_testing(zm_const) + !---------------------------------------------------------------------------- + ! Purpose: set zm_const consistent with shr_const_mod for testing + ! Note - normal model operation should use zm_const_set_to_global() + !---------------------------------------------------------------------------- + type(zm_const_t), intent(inout) :: zm_const + !---------------------------------------------------------------------------- + zm_const%grav = 9.80616_r8 + zm_const%boltz = 1.38065e-23_r8 + zm_const%avogad = 6.02214e26_r8 + zm_const%rgas = zm_const%avogad*zm_const%boltz + zm_const%mwdair = 28.966_r8 + zm_const%mwwv = 18.016_r8 + zm_const%rdair = zm_const%rgas/zm_const%mwdair + zm_const%rh2o = zm_const%rgas/zm_const%mwwv + zm_const%zvir = zm_const%rh2o/zm_const%rdair - 1.0_r8 + zm_const%cpair = 1.00464e3_r8 + zm_const%cpwv = 1.810e3_r8 + zm_const%cpliq = 4.188e3_r8 + zm_const%tfreez = 273.15_r8 + zm_const%latvap = 2.501e6_r8 + zm_const%latice = 3.337e5_r8 + zm_const%epsilo = zm_const%mwwv/zm_const%mwdair +end subroutine zm_const_set_for_testing + +!=================================================================================================== + +subroutine zm_param_mpi_broadcast(zm_param) + !---------------------------------------------------------------------------- + ! Purpose: broadcast parameter values to all MPI ranks + !---------------------------------------------------------------------------- + use mpishorthand + !---------------------------------------------------------------------------- + type(zm_param_t), intent(inout) :: zm_param + !---------------------------------------------------------------------------- + call mpibcast(zm_param%trig_dcape, 1, mpilog, 0, mpicom) + call mpibcast(zm_param%trig_ull, 1, mpilog, 0, mpicom) + call mpibcast(zm_param%tiedke_add, 1, mpir8, 0, mpicom) + call mpibcast(zm_param%dmpdz, 1, mpir8, 0, mpicom) + call mpibcast(zm_param%num_cin, 1, mpiint, 0, mpicom) + call mpibcast(zm_param%mx_bot_lyr_adj, 1, mpiint, 0, mpicom) + call mpibcast(zm_param%tpert_fix, 1, mpilog, 0, mpicom) + call mpibcast(zm_param%tpert_fac, 1, mpir8, 0, mpicom) +end subroutine zm_param_mpi_broadcast + +!=================================================================================================== + +end module zm_conv_types diff --git a/components/eam/src/physics/cam/zm_conv_util.F90 b/components/eam/src/physics/cam/zm_conv_util.F90 new file mode 100644 index 000000000000..60754592f341 --- /dev/null +++ b/components/eam/src/physics/cam/zm_conv_util.F90 @@ -0,0 +1,199 @@ +module zm_conv_util + !---------------------------------------------------------------------------- + ! Purpose: utility methods for ZM deep convection scheme + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use cam_abortutils, only: endrun + use zm_conv_types, only: zm_const_t + + public :: entropy ! calculate entropy + public :: ientropy ! invert entropy equation to get temperature and saturated vapor mixing ratio + public :: qsat_hPa ! wrapper for qsat_water that translates between Pa and hPa + +!=================================================================================================== +contains +!=================================================================================================== + +real(r8) function entropy(TK, p, qtot, zm_const) + !---------------------------------------------------------------------------- + ! Purpose: function to calculate entropy following: + ! + ! Raymond, D. J., and A. M. Blyth, 1992: Extension of the Stochastic Mixing + ! Model to Cumulonimbus Clouds. J. Atmos. Sci., 49, 1968–1983 + !---------------------------------------------------------------------------- + ! Arguments + real(r8), intent(in) :: TK ! temperature [K] + real(r8), intent(in) :: p ! pressure [mb] + real(r8), intent(in) :: qtot ! total water mixing ratio [kg/kg] + type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants + !---------------------------------------------------------------------------- + ! Local variables + real(r8) :: qv ! water vapor mixing ratio + real(r8) :: qst ! saturated vapor mixing ratio + real(r8) :: e ! water vapor pressure + real(r8) :: est ! saturated vapor pressure + real(r8) :: L ! latent heat of vaporization + real(r8), parameter :: pref = 1000._r8 + !---------------------------------------------------------------------------- + + ! Calculate latent heat of vaporization - note T is converted to centigrade + L = zm_const%latvap - (zm_const%cpliq - zm_const%cpwv)*(TK-zm_const%tfreez) + + ! Use saturation mixing ratio to partition qtot into vapor part only + call qsat_hPa(TK, p, est, qst) + qv = min(qtot,qst) + e = qv*p / (zm_const%epsilo+qv) + + ! calculate entropy per unit mass of dry air - Eq. 1 + entropy = ( zm_const%cpair & + + qtot*zm_const%cpliq)*log(TK/zm_const%tfreez) & + - zm_const%rdair*log( (p-e)/pref & + ) + L*qv/TK - qv*zm_const%rh2o*log(qv/qst) + +end function entropy + +!=================================================================================================== + +subroutine ientropy(rcall, s, p, qt, T, qst, Tfg, zm_const) + !---------------------------------------------------------------------------- + ! Purpose: invert the entropy equation to return temperature and saturated + ! vapor mixing ratio following Richard Brent's method:: + ! + ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. + ! Englewood Cliffs, NJ: Prentice-Hall, 1973. + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in) :: rcall ! call index + real(r8), intent(in) :: s ! entropy [J/kg] + real(r8), intent(in) :: p ! pressure [mb] + real(r8), intent(in) :: qt ! total water mixing ratio [kg/kg] + real(r8), intent(in) :: Tfg ! input temperature for first guess [K] + real(r8), intent(out) :: qst ! saturation vapor mixing ratio [kg/kg] + real(r8), intent(out) :: T ! temperature [k] + type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants + !---------------------------------------------------------------------------- + ! Local variables + integer :: i ! loop iterator + logical :: converged ! flag for convergence + real(r8) :: est ! saturation vapor pressure + real(r8) :: this_lat ! local latitude + real(r8) :: this_lon ! local logitude + real(r8) :: tolerance + real(r8) :: a, b, c, d, ebr, fa, fb, fc, pbr, qbr, rbr, sbr, xm + integer, parameter :: LOOPMAX = 100 ! Max number of iteration loops + real(r8), parameter :: tol_coeff = 0.001_r8 ! tolerance coeficient + real(r8), parameter :: tol_eps = 3.e-8_r8 ! small value for tolerance calculation + !---------------------------------------------------------------------------- + ! initialize variables + converged = .false. + T = Tfg ! first guess based on input temperature + a = Tfg-10 ! low bracket + b = Tfg+10 ! high bracket + + fa = entropy(a, p, qt, zm_const) - s + fb = entropy(b, p, qt, zm_const) - s + + c = b + fc = fb + !---------------------------------------------------------------------------- + ! + converge: do i=0, LOOPMAX + + if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & + (fb < 0.0_r8 .and. fc < 0.0_r8)) then + c = a + d = b-a + fc = fa + ebr = d + end if + + if (abs(fc) < abs(fb)) then + a = b + b = c + c = a + fa = fb + fb = fc + fc = fa + end if + + tolerance = 2.0_r8*tol_eps*abs(b) + 0.5_r8*tol_coeff + xm = 0.5_r8*(c-b) + + converged = (abs(xm) <= tolerance .or. fb == 0.0_r8) + if (converged) exit converge + + if (abs(ebr) >= tolerance .and. abs(fa) > abs(fb)) then + sbr=fb/fa + if (a == c) then + pbr = 2.0_r8*xm*sbr + qbr = 1.0_r8-sbr + else + qbr = fa/fc + rbr = fb/fc + pbr = sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) + qbr = (qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) + end if + if (pbr > 0.0_r8) qbr=-qbr + pbr=abs(pbr) + if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tolerance*qbr),abs(ebr*qbr))) then + ebr = d + d = pbr/qbr + else + d = xm + ebr = d + end if + else + d = xm + ebr = d + end if + a = b + fa = fb + b = b + merge( d, sign(tolerance,xm), abs(d)>tolerance ) + + fb = entropy(b, p, qt, zm_const) - s + + end do converge + + T = b + call qsat_hPa(T, p, est, qst) + + if (.not. converged) then + write(iulog,*) '*** ZM_CONV: IENTROPY: Failed and about to exit, info follows ****' + write(iulog,100) 'ZM_CONV: IENTROPY Details:', & + ' call#: ',rcall, & + ' P(mb): ',p, & + ' Tfg(K): ', Tfg, & + ' qt(g/kg): ', 1000._r8*qt, & + ' qst(g/kg): ', 1000._r8*qst,& + ' s(J/kg): ',s + call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') + end if + +100 format (A,I1,I4,I4,7(A,F6.2)) + +end subroutine ientropy + +!=================================================================================================== + +elemental subroutine qsat_hPa(t, p, es, qm) + !---------------------------------------------------------------------------- + ! Purpose: wrapper for qsat_water that translates between Pa and hPa + ! qsat_water uses Pa internally, so pass in Pa and set es back to hPa after + use wv_saturation, only: qsat_water + !---------------------------------------------------------------------------- + ! Arguments + real(r8), intent(in) :: t ! Temperature [K] + real(r8), intent(in) :: p ! Pressure [hPa] + real(r8), intent(out) :: es ! Saturation vapor pressure [hPa] + real(r8), intent(out) :: qm ! Saturation mass mixing ratio [kg/kg] (vapor mass over dry mass) + !---------------------------------------------------------------------------- + + call qsat_water(t, p*100._r8, es, qm) + + es = es*0.01_r8 + +end subroutine qsat_hPa + +!=================================================================================================== + +end module zm_conv_util diff --git a/components/eam/src/physics/cam/zm_microphysics.F90 b/components/eam/src/physics/cam/zm_microphysics.F90 old mode 100755 new mode 100644 index 031957d1fe8b..9dd3eaade1a7 --- a/components/eam/src/physics/cam/zm_microphysics.F90 +++ b/components/eam/src/physics/cam/zm_microphysics.F90 @@ -1,291 +1,200 @@ module zm_microphysics - -!--------------------------------------------------------------------------------- -! Purpose: -! CAM Interface for cumulus microphysics -! -! Author: Xialiang Song and Guang Zhang, June 2010 -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp -use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o -use physconst, only: latvap, latice -use activate_drop_mam, only: actdrop_mam_calc -use ndrop_bam, only: ndrop_bam_run -use nucleate_ice_conv, only: nucleati_conv -use shr_spfn_mod, only: gamma => shr_spfn_gamma -use wv_saturation, only: svp_water, svp_ice -use cam_logfile, only: iulog -use cam_abortutils, only: endrun -use zm_microphysics_state, only: zm_microp_st + !---------------------------------------------------------------------------- + ! + ! Purpose: Methods for convective microphysics + ! + ! Author: Xialiang Song and Guang Zhang, June 2010 + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver, pverp + use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o + use physconst, only: latvap, latice + use activate_drop_mam, only: actdrop_mam_calc + use ndrop_bam, only: ndrop_bam_run + use nucleate_ice_conv, only: nucleati_conv + use shr_spfn_mod, only: gamma => shr_spfn_gamma + use wv_saturation, only: svp_water, svp_ice + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use zm_microphysics_state, only: zm_microp_st + use zm_aero, only: zm_aero_t #ifndef HAVE_ERF_INTRINSICS -use shr_spfn_mod, only: erf => shr_spfn_erf + use shr_spfn_mod, only: erf => shr_spfn_erf #endif -implicit none -private -save - -public :: zm_mphyi -public :: zm_mphy -public :: zm_aero_t - -! Private module data - -! constants remaped -real(r8) :: g ! gravity -real(r8) :: mw ! molecular weight of water -real(r8) :: r ! Dry air Gas constant -real(r8) :: rv ! water vapor gas contstant -real(r8) :: rr ! universal gas constant -real(r8) :: cpp ! specific heat of dry air -real(r8) :: rhow ! density of liquid water -real(r8) :: xlf ! latent heat of freezing - -!from 'microconstants' -real(r8) :: rhosn ! bulk density snow -real(r8) :: rhoi ! bulk density ice -real(r8) :: rhog ! bulk density graupel - -real(r8) :: ac,bc,as,bs,ai,bi,ar,br,ag,bg !fall speed parameters -real(r8) :: ci,di !ice mass-diameter relation parameters -real(r8) :: cs,ds !snow mass-diameter relation parameters -real(r8) :: cr,dr !drop mass-diameter relation parameters -real(r8) :: cg,dg !graupel mass-diameter relation parameters -real(r8) :: Eii !collection efficiency aggregation of ice -real(r8) :: Ecc !collection efficiency -real(r8) :: Ecr !collection efficiency cloud droplets/rain -real(r8) :: ecg ! collection efficiency, ice-droplet collisions -real(r8) :: DCS !autoconversion size threshold -real(r8) :: bimm,aimm !immersion freezing -real(r8) :: rhosu !typical 850mn air density -real(r8) :: mi0 ! new crystal mass -real(r8) :: mg0 ! mass of embryo graupel -real(r8) :: rin ! radius of contact nuclei -real(r8) :: pi ! pi -real(r8) :: mmult - -! for Bergeron process (Rotstayn et al.2000) -real(r8) :: Ka_b ! thermal conductivity of air(J/m/s/K) -real(r8) :: Ls_b ! latent heat of sublimation of water(J/kg) -real(r8) :: Rv_b ! specigic gas constant for water vapour(J/kg/K) -real(r8) :: alfa_b ! parameter for ice crystal habit -real(r8) :: rhoi13 ! rhoi**(1/3) -real(r8) :: c23 ! 2/3 - -real(r8) :: cons14,cons16,cons17,cons18,cons19,cons24,cons25, cons31, cons32, cons41 - -real(r8) :: droplet_mass_25um - -! contact freezing due to dust -! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 -real(r8), parameter :: rn_dst1 = 0.258e-6_r8 -real(r8), parameter :: rn_dst2 = 0.717e-6_r8 -real(r8), parameter :: rn_dst3 = 1.576e-6_r8 -real(r8), parameter :: rn_dst4 = 3.026e-6_r8 - -! smallest mixing ratio considered in microphysics -real(r8), parameter :: qsmall = 1.e-18_r8 - - -type, public :: ptr2d - real(r8), pointer :: val(:,:) -end type ptr2d - -! Aerosols -type :: zm_aero_t - - ! Aerosol treatment - character(len=5) :: scheme ! either 'bulk' or 'modal' - - ! Bulk aerosols - integer :: nbulk = 0 ! number of bulk aerosols affecting climate - integer :: idxsul = -1 ! index in aerosol list for sulfate - integer :: idxdst1 = -1 ! index in aerosol list for dust1 - integer :: idxdst2 = -1 ! index in aerosol list for dust2 - integer :: idxdst3 = -1 ! index in aerosol list for dust3 - integer :: idxdst4 = -1 ! index in aerosol list for dust4 - integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHI) - - real(r8), allocatable :: num_to_mass_aer(:) ! conversion of mmr to number conc for bulk aerosols - type(ptr2d), allocatable :: mmr_bulk(:) ! array of pointers to bulk aerosol mmr - real(r8), allocatable :: mmrg_bulk(:,:,:) ! gathered bulk aerosol mmr - - ! Modal aerosols - integer :: nmodes = 0 ! number of modes - integer, allocatable :: nspec(:) ! number of species in each mode - type(ptr2d), allocatable :: num_a(:) ! number mixing ratio of modes (interstitial phase) - type(ptr2d), allocatable :: mmr_a(:,:) ! species mmr in each mode (interstitial phase) - real(r8), allocatable :: numg_a(:,:,:) ! gathered number mixing ratio of modes (interstitial phase) - real(r8), allocatable :: mmrg_a(:,:,:,:) ! gathered species mmr in each mode (interstitial phase) - real(r8), allocatable :: voltonumblo(:) ! volume to number conversion (lower bound) for each mode - real(r8), allocatable :: voltonumbhi(:) ! volume to number conversion (upper bound) for each mode - real(r8), allocatable :: specdens(:,:) ! density of modal species - real(r8), allocatable :: spechygro(:,:) ! hygroscopicity of modal species - - integer :: mode_accum_idx = -1 ! index of accumulation mode - integer :: mode_aitken_idx = -1 ! index of aitken mode - integer :: mode_coarse_idx = -1 ! index of coarse mode - integer :: coarse_dust_idx = -1 ! index of dust in coarse mode - integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode - - type(ptr2d), allocatable :: dgnum(:) ! mode dry radius - real(r8), allocatable :: dgnumg(:,:,:) ! gathered mode dry radius - - real(r8) :: sigmag_aitken - -end type zm_aero_t - - -real(r8), parameter :: dcon = 25.e-6_r8 -real(r8), parameter :: mucon = 5.3_r8 -real(r8), parameter :: lambdadpcu = (mucon + 1._r8)/dcon - -!=============================================================================== + implicit none + private + save + + public :: zm_microphysics_register + public :: zm_mphyi + public :: zm_mphy + + ! pbuf indices + integer, public :: dnlfzm_idx = -1 ! detrained convective cloud water num concen + integer, public :: dnifzm_idx = -1 ! detrained convective cloud ice num concen + integer, public :: dnsfzm_idx = -1 ! detrained convective snow num concen + integer, public :: dsfzm_idx = -1 ! detrained convective snow mixing ratio + integer, public :: wuc_idx = -1 ! vertical velocity in deep convection + + ! constants + real(r8), parameter :: pi = 3.14159265358979323846_r8 + + real(r8) :: xlf ! latent heat of freezing + + ! parameters below from Reisner et al. (1998) + real(r8), parameter :: rhow = 1000._r8 ! density of liquid water [kg/m3] + real(r8), parameter :: rhoi = 500._r8 ! bulk density ice [kg/m3] + real(r8), parameter :: rhog = 400._r8 ! bulk density graupel [kg/m3] + real(r8), parameter :: rhosn = 100._r8 ! bulk density snow [kg/m3] + + ! fall speed parameters, V = aD^b [m/s] + real(r8), parameter :: ac = 3.e7_r8 ! droplets + real(r8), parameter :: bc = 2._r8 ! droplets + real(r8), parameter :: as = 11.72_r8 ! snow + real(r8), parameter :: bs = 0.41_r8 ! snow + real(r8), parameter :: ai = 700._r8 ! cloud ice + real(r8), parameter :: bi = 1._r8 ! cloud ice + real(r8), parameter :: ar = 841.99667_r8 ! rain + real(r8), parameter :: br = 0.8_r8 ! rain + real(r8), parameter :: ag = 19.3_r8 ! graupel (if dense precipitating ice is graupel) + real(r8), parameter :: bg = 0.37_r8 ! graupel (if dense precipitating ice is graupel) + + real(r8) :: ci,di ! ice mass-diameter relation parameters + real(r8) :: cs,ds ! snow mass-diameter relation parameters + real(r8) :: cr,dr ! drop mass-diameter relation parameters + real(r8) :: cg,dg ! graupel mass-diameter relation parameters + real(r8), parameter :: Eii = 0.1_r8 ! collection efficiency aggregation of ice + real(r8) :: Ecc ! collection efficiency + real(r8), parameter :: Ecr = 1.0_r8 ! collection efficiency cloud droplets/rain + real(r8), parameter :: ecg = 0.7_r8 ! collection efficiency, ice-droplet collisions + real(r8) :: DCS ! autoconversion size threshold + real(r8), parameter :: bimm = 100._r8 ! immersion freezing parameter (Bigg, 1953) + real(r8), parameter :: aimm = 0.66_r8 ! immersion freezing parameter (Bigg, 1953) + real(r8) :: rhosu ! typical 850mn air density + real(r8) :: mi0 ! new crystal mass + real(r8), parameter :: mg0 = 1.6E-10 ! mass of embryo graupel + real(r8), parameter :: rin = 0.1e-6_r8 ! radius of contact nuclei + + ! for Bergeron process (Rotstayn et al.2000) + real(r8), parameter :: Ka_b = 2.4e-2_r8 ! thermal conductivity of air [J/m/s/K] + real(r8), parameter :: Ls_b = 2.834e6_r8 ! latent heat of sublimation of water [J/kg] + real(r8), parameter :: Rv_b = 461._r8 ! specigic gas constant for water vapour [J/kg/K] + real(r8) :: alfa_b ! parameter for ice crystal habit + real(r8) :: rhoi13 ! rhoi**(1/3) + real(r8) :: c23 ! 2/3 + + real(r8) :: mmult + + real(r8) :: cons14,cons16,cons17,cons18,cons19,cons24,cons25, cons31, cons32, cons41 + + real(r8) :: droplet_mass_25um + + ! contact freezing due to dust + ! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 + real(r8), parameter :: rn_dst1 = 0.258e-6_r8 + real(r8), parameter :: rn_dst2 = 0.717e-6_r8 + real(r8), parameter :: rn_dst3 = 1.576e-6_r8 + real(r8), parameter :: rn_dst4 = 3.026e-6_r8 + real(r8), parameter :: qsmall = 1.e-18_r8 ! smallest mixing ratio considered in microphysics + real(r8), parameter :: dcon = 25.e-6_r8 + real(r8), parameter :: mucon = 5.3_r8 + real(r8), parameter :: lambdadpcu = (mucon + 1._r8)/dcon + +!=================================================================================================== contains -!=============================================================================== - -subroutine zm_mphyi - -!----------------------------------------------------------------------- -! -! Purpose: -! initialize constants for the cumulus microphysics -! called from zm_conv_init() in zm_conv_intr.F90 -! -! Author: Xialiang Song, June 2010 -! -!----------------------------------------------------------------------- - -!NOTE: -! latent heats should probably be fixed with temperature -! for energy conservation with the rest of the model -! (this looks like a +/- 3 or 4% effect, but will mess up energy balance) - - xlf = latice ! latent heat freezing - -! from microconstants - -! parameters below from Reisner et al. (1998) -! density parameters (kg/m3) - - rhosn = 100._r8 ! bulk density snow - rhoi = 500._r8 ! bulk density ice - rhow = 1000._r8 ! bulk density liquid - - rhog = 400._r8 ! bulk density graupel(if dense precipitating ice is graupel) -! rhog = 900._r8 ! bulk density graupel(if dense precipitating ice is hail) - -! fall speed parameters, V = aD^b -! V is in m/s - -! droplets - ac = 3.e7_r8 - bc = 2._r8 - -! snow - as = 11.72_r8 - bs = 0.41_r8 - -! cloud ice - ai = 700._r8 - bi = 1._r8 - -! rain - ar = 841.99667_r8 - br = 0.8_r8 - -!graupel(if dense precipitating ice is graupel) - - ag = 19.3_r8 - bg = 0.37_r8 - -!if dense precipitating ice is hail (matsun and huggins 1980) -! ag = 114.5 -! bg = 0.5 - - -! particle mass-diameter relationship -! currently we assume spherical particles for cloud ice/snow -! m = cD^d - - pi = 3.14159265358979323846_r8 - -! cloud ice mass-diameter relationship - - ci = rhoi*pi/6._r8 - di = 3._r8 - -! snow mass-diameter relationship - - cs = rhosn*pi/6._r8 - ds = 3._r8 - -! drop mass-diameter relationship +!=================================================================================================== + +subroutine zm_microphysics_register() + !---------------------------------------------------------------------------- + ! Purpose: register pbuf variables for convective microphysics + !---------------------------------------------------------------------------- + use physics_buffer, only : pbuf_add_field, dtype_r8 + !---------------------------------------------------------------------------- + + ! detrained convective cloud water num concen. + call pbuf_add_field('DNLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnlfzm_idx) + + ! detrained convective cloud ice num concen. + call pbuf_add_field('DNIFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnifzm_idx) + + ! detrained convective snow num concen. + call pbuf_add_field('DNSFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnsfzm_idx) + + ! detrained convective snow mixing ratio. + call pbuf_add_field('DSFZM', 'physpkg', dtype_r8, (/pcols,pver/), dsfzm_idx) - cr = rhow*pi/6._r8 - dr = 3._r8 + ! vertical velocity (m/s) + call pbuf_add_field('WUC','global',dtype_r8,(/pcols,pver/), wuc_idx) -! graupel mass-diameter relationship +end subroutine zm_microphysics_register - cg = rhog*pi/6._r8 - dg = 3._r8 +!=================================================================================================== -! collection efficiency, aggregation of cloud ice and snow +subroutine zm_mphyi() + !---------------------------------------------------------------------------- + ! Purpose: initialize variables for convective microphysics + ! Author: Xialiang Song, June 2010 + !---------------------------------------------------------------------------- - Eii = 0.1_r8 + ! NOTE: latent heats should probably be fixed with temperature + ! for energy conservation with the rest of the model + ! (this looks like a +/- 3 or 4% effect, but will mess up energy balance) -! collection efficiency, accretion of cloud water by rain + ! latent heat freezing + xlf = latice - Ecr = 1.0_r8 + ! particle mass-diameter relationship - assume spherical particles for cloud ice/snow + ! m = cD^d - ecg = 0.7_r8 + ! cloud ice mass-diameter relationship + ci = rhoi*pi/6._r8 + di = 3._r8 -! immersion freezing parameters, bigg 1953 + ! snow mass-diameter relationship + cs = rhosn*pi/6._r8 + ds = 3._r8 - bimm = 100._r8 - aimm = 0.66_r8 + ! drop mass-diameter relationship + cr = rhow*pi/6._r8 + dr = 3._r8 -! typical air density at 850 mb + ! graupel mass-diameter relationship - rhosu = 85000._r8/(rair * tmelt) + cg = rhog*pi/6._r8 + dg = 3._r8 -! for Bergeron process (Rotstayn et al.2000) - Ka_b = 2.4e-2_r8 ! thermal conductivity of air(J/m/s/K) - Ls_b = 2.834e6_r8 ! latent heat of sublimation of water(J/kg) - Rv_b = 461._r8 ! specigic gas constant for water vapour(J/kg/K) - alfa_b = 1._r8/3._r8 - rhoi13 = rhoi**alfa_b - c23 = 2._r8/3._r8 + ! typical air density at 850 mb + rhosu = 85000._r8/(rair * tmelt) -! mass of new crystal due to aerosol freezing and growth (kg) + ! for Bergeron process (Rotstayn et al.2000) + alfa_b = 1._r8/3._r8 + rhoi13 = rhoi**alfa_b + c23 = 2._r8/3._r8 - mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8) + ! mass of new crystal due to aerosol freezing and growth (kg) + mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8) + + mmult = 4._r8/3._r8*pi*rhoi*(5.e-6_r8)**3 - mg0 = 1.6E-10 -! radius of contact nuclei aerosol (m) + cons14 = gamma(bg+3._r8)*pi/4._r8*ecg + cons16 = gamma(bi+3._r8)*pi/4._r8*ecg + cons17 = 4._r8*2._r8*3._r8*rhosu*pi*ecg*ecg*gamma(2._r8*bs+2._r8)/(8._r8*(rhog-rhosn)) + cons18 = rhosn*rhosn + cons19 = rhow*rhow + cons24 = pi/4._r8*ecr*gamma(br+3._r8) + cons25 = pi*pi/24._r8*rhow*ecr*gamma(br+6._r8) - rin = 0.1e-6_r8 - mmult = 4._r8/3._r8*pi*rhoi*(5.e-6_r8)**3 + cons31 = pi*pi*ecr*rhosn + cons32 = pi/2._r8*ecr + cons41 = pi*pi*ecr*rhow - cons14=gamma(bg+3._r8)*pi/4._r8*ecg - cons16=gamma(bi+3._r8)*pi/4._r8*ecg - cons17=4._r8*2._r8*3._r8*rhosu*pi*ecg*ecg*gamma(2._r8*bs+2._r8)/(8._r8*(rhog-rhosn)) - cons18=rhosn*rhosn - cons19=rhow*rhow - cons24=pi/4._r8*ecr*gamma(br+3._r8) - cons25=pi*pi/24._r8*rhow*ecr*gamma(br+6._r8) - - cons31=pi*pi*ecr*rhosn - cons32=pi/2._r8*ecr - cons41=pi*pi*ecr*rhow + droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3 - droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3 end subroutine zm_mphyi -!=============================================================================== +!=================================================================================================== subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qe, & eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & @@ -606,6 +515,12 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, real(r8) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) real(r8) :: dmc real(r8) :: ssmc + real(r8) :: so4mc + real(r8) :: mommc + real(r8) :: bcmc + real(r8) :: pommc + real(r8) :: soamc + real(r8) :: wght real(r8) :: dgnum_aitken ! bulk aerosol variables @@ -2127,9 +2042,32 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, dmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx) & +aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx)) ssmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx)) + +aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx)) + so4mc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_so4_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_so4_idx,aero%mode_coarse_idx)) +#if (defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE) + mommc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_mom_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_mom_idx,aero%mode_coarse_idx)) +#endif +#if (defined RAIN_EVAP_TO_COARSE_AERO) + bcmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_bc_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_bc_idx,aero%mode_coarse_idx)) + pommc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_pom_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_pom_idx,aero%mode_coarse_idx)) + soamc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_soa_idx,aero%mode_coarse_idx) & + +aero%mmrg_a(i,k,aero%coarse_soa_idx,aero%mode_coarse_idx)) +#endif if (dmc > 0._r8) then - dst_num = dmc/(ssmc + dmc) *(aero%numg_a(i,k-1,aero%mode_coarse_idx) & +#if ( ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE ) && ( defined RAIN_EVAP_TO_COARSE_AERO ) ) + wght = dmc/(ssmc + dmc + so4mc + bcmc + pommc + soamc + mommc) +#elif ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE ) + wght = dmc/(ssmc + dmc + so4mc + mommc) +#elif (defined RAIN_EVAP_TO_COARSE_AERO) + wght = dmc/(ssmc + dmc + so4mc + bcmc + pommc + soamc) +#else + wght = dmc/(ssmc + dmc + so4mc) +#endif + dst_num = wght *(aero%numg_a(i,k-1,aero%mode_coarse_idx) & + aero%numg_a(i,k,aero%mode_coarse_idx))*0.5_r8*rho(i,k)*1.0e-6_r8 else dst_num = 0.0_r8 @@ -2328,13 +2266,8 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, ! use size '3' for dust coarse mode... ! scale by dust fraction in coarse mode - dmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx)) - ssmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx)) if (dmc > 0.0_r8) then - nacon3 = dmc/(ssmc + dmc) * (aero%numg_a(i,k,aero%mode_coarse_idx) & - + aero%numg_a(i,k-1,aero%mode_coarse_idx))*0.5_r8*rho(i,k) + nacon3 = dst_num*tcnt*1.0e6_r8 end if else if (aero%scheme == 'bulk') then @@ -3275,6 +3208,6 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, end subroutine zm_mphy -!############################################################################## +!=================================================================================================== end module zm_microphysics diff --git a/components/eam/src/physics/cam/zm_microphysics_history.F90 b/components/eam/src/physics/cam/zm_microphysics_history.F90 new file mode 100644 index 000000000000..87dbee3f0416 --- /dev/null +++ b/components/eam/src/physics/cam/zm_microphysics_history.F90 @@ -0,0 +1,289 @@ +module zm_microphysics_history + !---------------------------------------------------------------------------- + ! Purpose: microphysics state structure definition and methods for ZM + ! Original Author: Xialiang Song and Guang Zhang, June 2010 + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver, pverp + use zm_microphysics_state, only: zm_microp_st + + public :: zm_microphysics_history_init ! add fields for history output + public :: zm_microphysics_history_out ! write history output related to ZM microphysics + +!=================================================================================================== +contains +!=================================================================================================== + +subroutine zm_microphysics_history_init() + !---------------------------------------------------------------------------- + ! Purpose: add output history variables for convective microphysics + !---------------------------------------------------------------------------- + use cam_history, only: addfld, horiz_only, add_default + !---------------------------------------------------------------------------- + call addfld( 'CLDLIQZM',(/ 'lev' /), 'A', 'g/m3', 'ZM cloud liq water') + call addfld( 'CLDICEZM',(/ 'lev' /), 'A', 'g/m3', 'ZM cloud ice water') + call addfld( 'CLIQSNUM',(/ 'lev' /), 'A', '1', 'ZM cloud liq water sample number') + call addfld( 'CICESNUM',(/ 'lev' /), 'A', '1', 'ZM cloud ice water sample number') + call addfld( 'QRAINZM' ,(/ 'lev' /), 'A', 'g/m3', 'ZM rain water') + call addfld( 'QSNOWZM' ,(/ 'lev' /), 'A', 'g/m3', 'ZM snow') + call addfld( 'QGRAPZM' ,(/ 'lev' /), 'A', 'g/m3', 'ZM graupel') + call addfld( 'CRAINNUM',(/ 'lev' /), 'A', '1', 'ZM cloud rain water sample number') + call addfld( 'CSNOWNUM',(/ 'lev' /), 'A', '1', 'ZM cloud snow sample number') + call addfld( 'CGRAPNUM',(/ 'lev' /), 'A', '1', 'ZM cloud graupel sample number') + call addfld( 'DIFZM', (/ 'lev' /), 'A', 'kg/kg/s ', 'ZM detrained ice water') + call addfld( 'DLFZM', (/ 'lev' /), 'A', 'kg/kg/s ', 'ZM detrained liq water') + call addfld( 'DNIFZM', (/ 'lev' /), 'A', '1/kg/s ', 'ZM detrained ice water num concen') + call addfld( 'DNLFZM', (/ 'lev' /), 'A', '1/kg/s ', 'ZM detrained liquid water num concen') + call addfld( 'WUZM', (/ 'lev' /), 'A', 'm/s', 'ZM vertical velocity') + call addfld( 'WUZMSNUM',(/ 'lev' /), 'A', '1', 'ZM vertical velocity sample number') + call addfld( 'QNLZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud liq water number concen') + call addfld( 'QNIZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud ice number concen') + call addfld( 'QNRZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud rain water number concen') + call addfld( 'QNSZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud snow number concen') + call addfld( 'QNGZM', (/ 'lev' /), 'A', '1/m3', 'ZM cloud graupel number concen') + call addfld( 'FRZZM', (/ 'lev' /), 'A', 'K/s', 'ZM heating tendency due to freezing') + call addfld( 'AUTOL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to autoconversion of droplets to rain') + call addfld( 'ACCRL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to accretion of droplets by rain') + call addfld( 'BERGN_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to Bergeron process') + call addfld( 'FHTIM_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to immersion freezing') + call addfld( 'FHTCT_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to contact freezing') + call addfld( 'FHML_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to homogeneous freezing of droplet') + call addfld( 'HMPI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to HM process') + call addfld( 'ACCSL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to accretion of droplet by snow') + call addfld( 'DLF_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to detrainment of droplet') + call addfld( 'COND_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to condensation') + call addfld( 'AUTOL_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to autoconversion of droplets to rain') + call addfld( 'ACCRL_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to accretion of droplets by rain') + call addfld( 'BERGN_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to Bergeron process') + call addfld( 'FHTIM_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to immersion freezing') + call addfld( 'FHTCT_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to contact freezing') + call addfld( 'FHML_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to homogeneous freezing of droplet') + call addfld( 'ACCSL_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to accretion of droplet by snow') + call addfld( 'ACTIV_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to droplets activation') + call addfld( 'DLF_N', (/ 'lev' /), 'A', '1/kg/m', 'ZM num tendency due to detrainment of droplet') + call addfld( 'AUTOI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to autoconversion of ice to snow') + call addfld( 'ACCSI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to accretion of ice by snow') + call addfld( 'DIF_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to detrainment of cloud ice') + call addfld( 'DEPOS_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to deposition') + call addfld( 'NUCLI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to ice nucleation') + call addfld( 'AUTOI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to autoconversion of ice to snow') + call addfld( 'ACCSI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to accretion of ice by snow') + call addfld( 'HMPI_N', (/ 'lev' /), 'A', '1/kg/s' , 'ZM num tendency due to HM process') + call addfld( 'DIF_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to detrainment of cloud ice') + call addfld( 'TRSPC_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of droplets due to convective transport') + call addfld( 'TRSPC_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of droplets due to convective transport') + call addfld( 'TRSPI_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of ice crystal due to convective transport') + call addfld( 'TRSPI_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of ice crystal due to convective transport') + call addfld( 'ACCGR_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to collection of rain by graupel') + call addfld( 'ACCGL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to collection of droplets by graupel') + call addfld( 'ACCGSL_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of droplets by snow') + call addfld( 'ACCGSR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of rain by snow') + call addfld( 'ACCGIR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of rain by ice') + call addfld( 'ACCGRI_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of ice by rain') + call addfld( 'ACCGRS_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel due to collection of snow by rain') + call addfld( 'ACCGSL_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel due to collection of droplets by snow') + call addfld( 'ACCGSR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel due to collection of rain by snow') + call addfld( 'ACCGIR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel due to collection of rain by ice') + call addfld( 'ACCSRI_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of snow due to collection of ice by rain') + call addfld( 'ACCIGL_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of ice mult(splintering) due to acc droplets by graupel') + call addfld( 'ACCIGR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of ice mult(splintering) due to acc rain by graupel') + call addfld( 'ACCSIR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of snow due to collection of rain by ice') + call addfld( 'ACCIGL_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of ice mult(splintering) due to acc droplets by graupel') + call addfld( 'ACCIGR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of ice mult(splintering) due to acc rain by graupel') + call addfld( 'ACCSIR_N',(/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of snow due to collection of rain by ice') + call addfld( 'ACCGL_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to collection of droplets by graupel') + call addfld( 'ACCGR_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency due to collection of rain by graupel') + call addfld( 'ACCIL_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of cloud ice due to collection of droplet by cloud ice') + call addfld( 'ACCIL_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of cloud ice due to collection of droplet by cloud ice') + call addfld( 'FALLR_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of rain fallout') + call addfld( 'FALLS_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of snow fallout') + call addfld( 'FALLG_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency of graupel fallout') + call addfld( 'FALLR_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of rain fallout') + call addfld( 'FALLS_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of snow fallout') + call addfld( 'FALLG_N', (/ 'lev' /), 'A', '1/kg/m' , 'ZM num tendency of graupel fallout') + call addfld( 'FHMR_M', (/ 'lev' /), 'A', 'kg/kg/m', 'ZM mass tendency due to homogeneous freezing of rain') + call addfld( 'PRECZ_SN',horiz_only , 'A', '#', 'ZM sample num of convective precipitation rate') + + !---------------------------------------------------------------------------- + + call add_default( 'CLDLIQZM', 1, ' ') + call add_default( 'CLDICEZM', 1, ' ') + call add_default( 'CLIQSNUM', 1, ' ') + call add_default( 'CICESNUM', 1, ' ') + call add_default( 'DIFZM', 1, ' ') + call add_default( 'DLFZM', 1, ' ') + call add_default( 'DNIFZM', 1, ' ') + call add_default( 'DNLFZM', 1, ' ') + call add_default( 'WUZM', 1, ' ') + call add_default( 'QRAINZM', 1, ' ') + call add_default( 'QSNOWZM', 1, ' ') + call add_default( 'QGRAPZM', 1, ' ') + call add_default( 'CRAINNUM', 1, ' ') + call add_default( 'CSNOWNUM', 1, ' ') + call add_default( 'CGRAPNUM', 1, ' ') + call add_default( 'QNLZM', 1, ' ') + call add_default( 'QNIZM', 1, ' ') + call add_default( 'QNRZM', 1, ' ') + call add_default( 'QNSZM', 1, ' ') + call add_default( 'QNGZM', 1, ' ') + call add_default( 'FRZZM', 1, ' ') + +end subroutine zm_microphysics_history_init + +!=================================================================================================== + +subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, dnlf, dnif, frz ) + !---------------------------------------------------------------------------- + ! Purpose: write out history variables for convective microphysics + !---------------------------------------------------------------------------- + use cam_history, only: outfld + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of columns in chunk + type(zm_microp_st), intent(in) :: microp_st ! ZM microphysics data structure + real(r8), dimension(pcols), intent(in) :: prec ! convective precip rate + real(r8), dimension(pcols,pver), intent(in) :: dlf ! detrainment of conv cld liq water mixing ratio + real(r8), dimension(pcols,pver), intent(in) :: dif ! detrainment of conv cld ice mixing ratio + real(r8), dimension(pcols,pver), intent(in) :: dnlf ! detrainment of conv cld liq water num concen + real(r8), dimension(pcols,pver), intent(in) :: dnif ! detrainment of conv cld ice num concen + real(r8), dimension(pcols,pver), intent(in) :: frz ! heating rate due to freezing + !---------------------------------------------------------------------------- + ! Local variables + integer :: i,k + real(r8), dimension(pcols) :: precz_snum ! sample num of conv precip rate + real(r8), dimension(pcols,pver) :: cice_snum ! convective cloud ice sample number + real(r8), dimension(pcols,pver) :: cliq_snum ! convective cloud liquid sample number + real(r8), dimension(pcols,pver) :: crain_snum ! convective rain water sample number + real(r8), dimension(pcols,pver) :: csnow_snum ! convective snow sample number + real(r8), dimension(pcols,pver) :: cgraupel_snum ! convective graupel sample number + real(r8), dimension(pcols,pver) :: wu_snum ! vertical velocity sample number + !---------------------------------------------------------------------------- + do k = 1,pver + do i = 1,ncol + if (microp_st%qice(i,k) > 0) cice_snum(i,k) = 1 + if (microp_st%qice(i,k) <= 0) cice_snum(i,k) = 0 + if (microp_st%qliq(i,k) > 0) cliq_snum(i,k) = 1 + if (microp_st%qliq(i,k) <= 0) cliq_snum(i,k) = 0 + if (microp_st%qsnow(i,k) > 0) csnow_snum(i,k) = 1 + if (microp_st%qsnow(i,k) <= 0) csnow_snum(i,k) = 0 + if (microp_st%qrain(i,k) > 0) crain_snum(i,k) = 1 + if (microp_st%qrain(i,k) <= 0) crain_snum(i,k) = 0 + if (microp_st%qgraupel(i,k) > 0) cgraupel_snum(i,k) = 1 + if (microp_st%qgraupel(i,k) <= 0) cgraupel_snum(i,k) = 0 + if (microp_st%wu(i,k) > 0) wu_snum(i,k) = 1 + if (microp_st%wu(i,k) <= 0) wu_snum(i,k) = 0 + end do + end do + + call outfld('CLIQSNUM',cliq_snum , pcols, lchnk ) + call outfld('CICESNUM',cice_snum , pcols, lchnk ) + call outfld('CRAINNUM',crain_snum , pcols, lchnk ) + call outfld('CSNOWNUM',csnow_snum , pcols, lchnk ) + call outfld('CGRAPNUM',cgraupel_snum , pcols, lchnk ) + call outfld('WUZMSNUM',wu_snum , pcols, lchnk ) + + call outfld('DIFZM' ,dif , pcols, lchnk ) + call outfld('DLFZM' ,dlf , pcols, lchnk ) + call outfld('DNIFZM' ,dnif , pcols, lchnk ) + call outfld('DNLFZM' ,dnlf , pcols, lchnk ) + call outfld('FRZZM' ,frz , pcols, lchnk ) + + call outfld('WUZM' ,microp_st%wu , pcols, lchnk ) + + call outfld('CLDLIQZM',microp_st%qliq , pcols, lchnk ) + call outfld('CLDICEZM',microp_st%qice , pcols, lchnk ) + call outfld('QRAINZM' ,microp_st%qrain , pcols, lchnk ) + call outfld('QSNOWZM' ,microp_st%qsnow , pcols, lchnk ) + call outfld('QGRAPZM' ,microp_st%qgraupel , pcols, lchnk ) + + call outfld('QNLZM' ,microp_st%qnl , pcols, lchnk ) + call outfld('QNIZM' ,microp_st%qni , pcols, lchnk ) + call outfld('QNRZM' ,microp_st%qnr , pcols, lchnk ) + call outfld('QNSZM' ,microp_st%qns , pcols, lchnk ) + call outfld('QNGZM' ,microp_st%qng , pcols, lchnk ) + + call outfld('AUTOL_M' ,microp_st%autolm , pcols, lchnk ) + call outfld('ACCRL_M' ,microp_st%accrlm , pcols, lchnk ) + call outfld('BERGN_M' ,microp_st%bergnm , pcols, lchnk ) + call outfld('FHTIM_M' ,microp_st%fhtimm , pcols, lchnk ) + call outfld('FHTCT_M' ,microp_st%fhtctm , pcols, lchnk ) + call outfld('FHML_M' ,microp_st%fhmlm , pcols, lchnk ) + call outfld('HMPI_M' ,microp_st%hmpim , pcols, lchnk ) + call outfld('ACCSL_M' ,microp_st%accslm , pcols, lchnk ) + call outfld('DLF_M' ,microp_st%dlfm , pcols, lchnk ) + + call outfld('AUTOL_N' ,microp_st%autoln , pcols, lchnk ) + call outfld('ACCRL_N' ,microp_st%accrln , pcols, lchnk ) + call outfld('BERGN_N' ,microp_st%bergnn , pcols, lchnk ) + call outfld('FHTIM_N' ,microp_st%fhtimn , pcols, lchnk ) + call outfld('FHTCT_N' ,microp_st%fhtctn , pcols, lchnk ) + call outfld('FHML_N' ,microp_st%fhmln , pcols, lchnk ) + call outfld('ACCSL_N' ,microp_st%accsln , pcols, lchnk ) + call outfld('ACTIV_N' ,microp_st%activn , pcols, lchnk ) + call outfld('DLF_N' ,microp_st%dlfn , pcols, lchnk ) + call outfld('AUTOI_M' ,microp_st%autoim , pcols, lchnk ) + call outfld('ACCSI_M' ,microp_st%accsim , pcols, lchnk ) + call outfld('DIF_M' ,microp_st%difm , pcols, lchnk ) + call outfld('NUCLI_N' ,microp_st%nuclin , pcols, lchnk ) + call outfld('AUTOI_N' ,microp_st%autoin , pcols, lchnk ) + call outfld('ACCSI_N' ,microp_st%accsin , pcols, lchnk ) + call outfld('HMPI_N' ,microp_st%hmpin , pcols, lchnk ) + call outfld('DIF_N' ,microp_st%difn , pcols, lchnk ) + call outfld('COND_M' ,microp_st%cmel , pcols, lchnk ) + call outfld('DEPOS_M' ,microp_st%cmei , pcols, lchnk ) + + call outfld('TRSPC_M' ,microp_st%trspcm , pcols, lchnk ) + call outfld('TRSPC_N' ,microp_st%trspcn , pcols, lchnk ) + call outfld('TRSPI_M' ,microp_st%trspim , pcols, lchnk ) + call outfld('TRSPI_N' ,microp_st%trspin , pcols, lchnk ) + + call outfld('ACCGR_M' ,microp_st%accgrm , pcols, lchnk ) + call outfld('ACCGL_M' ,microp_st%accglm , pcols, lchnk ) + call outfld('ACCGSL_M',microp_st%accgslm , pcols, lchnk ) + call outfld('ACCGSR_M',microp_st%accgsrm , pcols, lchnk ) + call outfld('ACCGIR_M',microp_st%accgirm , pcols, lchnk ) + call outfld('ACCGRI_M',microp_st%accgrim , pcols, lchnk ) + call outfld('ACCGRS_M',microp_st%accgrsm , pcols, lchnk ) + + call outfld('ACCGSL_N',microp_st%accgsln , pcols, lchnk ) + call outfld('ACCGSR_N',microp_st%accgsrn , pcols, lchnk ) + call outfld('ACCGIR_N',microp_st%accgirn , pcols, lchnk ) + + call outfld('ACCSRI_M',microp_st%accsrim , pcols, lchnk ) + call outfld('ACCIGL_M',microp_st%acciglm , pcols, lchnk ) + call outfld('ACCIGR_M',microp_st%accigrm , pcols, lchnk ) + call outfld('ACCSIR_M',microp_st%accsirm , pcols, lchnk ) + + call outfld('ACCIGL_N',microp_st%accigln , pcols, lchnk ) + call outfld('ACCIGR_N',microp_st%accigrn , pcols, lchnk ) + call outfld('ACCSIR_N',microp_st%accsirn , pcols, lchnk ) + call outfld('ACCGL_N' ,microp_st%accgln , pcols, lchnk ) + call outfld('ACCGR_N' ,microp_st%accgrn , pcols, lchnk ) + + call outfld('ACCIL_M' ,microp_st%accilm , pcols, lchnk ) + call outfld('ACCIL_N' ,microp_st%acciln , pcols, lchnk ) + + call outfld('FALLR_M' ,microp_st%fallrm , pcols, lchnk ) + call outfld('FALLS_M' ,microp_st%fallsm , pcols, lchnk ) + call outfld('FALLG_M' ,microp_st%fallgm , pcols, lchnk ) + call outfld('FALLR_N' ,microp_st%fallrn , pcols, lchnk ) + call outfld('FALLS_N' ,microp_st%fallsn , pcols, lchnk ) + call outfld('FALLG_N' ,microp_st%fallgn , pcols, lchnk ) + + call outfld('FHMR_M' ,microp_st%fhmrm , pcols, lchnk ) + + do i = 1,ncol + if (prec(i) .gt. 0) then + precz_snum(i) = 1 + else + precz_snum(i) = 0 + end if + end do + call outfld('PRECZ_SN', precz_snum, pcols, lchnk ) + +end subroutine zm_microphysics_history_out + +!=================================================================================================== + +end module zm_microphysics_history diff --git a/components/eam/src/physics/cam/zm_microphysics_state.F90 b/components/eam/src/physics/cam/zm_microphysics_state.F90 index 6bdd841fb581..79b5b55d5556 100644 --- a/components/eam/src/physics/cam/zm_microphysics_state.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_state.F90 @@ -1,91 +1,91 @@ -module zm_microphysics_state - !----------------------------------------------------------------------------- - ! Purpose: microphysics state structure definition and methods for ZM - ! Original Author: Xialiang Song and Guang Zhang, June 2010 - !----------------------------------------------------------------------------- - use shr_kind_mod, only: r8=>shr_kind_r8 - use ppgrid, only: pcols, pver, pverp +module zm_microphysics_state + !---------------------------------------------------------------------------- + ! Purpose: microphysics state structure definition and methods for ZM + ! Original Author: Xialiang Song and Guang Zhang, June 2010 + !---------------------------------------------------------------------------- + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pcols, pver, pverp - public :: zm_microp_st ! structure to hold state and tendency of ZM microphysics - public :: zm_microp_st_alloc - public :: zm_microp_st_dealloc - public :: zm_microp_st_ini - public :: zm_microp_st_gb + public :: zm_microp_st ! structure to hold state and tendency of ZM microphysics + public :: zm_microp_st_alloc ! allocate zm_microp_st variables + public :: zm_microp_st_dealloc ! deallocate zm_microp_st variables + public :: zm_microp_st_ini ! intialize zm_microp_st variables + public :: zm_microp_st_gb ! gather microphysic arrays !=================================================================================================== type :: zm_microp_st - real(r8), allocatable, dimension(:,:) :: wu ! vertical velocity - real(r8), allocatable, dimension(:,:) :: qliq ! convective cloud liquid water. - real(r8), allocatable, dimension(:,:) :: qice ! convective cloud ice. - real(r8), allocatable, dimension(:,:) :: qrain ! convective rain water. - real(r8), allocatable, dimension(:,:) :: qsnow ! convective snow. - real(r8), allocatable, dimension(:,:) :: qgraupel ! convective graupel. - real(r8), allocatable, dimension(:,:) :: qnl ! convective cloud liquid water num concen. - real(r8), allocatable, dimension(:,:) :: qni ! convective cloud ice num concen. - real(r8), allocatable, dimension(:,:) :: qnr ! convective rain water num concen. - real(r8), allocatable, dimension(:,:) :: qns ! convective snow num concen. - real(r8), allocatable, dimension(:,:) :: qng ! convective graupel num concen. - real(r8), allocatable, dimension(:,:) :: autolm ! mass tendency due to autoconversion of droplets to rain - real(r8), allocatable, dimension(:,:) :: accrlm ! mass tendency due to accretion of droplets by rain - real(r8), allocatable, dimension(:,:) :: bergnm ! mass tendency due to Bergeron process - real(r8), allocatable, dimension(:,:) :: fhtimm ! mass tendency due to immersion freezing - real(r8), allocatable, dimension(:,:) :: fhtctm ! mass tendency due to contact freezing - real(r8), allocatable, dimension(:,:) :: fhmlm ! mass tendency due to homogeneous freezing - real(r8), allocatable, dimension(:,:) :: hmpim ! mass tendency due to HM process - real(r8), allocatable, dimension(:,:) :: accslm ! mass tendency due to accretion of droplets by snow - real(r8), allocatable, dimension(:,:) :: dlfm ! mass tendency due to detrainment of droplet - real(r8), allocatable, dimension(:,:) :: autoln ! num tendency due to autoconversion of droplets to rain - real(r8), allocatable, dimension(:,:) :: accrln ! num tendency due to accretion of droplets by rain - real(r8), allocatable, dimension(:,:) :: bergnn ! num tendency due to Bergeron process - real(r8), allocatable, dimension(:,:) :: fhtimn ! num tendency due to immersion freezing - real(r8), allocatable, dimension(:,:) :: fhtctn ! num tendency due to contact freezing - real(r8), allocatable, dimension(:,:) :: fhmln ! num tendency due to homogeneous freezing - real(r8), allocatable, dimension(:,:) :: accsln ! num tendency due to accretion of droplets by snow - real(r8), allocatable, dimension(:,:) :: activn ! num tendency due to droplets activation - real(r8), allocatable, dimension(:,:) :: dlfn ! num tendency due to detrainment of droplet - real(r8), allocatable, dimension(:,:) :: autoim ! mass tendency due to autoconversion of cloud ice to snow - real(r8), allocatable, dimension(:,:) :: accsim ! mass tendency due to accretion of cloud ice by snow - real(r8), allocatable, dimension(:,:) :: difm ! mass tendency due to detrainment of cloud ice - real(r8), allocatable, dimension(:,:) :: nuclin ! num tendency due to ice nucleation - real(r8), allocatable, dimension(:,:) :: autoin ! num tendency due to autoconversion of cloud ice to snow - real(r8), allocatable, dimension(:,:) :: accsin ! num tendency due to accretion of cloud ice by snow - real(r8), allocatable, dimension(:,:) :: hmpin ! num tendency due to HM process - real(r8), allocatable, dimension(:,:) :: difn ! num tendency due to detrainment of cloud ice - real(r8), allocatable, dimension(:,:) :: cmel ! mass tendency due to condensation - real(r8), allocatable, dimension(:,:) :: cmei ! mass tendency due to deposition - real(r8), allocatable, dimension(:,:) :: trspcm ! LWC tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: trspcn ! droplet num tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: trspim ! IWC tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: trspin ! ice crystal num tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: accgrm ! mass tendency due to collection of rain by graupel - real(r8), allocatable, dimension(:,:) :: accglm ! mass tendency due to collection of droplets by graupel - real(r8), allocatable, dimension(:,:) :: accgslm ! mass tendency of graupel due to collection of droplets by snow - real(r8), allocatable, dimension(:,:) :: accgsrm ! mass tendency of graupel due to collection of rain by snow - real(r8), allocatable, dimension(:,:) :: accgirm ! mass tendency of graupel due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accgrim ! mass tendency of graupel due to collection of ice by rain - real(r8), allocatable, dimension(:,:) :: accgrsm ! mass tendency due to collection of snow by rain - real(r8), allocatable, dimension(:,:) :: accgsln ! num tendency of graupel due to collection of droplets by snow - real(r8), allocatable, dimension(:,:) :: accgsrn ! num tendency of graupel due to collection of rain by snow - real(r8), allocatable, dimension(:,:) :: accgirn ! num tendency of graupel due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accsrim ! mass tendency of snow due to collection of ice by rain - real(r8), allocatable, dimension(:,:) :: acciglm ! mass tendency of ice mult(splintering) due to acc droplets by graupel - real(r8), allocatable, dimension(:,:) :: accigrm ! mass tendency of ice mult(splintering) due to acc rain by graupel - real(r8), allocatable, dimension(:,:) :: accsirm ! mass tendency of snow due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accigln ! num tendency of ice mult(splintering) due to acc droplets by graupel - real(r8), allocatable, dimension(:,:) :: accigrn ! num tendency of ice mult(splintering) due to acc rain by graupel - real(r8), allocatable, dimension(:,:) :: accsirn ! num tendency of snow due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accgln ! num tendency due to collection of droplets by graupel - real(r8), allocatable, dimension(:,:) :: accgrn ! num tendency due to collection of rain by graupel - real(r8), allocatable, dimension(:,:) :: accilm ! mass tendency of cloud ice due to collection of droplet by cloud ice - real(r8), allocatable, dimension(:,:) :: acciln ! number conc tendency of cloud ice due to collection of droplet by cloud ice - real(r8), allocatable, dimension(:,:) :: fallrm ! mass tendency of rain fallout - real(r8), allocatable, dimension(:,:) :: fallsm ! mass tendency of snow fallout - real(r8), allocatable, dimension(:,:) :: fallgm ! mass tendency of graupel fallout - real(r8), allocatable, dimension(:,:) :: fallrn ! num tendency of rain fallout - real(r8), allocatable, dimension(:,:) :: fallsn ! num tendency of snow fallout - real(r8), allocatable, dimension(:,:) :: fallgn ! num tendency of graupel fallout - real(r8), allocatable, dimension(:,:) :: fhmrm ! mass tendency due to homogeneous freezing of rain + real(r8), allocatable, dimension(:,:) :: wu ! vertical velocity + real(r8), allocatable, dimension(:,:) :: qliq ! convective cloud liquid water. + real(r8), allocatable, dimension(:,:) :: qice ! convective cloud ice. + real(r8), allocatable, dimension(:,:) :: qrain ! convective rain water. + real(r8), allocatable, dimension(:,:) :: qsnow ! convective snow. + real(r8), allocatable, dimension(:,:) :: qgraupel ! convective graupel. + real(r8), allocatable, dimension(:,:) :: qnl ! convective cloud liquid water num concen. + real(r8), allocatable, dimension(:,:) :: qni ! convective cloud ice num concen. + real(r8), allocatable, dimension(:,:) :: qnr ! convective rain water num concen. + real(r8), allocatable, dimension(:,:) :: qns ! convective snow num concen. + real(r8), allocatable, dimension(:,:) :: qng ! convective graupel num concen. + real(r8), allocatable, dimension(:,:) :: autolm ! mass tendency due to autoconversion of droplets to rain + real(r8), allocatable, dimension(:,:) :: accrlm ! mass tendency due to accretion of droplets by rain + real(r8), allocatable, dimension(:,:) :: bergnm ! mass tendency due to Bergeron process + real(r8), allocatable, dimension(:,:) :: fhtimm ! mass tendency due to immersion freezing + real(r8), allocatable, dimension(:,:) :: fhtctm ! mass tendency due to contact freezing + real(r8), allocatable, dimension(:,:) :: fhmlm ! mass tendency due to homogeneous freezing + real(r8), allocatable, dimension(:,:) :: hmpim ! mass tendency due to HM process + real(r8), allocatable, dimension(:,:) :: accslm ! mass tendency due to accretion of droplets by snow + real(r8), allocatable, dimension(:,:) :: dlfm ! mass tendency due to detrainment of droplet + real(r8), allocatable, dimension(:,:) :: autoln ! num tendency due to autoconversion of droplets to rain + real(r8), allocatable, dimension(:,:) :: accrln ! num tendency due to accretion of droplets by rain + real(r8), allocatable, dimension(:,:) :: bergnn ! num tendency due to Bergeron process + real(r8), allocatable, dimension(:,:) :: fhtimn ! num tendency due to immersion freezing + real(r8), allocatable, dimension(:,:) :: fhtctn ! num tendency due to contact freezing + real(r8), allocatable, dimension(:,:) :: fhmln ! num tendency due to homogeneous freezing + real(r8), allocatable, dimension(:,:) :: accsln ! num tendency due to accretion of droplets by snow + real(r8), allocatable, dimension(:,:) :: activn ! num tendency due to droplets activation + real(r8), allocatable, dimension(:,:) :: dlfn ! num tendency due to detrainment of droplet + real(r8), allocatable, dimension(:,:) :: autoim ! mass tendency due to autoconversion of cloud ice to snow + real(r8), allocatable, dimension(:,:) :: accsim ! mass tendency due to accretion of cloud ice by snow + real(r8), allocatable, dimension(:,:) :: difm ! mass tendency due to detrainment of cloud ice + real(r8), allocatable, dimension(:,:) :: nuclin ! num tendency due to ice nucleation + real(r8), allocatable, dimension(:,:) :: autoin ! num tendency due to autoconversion of cloud ice to snow + real(r8), allocatable, dimension(:,:) :: accsin ! num tendency due to accretion of cloud ice by snow + real(r8), allocatable, dimension(:,:) :: hmpin ! num tendency due to HM process + real(r8), allocatable, dimension(:,:) :: difn ! num tendency due to detrainment of cloud ice + real(r8), allocatable, dimension(:,:) :: cmel ! mass tendency due to condensation + real(r8), allocatable, dimension(:,:) :: cmei ! mass tendency due to deposition + real(r8), allocatable, dimension(:,:) :: trspcm ! LWC tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: trspcn ! droplet num tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: trspim ! IWC tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: trspin ! ice crystal num tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: accgrm ! mass tendency due to collection of rain by graupel + real(r8), allocatable, dimension(:,:) :: accglm ! mass tendency due to collection of droplets by graupel + real(r8), allocatable, dimension(:,:) :: accgslm ! mass tendency of graupel due to collection of droplets by snow + real(r8), allocatable, dimension(:,:) :: accgsrm ! mass tendency of graupel due to collection of rain by snow + real(r8), allocatable, dimension(:,:) :: accgirm ! mass tendency of graupel due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accgrim ! mass tendency of graupel due to collection of ice by rain + real(r8), allocatable, dimension(:,:) :: accgrsm ! mass tendency due to collection of snow by rain + real(r8), allocatable, dimension(:,:) :: accgsln ! num tendency of graupel due to collection of droplets by snow + real(r8), allocatable, dimension(:,:) :: accgsrn ! num tendency of graupel due to collection of rain by snow + real(r8), allocatable, dimension(:,:) :: accgirn ! num tendency of graupel due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accsrim ! mass tendency of snow due to collection of ice by rain + real(r8), allocatable, dimension(:,:) :: acciglm ! mass tendency of ice mult(splintering) due to acc droplets by graupel + real(r8), allocatable, dimension(:,:) :: accigrm ! mass tendency of ice mult(splintering) due to acc rain by graupel + real(r8), allocatable, dimension(:,:) :: accsirm ! mass tendency of snow due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accigln ! num tendency of ice mult(splintering) due to acc droplets by graupel + real(r8), allocatable, dimension(:,:) :: accigrn ! num tendency of ice mult(splintering) due to acc rain by graupel + real(r8), allocatable, dimension(:,:) :: accsirn ! num tendency of snow due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accgln ! num tendency due to collection of droplets by graupel + real(r8), allocatable, dimension(:,:) :: accgrn ! num tendency due to collection of rain by graupel + real(r8), allocatable, dimension(:,:) :: accilm ! mass tendency of cloud ice due to collection of droplet by cloud ice + real(r8), allocatable, dimension(:,:) :: acciln ! number conc tendency of cloud ice due to collection of droplet by cloud ice + real(r8), allocatable, dimension(:,:) :: fallrm ! mass tendency of rain fallout + real(r8), allocatable, dimension(:,:) :: fallsm ! mass tendency of snow fallout + real(r8), allocatable, dimension(:,:) :: fallgm ! mass tendency of graupel fallout + real(r8), allocatable, dimension(:,:) :: fallrn ! num tendency of rain fallout + real(r8), allocatable, dimension(:,:) :: fallsn ! num tendency of snow fallout + real(r8), allocatable, dimension(:,:) :: fallgn ! num tendency of graupel fallout + real(r8), allocatable, dimension(:,:) :: fhmrm ! mass tendency due to homogeneous freezing of rain end type zm_microp_st !=================================================================================================== @@ -93,333 +93,344 @@ module zm_microphysics_state !=================================================================================================== subroutine zm_microp_st_alloc(loc_microp_st) - - type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - - allocate( & - loc_microp_st%wu (pcols,pver), & - loc_microp_st%qliq (pcols,pver), & - loc_microp_st%qice (pcols,pver), & - loc_microp_st%qrain (pcols,pver), & - loc_microp_st%qsnow (pcols,pver), & - loc_microp_st%qgraupel (pcols,pver), & - loc_microp_st%qnl (pcols,pver), & - loc_microp_st%qni (pcols,pver), & - loc_microp_st%qnr (pcols,pver), & - loc_microp_st%qns (pcols,pver), & - loc_microp_st%qng (pcols,pver), & - loc_microp_st%autolm (pcols,pver), & - loc_microp_st%accrlm (pcols,pver), & - loc_microp_st%bergnm (pcols,pver), & - loc_microp_st%fhtimm (pcols,pver), & - loc_microp_st%fhtctm (pcols,pver), & - loc_microp_st%fhmlm (pcols,pver), & - loc_microp_st%hmpim (pcols,pver), & - loc_microp_st%accslm (pcols,pver), & - loc_microp_st%dlfm (pcols,pver), & - loc_microp_st%autoln (pcols,pver), & - loc_microp_st%accrln (pcols,pver), & - loc_microp_st%bergnn (pcols,pver), & - loc_microp_st%fhtimn (pcols,pver), & - loc_microp_st%fhtctn (pcols,pver), & - loc_microp_st%fhmln (pcols,pver), & - loc_microp_st%accsln (pcols,pver), & - loc_microp_st%activn (pcols,pver), & - loc_microp_st%dlfn (pcols,pver), & - loc_microp_st%autoim (pcols,pver), & - loc_microp_st%accsim (pcols,pver), & - loc_microp_st%difm (pcols,pver), & - loc_microp_st%nuclin (pcols,pver), & - loc_microp_st%autoin (pcols,pver), & - loc_microp_st%accsin (pcols,pver), & - loc_microp_st%hmpin (pcols,pver), & - loc_microp_st%difn (pcols,pver), & - loc_microp_st%cmel (pcols,pver), & - loc_microp_st%cmei (pcols,pver), & - loc_microp_st%trspcm (pcols,pver), & - loc_microp_st%trspcn (pcols,pver), & - loc_microp_st%trspim (pcols,pver), & - loc_microp_st%trspin (pcols,pver), & - loc_microp_st%accgrm (pcols,pver), & - loc_microp_st%accglm (pcols,pver), & - loc_microp_st%accgslm (pcols,pver), & - loc_microp_st%accgsrm (pcols,pver), & - loc_microp_st%accgirm (pcols,pver), & - loc_microp_st%accgrim (pcols,pver), & - loc_microp_st%accgrsm (pcols,pver), & - loc_microp_st%accgsln (pcols,pver), & - loc_microp_st%accgsrn (pcols,pver), & - loc_microp_st%accgirn (pcols,pver), & - loc_microp_st%accsrim (pcols,pver), & - loc_microp_st%acciglm (pcols,pver), & - loc_microp_st%accigrm (pcols,pver), & - loc_microp_st%accsirm (pcols,pver), & - loc_microp_st%accigln (pcols,pver), & - loc_microp_st%accigrn (pcols,pver), & - loc_microp_st%accsirn (pcols,pver), & - loc_microp_st%accgln (pcols,pver), & - loc_microp_st%accgrn (pcols,pver), & - loc_microp_st%accilm (pcols,pver), & - loc_microp_st%acciln (pcols,pver), & - loc_microp_st%fallrm (pcols,pver), & - loc_microp_st%fallsm (pcols,pver), & - loc_microp_st%fallgm (pcols,pver), & - loc_microp_st%fallrn (pcols,pver), & - loc_microp_st%fallsn (pcols,pver), & - loc_microp_st%fallgn (pcols,pver), & - loc_microp_st%fhmrm (pcols,pver) ) + !---------------------------------------------------------------------------- + ! Purpose: allocate zm_microp_st variables + !---------------------------------------------------------------------------- + ! Arguments + type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics + !---------------------------------------------------------------------------- + allocate( & + loc_microp_st%wu (pcols,pver), & + loc_microp_st%qliq (pcols,pver), & + loc_microp_st%qice (pcols,pver), & + loc_microp_st%qrain (pcols,pver), & + loc_microp_st%qsnow (pcols,pver), & + loc_microp_st%qgraupel (pcols,pver), & + loc_microp_st%qnl (pcols,pver), & + loc_microp_st%qni (pcols,pver), & + loc_microp_st%qnr (pcols,pver), & + loc_microp_st%qns (pcols,pver), & + loc_microp_st%qng (pcols,pver), & + loc_microp_st%autolm (pcols,pver), & + loc_microp_st%accrlm (pcols,pver), & + loc_microp_st%bergnm (pcols,pver), & + loc_microp_st%fhtimm (pcols,pver), & + loc_microp_st%fhtctm (pcols,pver), & + loc_microp_st%fhmlm (pcols,pver), & + loc_microp_st%hmpim (pcols,pver), & + loc_microp_st%accslm (pcols,pver), & + loc_microp_st%dlfm (pcols,pver), & + loc_microp_st%autoln (pcols,pver), & + loc_microp_st%accrln (pcols,pver), & + loc_microp_st%bergnn (pcols,pver), & + loc_microp_st%fhtimn (pcols,pver), & + loc_microp_st%fhtctn (pcols,pver), & + loc_microp_st%fhmln (pcols,pver), & + loc_microp_st%accsln (pcols,pver), & + loc_microp_st%activn (pcols,pver), & + loc_microp_st%dlfn (pcols,pver), & + loc_microp_st%autoim (pcols,pver), & + loc_microp_st%accsim (pcols,pver), & + loc_microp_st%difm (pcols,pver), & + loc_microp_st%nuclin (pcols,pver), & + loc_microp_st%autoin (pcols,pver), & + loc_microp_st%accsin (pcols,pver), & + loc_microp_st%hmpin (pcols,pver), & + loc_microp_st%difn (pcols,pver), & + loc_microp_st%cmel (pcols,pver), & + loc_microp_st%cmei (pcols,pver), & + loc_microp_st%trspcm (pcols,pver), & + loc_microp_st%trspcn (pcols,pver), & + loc_microp_st%trspim (pcols,pver), & + loc_microp_st%trspin (pcols,pver), & + loc_microp_st%accgrm (pcols,pver), & + loc_microp_st%accglm (pcols,pver), & + loc_microp_st%accgslm (pcols,pver), & + loc_microp_st%accgsrm (pcols,pver), & + loc_microp_st%accgirm (pcols,pver), & + loc_microp_st%accgrim (pcols,pver), & + loc_microp_st%accgrsm (pcols,pver), & + loc_microp_st%accgsln (pcols,pver), & + loc_microp_st%accgsrn (pcols,pver), & + loc_microp_st%accgirn (pcols,pver), & + loc_microp_st%accsrim (pcols,pver), & + loc_microp_st%acciglm (pcols,pver), & + loc_microp_st%accigrm (pcols,pver), & + loc_microp_st%accsirm (pcols,pver), & + loc_microp_st%accigln (pcols,pver), & + loc_microp_st%accigrn (pcols,pver), & + loc_microp_st%accsirn (pcols,pver), & + loc_microp_st%accgln (pcols,pver), & + loc_microp_st%accgrn (pcols,pver), & + loc_microp_st%accilm (pcols,pver), & + loc_microp_st%acciln (pcols,pver), & + loc_microp_st%fallrm (pcols,pver), & + loc_microp_st%fallsm (pcols,pver), & + loc_microp_st%fallgm (pcols,pver), & + loc_microp_st%fallrn (pcols,pver), & + loc_microp_st%fallsn (pcols,pver), & + loc_microp_st%fallgn (pcols,pver), & + loc_microp_st%fhmrm (pcols,pver) ) end subroutine zm_microp_st_alloc !=================================================================================================== subroutine zm_microp_st_dealloc(loc_microp_st) - - type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - - deallocate( & - loc_microp_st%wu, & - loc_microp_st%qliq, & - loc_microp_st%qice, & - loc_microp_st%qrain, & - loc_microp_st%qsnow, & - loc_microp_st%qgraupel, & - loc_microp_st%qnl, & - loc_microp_st%qni, & - loc_microp_st%qnr, & - loc_microp_st%qns, & - loc_microp_st%qng, & - loc_microp_st%autolm, & - loc_microp_st%accrlm, & - loc_microp_st%bergnm, & - loc_microp_st%fhtimm, & - loc_microp_st%fhtctm, & - loc_microp_st%fhmlm , & - loc_microp_st%hmpim , & - loc_microp_st%accslm, & - loc_microp_st%dlfm , & - loc_microp_st%autoln, & - loc_microp_st%accrln, & - loc_microp_st%bergnn, & - loc_microp_st%fhtimn, & - loc_microp_st%fhtctn, & - loc_microp_st%fhmln , & - loc_microp_st%accsln, & - loc_microp_st%activn, & - loc_microp_st%dlfn , & - loc_microp_st%autoim, & - loc_microp_st%accsim, & - loc_microp_st%difm , & - loc_microp_st%nuclin, & - loc_microp_st%autoin, & - loc_microp_st%accsin, & - loc_microp_st%hmpin, & - loc_microp_st%difn, & - loc_microp_st%cmel, & - loc_microp_st%cmei, & - loc_microp_st%trspcm, & - loc_microp_st%trspcn, & - loc_microp_st%trspim, & - loc_microp_st%trspin, & - loc_microp_st%accgrm, & - loc_microp_st%accglm, & - loc_microp_st%accgslm, & - loc_microp_st%accgsrm, & - loc_microp_st%accgirm, & - loc_microp_st%accgrim, & - loc_microp_st%accgrsm, & - loc_microp_st%accgsln, & - loc_microp_st%accgsrn, & - loc_microp_st%accgirn, & - loc_microp_st%accsrim, & - loc_microp_st%acciglm, & - loc_microp_st%accigrm, & - loc_microp_st%accsirm, & - loc_microp_st%accigln, & - loc_microp_st%accigrn, & - loc_microp_st%accsirn, & - loc_microp_st%accgln, & - loc_microp_st%accgrn, & - loc_microp_st%accilm, & - loc_microp_st%acciln, & - loc_microp_st%fallrm, & - loc_microp_st%fallsm, & - loc_microp_st%fallgm, & - loc_microp_st%fallrn, & - loc_microp_st%fallsn, & - loc_microp_st%fallgn, & - loc_microp_st%fhmrm ) + !---------------------------------------------------------------------------- + ! Purpose: deallocate zm_microp_st variables + !---------------------------------------------------------------------------- + ! Arguments + type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics + !---------------------------------------------------------------------------- + deallocate( & + loc_microp_st%wu, & + loc_microp_st%qliq, & + loc_microp_st%qice, & + loc_microp_st%qrain, & + loc_microp_st%qsnow, & + loc_microp_st%qgraupel, & + loc_microp_st%qnl, & + loc_microp_st%qni, & + loc_microp_st%qnr, & + loc_microp_st%qns, & + loc_microp_st%qng, & + loc_microp_st%autolm, & + loc_microp_st%accrlm, & + loc_microp_st%bergnm, & + loc_microp_st%fhtimm, & + loc_microp_st%fhtctm, & + loc_microp_st%fhmlm , & + loc_microp_st%hmpim , & + loc_microp_st%accslm, & + loc_microp_st%dlfm , & + loc_microp_st%autoln, & + loc_microp_st%accrln, & + loc_microp_st%bergnn, & + loc_microp_st%fhtimn, & + loc_microp_st%fhtctn, & + loc_microp_st%fhmln , & + loc_microp_st%accsln, & + loc_microp_st%activn, & + loc_microp_st%dlfn , & + loc_microp_st%autoim, & + loc_microp_st%accsim, & + loc_microp_st%difm , & + loc_microp_st%nuclin, & + loc_microp_st%autoin, & + loc_microp_st%accsin, & + loc_microp_st%hmpin, & + loc_microp_st%difn, & + loc_microp_st%cmel, & + loc_microp_st%cmei, & + loc_microp_st%trspcm, & + loc_microp_st%trspcn, & + loc_microp_st%trspim, & + loc_microp_st%trspin, & + loc_microp_st%accgrm, & + loc_microp_st%accglm, & + loc_microp_st%accgslm, & + loc_microp_st%accgsrm, & + loc_microp_st%accgirm, & + loc_microp_st%accgrim, & + loc_microp_st%accgrsm, & + loc_microp_st%accgsln, & + loc_microp_st%accgsrn, & + loc_microp_st%accgirn, & + loc_microp_st%accsrim, & + loc_microp_st%acciglm, & + loc_microp_st%accigrm, & + loc_microp_st%accsirm, & + loc_microp_st%accigln, & + loc_microp_st%accigrn, & + loc_microp_st%accsirn, & + loc_microp_st%accgln, & + loc_microp_st%accgrn, & + loc_microp_st%accilm, & + loc_microp_st%acciln, & + loc_microp_st%fallrm, & + loc_microp_st%fallsm, & + loc_microp_st%fallgm, & + loc_microp_st%fallrn, & + loc_microp_st%fallsn, & + loc_microp_st%fallgn, & + loc_microp_st%fhmrm ) end subroutine zm_microp_st_dealloc !=================================================================================================== subroutine zm_microp_st_ini(microp_st,ncol) - - type(zm_microp_st) :: microp_st ! state and tendency of convective microphysics - integer, intent(in) :: ncol ! number of atmospheric columns - - microp_st%wu (1:ncol,1:pver) = 0._r8 - microp_st%qliq (1:ncol,1:pver) = 0._r8 - microp_st%qice (1:ncol,1:pver) = 0._r8 - microp_st%qrain (1:ncol,1:pver) = 0._r8 - microp_st%qsnow (1:ncol,1:pver) = 0._r8 - microp_st%qgraupel (1:ncol,1:pver) = 0._r8 - microp_st%qnl (1:ncol,1:pver) = 0._r8 - microp_st%qni (1:ncol,1:pver) = 0._r8 - microp_st%qnr (1:ncol,1:pver) = 0._r8 - microp_st%qns (1:ncol,1:pver) = 0._r8 - microp_st%qng (1:ncol,1:pver) = 0._r8 - microp_st%autolm (1:ncol,1:pver) = 0._r8 - microp_st%accrlm (1:ncol,1:pver) = 0._r8 - microp_st%bergnm (1:ncol,1:pver) = 0._r8 - microp_st%fhtimm (1:ncol,1:pver) = 0._r8 - microp_st%fhtctm (1:ncol,1:pver) = 0._r8 - microp_st%fhmlm (1:ncol,1:pver) = 0._r8 - microp_st%hmpim (1:ncol,1:pver) = 0._r8 - microp_st%accslm (1:ncol,1:pver) = 0._r8 - microp_st%dlfm (1:ncol,1:pver) = 0._r8 - microp_st%autoln (1:ncol,1:pver) = 0._r8 - microp_st%accrln (1:ncol,1:pver) = 0._r8 - microp_st%bergnn (1:ncol,1:pver) = 0._r8 - microp_st%fhtimn (1:ncol,1:pver) = 0._r8 - microp_st%fhtctn (1:ncol,1:pver) = 0._r8 - microp_st%fhmln (1:ncol,1:pver) = 0._r8 - microp_st%accsln (1:ncol,1:pver) = 0._r8 - microp_st%activn (1:ncol,1:pver) = 0._r8 - microp_st%dlfn (1:ncol,1:pver) = 0._r8 - microp_st%cmel (1:ncol,1:pver) = 0._r8 - microp_st%autoim (1:ncol,1:pver) = 0._r8 - microp_st%accsim (1:ncol,1:pver) = 0._r8 - microp_st%difm (1:ncol,1:pver) = 0._r8 - microp_st%cmei (1:ncol,1:pver) = 0._r8 - microp_st%nuclin (1:ncol,1:pver) = 0._r8 - microp_st%autoin (1:ncol,1:pver) = 0._r8 - microp_st%accsin (1:ncol,1:pver) = 0._r8 - microp_st%hmpin (1:ncol,1:pver) = 0._r8 - microp_st%difn (1:ncol,1:pver) = 0._r8 - microp_st%trspcm (1:ncol,1:pver) = 0._r8 - microp_st%trspcn (1:ncol,1:pver) = 0._r8 - microp_st%trspim (1:ncol,1:pver) = 0._r8 - microp_st%trspin (1:ncol,1:pver) = 0._r8 - microp_st%accgrm (1:ncol,1:pver) = 0._r8 - microp_st%accglm (1:ncol,1:pver) = 0._r8 - microp_st%accgslm (1:ncol,1:pver) = 0._r8 - microp_st%accgsrm (1:ncol,1:pver) = 0._r8 - microp_st%accgirm (1:ncol,1:pver) = 0._r8 - microp_st%accgrim (1:ncol,1:pver) = 0._r8 - microp_st%accgrsm (1:ncol,1:pver) = 0._r8 - microp_st%accgsln (1:ncol,1:pver) = 0._r8 - microp_st%accgsrn (1:ncol,1:pver) = 0._r8 - microp_st%accgirn (1:ncol,1:pver) = 0._r8 - microp_st%accsrim (1:ncol,1:pver) = 0._r8 - microp_st%acciglm (1:ncol,1:pver) = 0._r8 - microp_st%accigrm (1:ncol,1:pver) = 0._r8 - microp_st%accsirm (1:ncol,1:pver) = 0._r8 - microp_st%accigln (1:ncol,1:pver) = 0._r8 - microp_st%accigrn (1:ncol,1:pver) = 0._r8 - microp_st%accsirn (1:ncol,1:pver) = 0._r8 - microp_st%accgln (1:ncol,1:pver) = 0._r8 - microp_st%accgrn (1:ncol,1:pver) = 0._r8 - microp_st%accilm (1:ncol,1:pver) = 0._r8 - microp_st%acciln (1:ncol,1:pver) = 0._r8 - microp_st%fallrm (1:ncol,1:pver) = 0._r8 - microp_st%fallsm (1:ncol,1:pver) = 0._r8 - microp_st%fallgm (1:ncol,1:pver) = 0._r8 - microp_st%fallrn (1:ncol,1:pver) = 0._r8 - microp_st%fallsn (1:ncol,1:pver) = 0._r8 - microp_st%fallgn (1:ncol,1:pver) = 0._r8 - microp_st%fhmrm (1:ncol,1:pver) = 0._r8 + !---------------------------------------------------------------------------- + ! Purpose: initialize zm_microp_st variables + !---------------------------------------------------------------------------- + ! Arguments + type(zm_microp_st), intent(inout) :: microp_st ! state and tendency of convective microphysics + integer, intent(in ) :: ncol ! number of atmospheric columns + !---------------------------------------------------------------------------- + microp_st%wu (1:ncol,1:pver) = 0._r8 + microp_st%qliq (1:ncol,1:pver) = 0._r8 + microp_st%qice (1:ncol,1:pver) = 0._r8 + microp_st%qrain (1:ncol,1:pver) = 0._r8 + microp_st%qsnow (1:ncol,1:pver) = 0._r8 + microp_st%qgraupel (1:ncol,1:pver) = 0._r8 + microp_st%qnl (1:ncol,1:pver) = 0._r8 + microp_st%qni (1:ncol,1:pver) = 0._r8 + microp_st%qnr (1:ncol,1:pver) = 0._r8 + microp_st%qns (1:ncol,1:pver) = 0._r8 + microp_st%qng (1:ncol,1:pver) = 0._r8 + microp_st%autolm (1:ncol,1:pver) = 0._r8 + microp_st%accrlm (1:ncol,1:pver) = 0._r8 + microp_st%bergnm (1:ncol,1:pver) = 0._r8 + microp_st%fhtimm (1:ncol,1:pver) = 0._r8 + microp_st%fhtctm (1:ncol,1:pver) = 0._r8 + microp_st%fhmlm (1:ncol,1:pver) = 0._r8 + microp_st%hmpim (1:ncol,1:pver) = 0._r8 + microp_st%accslm (1:ncol,1:pver) = 0._r8 + microp_st%dlfm (1:ncol,1:pver) = 0._r8 + microp_st%autoln (1:ncol,1:pver) = 0._r8 + microp_st%accrln (1:ncol,1:pver) = 0._r8 + microp_st%bergnn (1:ncol,1:pver) = 0._r8 + microp_st%fhtimn (1:ncol,1:pver) = 0._r8 + microp_st%fhtctn (1:ncol,1:pver) = 0._r8 + microp_st%fhmln (1:ncol,1:pver) = 0._r8 + microp_st%accsln (1:ncol,1:pver) = 0._r8 + microp_st%activn (1:ncol,1:pver) = 0._r8 + microp_st%dlfn (1:ncol,1:pver) = 0._r8 + microp_st%cmel (1:ncol,1:pver) = 0._r8 + microp_st%autoim (1:ncol,1:pver) = 0._r8 + microp_st%accsim (1:ncol,1:pver) = 0._r8 + microp_st%difm (1:ncol,1:pver) = 0._r8 + microp_st%cmei (1:ncol,1:pver) = 0._r8 + microp_st%nuclin (1:ncol,1:pver) = 0._r8 + microp_st%autoin (1:ncol,1:pver) = 0._r8 + microp_st%accsin (1:ncol,1:pver) = 0._r8 + microp_st%hmpin (1:ncol,1:pver) = 0._r8 + microp_st%difn (1:ncol,1:pver) = 0._r8 + microp_st%trspcm (1:ncol,1:pver) = 0._r8 + microp_st%trspcn (1:ncol,1:pver) = 0._r8 + microp_st%trspim (1:ncol,1:pver) = 0._r8 + microp_st%trspin (1:ncol,1:pver) = 0._r8 + microp_st%accgrm (1:ncol,1:pver) = 0._r8 + microp_st%accglm (1:ncol,1:pver) = 0._r8 + microp_st%accgslm (1:ncol,1:pver) = 0._r8 + microp_st%accgsrm (1:ncol,1:pver) = 0._r8 + microp_st%accgirm (1:ncol,1:pver) = 0._r8 + microp_st%accgrim (1:ncol,1:pver) = 0._r8 + microp_st%accgrsm (1:ncol,1:pver) = 0._r8 + microp_st%accgsln (1:ncol,1:pver) = 0._r8 + microp_st%accgsrn (1:ncol,1:pver) = 0._r8 + microp_st%accgirn (1:ncol,1:pver) = 0._r8 + microp_st%accsrim (1:ncol,1:pver) = 0._r8 + microp_st%acciglm (1:ncol,1:pver) = 0._r8 + microp_st%accigrm (1:ncol,1:pver) = 0._r8 + microp_st%accsirm (1:ncol,1:pver) = 0._r8 + microp_st%accigln (1:ncol,1:pver) = 0._r8 + microp_st%accigrn (1:ncol,1:pver) = 0._r8 + microp_st%accsirn (1:ncol,1:pver) = 0._r8 + microp_st%accgln (1:ncol,1:pver) = 0._r8 + microp_st%accgrn (1:ncol,1:pver) = 0._r8 + microp_st%accilm (1:ncol,1:pver) = 0._r8 + microp_st%acciln (1:ncol,1:pver) = 0._r8 + microp_st%fallrm (1:ncol,1:pver) = 0._r8 + microp_st%fallsm (1:ncol,1:pver) = 0._r8 + microp_st%fallgm (1:ncol,1:pver) = 0._r8 + microp_st%fallrn (1:ncol,1:pver) = 0._r8 + microp_st%fallsn (1:ncol,1:pver) = 0._r8 + microp_st%fallgn (1:ncol,1:pver) = 0._r8 + microp_st%fhmrm (1:ncol,1:pver) = 0._r8 end subroutine zm_microp_st_ini !=================================================================================================== subroutine zm_microp_st_gb(microp_st,loc_microp_st,ideep,lengath) - !----------------------------------------------------------------------------- - ! Purpose: Gather microphysic arrays from microp_st to loc_microp_st - !----------------------------------------------------------------------------- - type(zm_microp_st) :: microp_st ! state and tendency of convective microphysics - type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - integer ideep(pcols) ! holds position of gathered points vs longitude index. - integer lengath - integer i,k - - do k = 1,pver - do i = 1,lengath - microp_st%wu (ideep(i),k) = loc_microp_st%wu (i,k) - microp_st%qliq (ideep(i),k) = loc_microp_st%qliq (i,k) - microp_st%qice (ideep(i),k) = loc_microp_st%qice (i,k) - microp_st%qrain (ideep(i),k) = loc_microp_st%qrain (i,k) - microp_st%qsnow (ideep(i),k) = loc_microp_st%qsnow (i,k) - microp_st%qgraupel (ideep(i),k) = loc_microp_st%qgraupel (i,k) - microp_st%qnl (ideep(i),k) = loc_microp_st%qnl (i,k) - microp_st%qni (ideep(i),k) = loc_microp_st%qni (i,k) - microp_st%qnr (ideep(i),k) = loc_microp_st%qnr (i,k) - microp_st%qns (ideep(i),k) = loc_microp_st%qns (i,k) - microp_st%qng (ideep(i),k) = loc_microp_st%qng (i,k) - microp_st%autolm (ideep(i),k) = loc_microp_st%autolm (i,k) - microp_st%accrlm (ideep(i),k) = loc_microp_st%accrlm (i,k) - microp_st%bergnm (ideep(i),k) = loc_microp_st%bergnm (i,k) - microp_st%fhtimm (ideep(i),k) = loc_microp_st%fhtimm (i,k) - microp_st%fhtctm (ideep(i),k) = loc_microp_st%fhtctm (i,k) - microp_st%fhmlm (ideep(i),k) = loc_microp_st%fhmlm (i,k) - microp_st%hmpim (ideep(i),k) = loc_microp_st%hmpim (i,k) - microp_st%accslm (ideep(i),k) = loc_microp_st%accslm (i,k) - microp_st%dlfm (ideep(i),k) = loc_microp_st%dlfm (i,k) - microp_st%autoln (ideep(i),k) = loc_microp_st%autoln (i,k) - microp_st%accrln (ideep(i),k) = loc_microp_st%accrln (i,k) - microp_st%bergnn (ideep(i),k) = loc_microp_st%bergnn (i,k) - microp_st%fhtimn (ideep(i),k) = loc_microp_st%fhtimn (i,k) - microp_st%fhtctn (ideep(i),k) = loc_microp_st%fhtctn (i,k) - microp_st%fhmln (ideep(i),k) = loc_microp_st%fhmln (i,k) - microp_st%accsln (ideep(i),k) = loc_microp_st%accsln (i,k) - microp_st%activn (ideep(i),k) = loc_microp_st%activn (i,k) - microp_st%dlfn (ideep(i),k) = loc_microp_st%dlfn (i,k) - microp_st%cmel (ideep(i),k) = loc_microp_st%cmel (i,k) - microp_st%autoim (ideep(i),k) = loc_microp_st%autoim (i,k) - microp_st%accsim (ideep(i),k) = loc_microp_st%accsim (i,k) - microp_st%difm (ideep(i),k) = loc_microp_st%difm (i,k) - microp_st%cmei (ideep(i),k) = loc_microp_st%cmei (i,k) - microp_st%nuclin (ideep(i),k) = loc_microp_st%nuclin (i,k) - microp_st%autoin (ideep(i),k) = loc_microp_st%autoin (i,k) - microp_st%accsin (ideep(i),k) = loc_microp_st%accsin (i,k) - microp_st%hmpin (ideep(i),k) = loc_microp_st%hmpin (i,k) - microp_st%difn (ideep(i),k) = loc_microp_st%difn (i,k) - microp_st%trspcm (ideep(i),k) = loc_microp_st%trspcm (i,k) - microp_st%trspcn (ideep(i),k) = loc_microp_st%trspcn (i,k) - microp_st%trspim (ideep(i),k) = loc_microp_st%trspim (i,k) - microp_st%trspin (ideep(i),k) = loc_microp_st%trspin (i,k) - microp_st%accgrm (ideep(i),k) = loc_microp_st%accgrm (i,k) - microp_st%accglm (ideep(i),k) = loc_microp_st%accglm (i,k) - microp_st%accgslm (ideep(i),k) = loc_microp_st%accgslm (i,k) - microp_st%accgsrm (ideep(i),k) = loc_microp_st%accgsrm (i,k) - microp_st%accgirm (ideep(i),k) = loc_microp_st%accgirm (i,k) - microp_st%accgrim (ideep(i),k) = loc_microp_st%accgrim (i,k) - microp_st%accgrsm (ideep(i),k) = loc_microp_st%accgrsm (i,k) - microp_st%accgsln (ideep(i),k) = loc_microp_st%accgsln (i,k) - microp_st%accgsrn (ideep(i),k) = loc_microp_st%accgsrn (i,k) - microp_st%accgirn (ideep(i),k) = loc_microp_st%accgirn (i,k) - microp_st%accsrim (ideep(i),k) = loc_microp_st%accsrim (i,k) - microp_st%acciglm (ideep(i),k) = loc_microp_st%acciglm (i,k) - microp_st%accigrm (ideep(i),k) = loc_microp_st%accigrm (i,k) - microp_st%accsirm (ideep(i),k) = loc_microp_st%accsirm (i,k) - microp_st%accigln (ideep(i),k) = loc_microp_st%accigln (i,k) - microp_st%accigrn (ideep(i),k) = loc_microp_st%accigrn (i,k) - microp_st%accsirn (ideep(i),k) = loc_microp_st%accsirn (i,k) - microp_st%accgln (ideep(i),k) = loc_microp_st%accgln (i,k) - microp_st%accgrn (ideep(i),k) = loc_microp_st%accgrn (i,k) - microp_st%accilm (ideep(i),k) = loc_microp_st%accilm (i,k) - microp_st%acciln (ideep(i),k) = loc_microp_st%acciln (i,k) - microp_st%fallrm (ideep(i),k) = loc_microp_st%fallrm (i,k) - microp_st%fallsm (ideep(i),k) = loc_microp_st%fallsm (i,k) - microp_st%fallgm (ideep(i),k) = loc_microp_st%fallgm (i,k) - microp_st%fallrn (ideep(i),k) = loc_microp_st%fallrn (i,k) - microp_st%fallsn (ideep(i),k) = loc_microp_st%fallsn (i,k) - microp_st%fallgn (ideep(i),k) = loc_microp_st%fallgn (i,k) - microp_st%fhmrm (ideep(i),k) = loc_microp_st%fhmrm (i,k) - end do - end do + !---------------------------------------------------------------------------- + ! Purpose: gather microphysic arrays from microp_st to loc_microp_st + !---------------------------------------------------------------------------- + ! Arguments + type(zm_microp_st), intent(inout) :: microp_st ! state and tendency of convective microphysics + type(zm_microp_st), intent(in ) :: loc_microp_st ! state and tendency of convective microphysics + integer, intent(in ) :: ideep(pcols) ! holds position of gathered points vs longitude index. + integer, intent(in ) :: lengath + !---------------------------------------------------------------------------- + integer :: i,k + !---------------------------------------------------------------------------- + do k = 1,pver + do i = 1,lengath + microp_st%wu (ideep(i),k) = loc_microp_st%wu (i,k) + microp_st%qliq (ideep(i),k) = loc_microp_st%qliq (i,k) + microp_st%qice (ideep(i),k) = loc_microp_st%qice (i,k) + microp_st%qrain (ideep(i),k) = loc_microp_st%qrain (i,k) + microp_st%qsnow (ideep(i),k) = loc_microp_st%qsnow (i,k) + microp_st%qgraupel (ideep(i),k) = loc_microp_st%qgraupel (i,k) + microp_st%qnl (ideep(i),k) = loc_microp_st%qnl (i,k) + microp_st%qni (ideep(i),k) = loc_microp_st%qni (i,k) + microp_st%qnr (ideep(i),k) = loc_microp_st%qnr (i,k) + microp_st%qns (ideep(i),k) = loc_microp_st%qns (i,k) + microp_st%qng (ideep(i),k) = loc_microp_st%qng (i,k) + microp_st%autolm (ideep(i),k) = loc_microp_st%autolm (i,k) + microp_st%accrlm (ideep(i),k) = loc_microp_st%accrlm (i,k) + microp_st%bergnm (ideep(i),k) = loc_microp_st%bergnm (i,k) + microp_st%fhtimm (ideep(i),k) = loc_microp_st%fhtimm (i,k) + microp_st%fhtctm (ideep(i),k) = loc_microp_st%fhtctm (i,k) + microp_st%fhmlm (ideep(i),k) = loc_microp_st%fhmlm (i,k) + microp_st%hmpim (ideep(i),k) = loc_microp_st%hmpim (i,k) + microp_st%accslm (ideep(i),k) = loc_microp_st%accslm (i,k) + microp_st%dlfm (ideep(i),k) = loc_microp_st%dlfm (i,k) + microp_st%autoln (ideep(i),k) = loc_microp_st%autoln (i,k) + microp_st%accrln (ideep(i),k) = loc_microp_st%accrln (i,k) + microp_st%bergnn (ideep(i),k) = loc_microp_st%bergnn (i,k) + microp_st%fhtimn (ideep(i),k) = loc_microp_st%fhtimn (i,k) + microp_st%fhtctn (ideep(i),k) = loc_microp_st%fhtctn (i,k) + microp_st%fhmln (ideep(i),k) = loc_microp_st%fhmln (i,k) + microp_st%accsln (ideep(i),k) = loc_microp_st%accsln (i,k) + microp_st%activn (ideep(i),k) = loc_microp_st%activn (i,k) + microp_st%dlfn (ideep(i),k) = loc_microp_st%dlfn (i,k) + microp_st%cmel (ideep(i),k) = loc_microp_st%cmel (i,k) + microp_st%autoim (ideep(i),k) = loc_microp_st%autoim (i,k) + microp_st%accsim (ideep(i),k) = loc_microp_st%accsim (i,k) + microp_st%difm (ideep(i),k) = loc_microp_st%difm (i,k) + microp_st%cmei (ideep(i),k) = loc_microp_st%cmei (i,k) + microp_st%nuclin (ideep(i),k) = loc_microp_st%nuclin (i,k) + microp_st%autoin (ideep(i),k) = loc_microp_st%autoin (i,k) + microp_st%accsin (ideep(i),k) = loc_microp_st%accsin (i,k) + microp_st%hmpin (ideep(i),k) = loc_microp_st%hmpin (i,k) + microp_st%difn (ideep(i),k) = loc_microp_st%difn (i,k) + microp_st%trspcm (ideep(i),k) = loc_microp_st%trspcm (i,k) + microp_st%trspcn (ideep(i),k) = loc_microp_st%trspcn (i,k) + microp_st%trspim (ideep(i),k) = loc_microp_st%trspim (i,k) + microp_st%trspin (ideep(i),k) = loc_microp_st%trspin (i,k) + microp_st%accgrm (ideep(i),k) = loc_microp_st%accgrm (i,k) + microp_st%accglm (ideep(i),k) = loc_microp_st%accglm (i,k) + microp_st%accgslm (ideep(i),k) = loc_microp_st%accgslm (i,k) + microp_st%accgsrm (ideep(i),k) = loc_microp_st%accgsrm (i,k) + microp_st%accgirm (ideep(i),k) = loc_microp_st%accgirm (i,k) + microp_st%accgrim (ideep(i),k) = loc_microp_st%accgrim (i,k) + microp_st%accgrsm (ideep(i),k) = loc_microp_st%accgrsm (i,k) + microp_st%accgsln (ideep(i),k) = loc_microp_st%accgsln (i,k) + microp_st%accgsrn (ideep(i),k) = loc_microp_st%accgsrn (i,k) + microp_st%accgirn (ideep(i),k) = loc_microp_st%accgirn (i,k) + microp_st%accsrim (ideep(i),k) = loc_microp_st%accsrim (i,k) + microp_st%acciglm (ideep(i),k) = loc_microp_st%acciglm (i,k) + microp_st%accigrm (ideep(i),k) = loc_microp_st%accigrm (i,k) + microp_st%accsirm (ideep(i),k) = loc_microp_st%accsirm (i,k) + microp_st%accigln (ideep(i),k) = loc_microp_st%accigln (i,k) + microp_st%accigrn (ideep(i),k) = loc_microp_st%accigrn (i,k) + microp_st%accsirn (ideep(i),k) = loc_microp_st%accsirn (i,k) + microp_st%accgln (ideep(i),k) = loc_microp_st%accgln (i,k) + microp_st%accgrn (ideep(i),k) = loc_microp_st%accgrn (i,k) + microp_st%accilm (ideep(i),k) = loc_microp_st%accilm (i,k) + microp_st%acciln (ideep(i),k) = loc_microp_st%acciln (i,k) + microp_st%fallrm (ideep(i),k) = loc_microp_st%fallrm (i,k) + microp_st%fallsm (ideep(i),k) = loc_microp_st%fallsm (i,k) + microp_st%fallgm (ideep(i),k) = loc_microp_st%fallgm (i,k) + microp_st%fallrn (ideep(i),k) = loc_microp_st%fallrn (i,k) + microp_st%fallsn (ideep(i),k) = loc_microp_st%fallsn (i,k) + microp_st%fallgn (ideep(i),k) = loc_microp_st%fallgn (i,k) + microp_st%fhmrm (ideep(i),k) = loc_microp_st%fhmrm (i,k) + end do + end do end subroutine zm_microp_st_gb !=================================================================================================== diff --git a/components/eam/tools/topo_tool/cube_to_target/Makefile b/components/eam/tools/topo_tool/cube_to_target/Makefile index eb69232030db..d1612c59e2b2 100644 --- a/components/eam/tools/topo_tool/cube_to_target/Makefile +++ b/components/eam/tools/topo_tool/cube_to_target/Makefile @@ -6,7 +6,9 @@ RM = rm .SUFFIXES: .F90 .o # Set the compiler -FC := gfortran +ifeq ($(FC),$(null)) + FC = gfortran +endif # Set NetCDF library and include directories LIB_NETCDF := $(shell nf-config --prefix)/lib diff --git a/components/eamxx/.clang-format b/components/eamxx/.clang-format index 7a754b0597fe..8f0ed4356777 100644 --- a/components/eamxx/.clang-format +++ b/components/eamxx/.clang-format @@ -1,15 +1,13 @@ --- -BasedOnStyle: Google -IndentWidth: 2 -SpaceBeforeParens: Never -UseTab: Never -TabWidth: 2 -ColumnLimit: 80 ---- -Language: Cpp -PointerAlignment: Right -DerivePointerAlignment: false +BasedOnStyle: LLVM +ColumnLimit: 100 AlignConsecutiveAssignments: true -AlignOperands: true -AlignTrailingComments: true -AlignEscapedNewlines: true +AlignConsecutiveBitFields: true +AlignConsecutiveMacros: true +AlignEscapedNewlines: true +AlignTrailingComments: true +--- +# # you can obtain the defaults for the LLVM style by running +# # clang-format --style=llvm --dump-config > [outfile] +# # the option definitions are found here: +# # https://clang.llvm.org/docs/ClangFormatStyleOptions.html diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 2ded53df65ed..33524c755a70 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -68,7 +68,7 @@ else() endif() #################################################################### -# Kokkos/YAKL-related settings # +# Kokkos related settings # #################################################################### if (Kokkos_ENABLE_CUDA) @@ -95,16 +95,12 @@ endif() option (Kokkos_ENABLE_SERIAL "" ON) set (EAMXX_ENABLE_GPU FALSE CACHE BOOL "") -set (CUDA_BUILD FALSE CACHE BOOL "") #needed for yakl if kokkos vars are not visible there? -set (HIP_BUILD FALSE CACHE BOOL "") #needed for yakl if kokkos vars are not visible there? -set (SYCL_BUILD FALSE CACHE BOOL "") #needed for yakl if kokkos vars are not visible there? # Determine if this is a Cuda build. if (Kokkos_ENABLE_CUDA) # Add CUDA as a language for CUDA builds enable_language(CUDA) set (EAMXX_ENABLE_GPU TRUE CACHE BOOL "" FORCE) - set (CUDA_BUILD TRUE CACHE BOOL "" FORCE) #needed for yakl if kokkos vars are not visible there? endif () # Determine if this is a HIP build. @@ -112,14 +108,12 @@ if (Kokkos_ENABLE_HIP) # Add CUDA as a language for CUDA builds enable_language(HIP) set (EAMXX_ENABLE_GPU TRUE CACHE BOOL "" FORCE) - set (HIP_BUILD TRUE CACHE BOOL "" FORCE) #needed for yakl if kokkos vars are not visible there? endif () # Determine if this is a sycl build. if (Kokkos_ENABLE_SYCL) #enable_language(SYCL) set (EAMXX_ENABLE_GPU TRUE CACHE BOOL "" FORCE) - set (SYCL_BUILD TRUE CACHE BOOL "" FORCE) #needed for yakl if kokkos vars are not visible there? endif () if( NOT "${CMAKE_CXX_COMPILER_ID}" MATCHES "[Cc]lang" ) @@ -205,12 +199,7 @@ set(NetCDF_Fortran_PATH ${DEFAULT_NetCDF_Fortran_PATH} CACHE FILEPATH "Path to n set(NetCDF_C_PATH ${DEFAULT_NetCDF_C_PATH} CACHE FILEPATH "Path to netcdf C installation") set(SCREAM_MACHINE ${DEFAULT_SCREAM_MACHINE} CACHE STRING "The CIME/SCREAM name for the current machine") option(SCREAM_MPI_ON_DEVICE "Whether to use device pointers for MPI calls" ON) - -if (Kokkos_ENABLE_SYCL) - option(SCREAM_ENABLE_MAM "Whether to enable MAM aerosol support" OFF) -else() - option(SCREAM_ENABLE_MAM "Whether to enable MAM aerosol support" ON) -endif() +option(SCREAM_ENABLE_MAM "Whether to enable MAM aerosol support" ON) set(SCREAM_SMALL_KERNELS ${DEFAULT_SMALL_KERNELS} CACHE STRING "Use small, non-monolothic kokkos kernels for ALL components that support them") set(SCREAM_P3_SMALL_KERNELS ${SCREAM_SMALL_KERNELS} CACHE STRING "Use small, non-monolothic kokkos kernels for P3 only") @@ -225,17 +214,8 @@ endif() # and then adding to eamxx_config.h: # #cmakedefine RRTMGP_EXPENSIVE_CHECKS option (SCREAM_RRTMGP_DEBUG "Turn on extra debug checks in RRTMGP" ${SCREAM_DEBUG}) - -option(SCREAM_RRTMGP_ENABLE_YAKL "Use YAKL under rrtmgp" FALSE) -option(SCREAM_RRTMGP_ENABLE_KOKKOS "Use Kokkos under rrtmgp" TRUE) -if (SCREAM_RRTMGP_ENABLE_YAKL) - add_definitions("-DRRTMGP_ENABLE_YAKL") -endif() - -if (SCREAM_RRTMGP_ENABLE_KOKKOS) - add_definitions("-DRRTMGP_ENABLE_KOKKOS") -endif() - +# This can be removed once rrtmgp is kokkos-only. +add_definitions("-DRRTMGP_ENABLE_KOKKOS") set(SCREAM_DOUBLE_PRECISION TRUE CACHE BOOL "Set to double precision (default True)") @@ -623,8 +603,6 @@ function (print_var var) endfunction () print_var(EAMXX_ENABLE_GPU) -print_var(CUDA_BUILD) -print_var(HIP_BUILD) print_var(SCREAM_MACHINE) print_var(SCREAM_DYNAMICS_DYCORE) print_var(SCREAM_DOUBLE_PRECISION) diff --git a/components/eamxx/cacts.yaml b/components/eamxx/cacts.yaml new file mode 100644 index 000000000000..16d42ca4574e --- /dev/null +++ b/components/eamxx/cacts.yaml @@ -0,0 +1,322 @@ +# Configuration file for TestProjectBuilds (TPB) +# +# There are three main sections: project, machines build_types +# - project: contains basic info on the project +# - machines: contains a list of machines on which testing is allowed +# - configurations: contains a list of build types that can be built +# +# The machines and configurations sections CAN contain an entry "default", which +# defines some defaults for all machines/build_types. Other entries will OVERWRITE anything +# that is also set in the default entry. It is recommended to keep the default +# entry, since it can be used to list ALL possible settings, for documentation purposes. +# +# Upon parsing the yaml file, CACTS will create one Project, one Machine, and one or +# more BuildType objects. These objects will contain members with *the same* name as the +# configs in the yaml file. Notice the settings names are hard-coded, so you can't add +# a new setting and hope that it gets set in the object. +# +# The objects settings CAN be used in the yaml file to programmatically set other options. +# For instance, a build type can use properties of the project/machine to set a cmake var. +# The syntax is ${.}, where is 'project', 'machine', or 'build', and +# and must be a valid attribute of the corresponding object (see the +# corresponding py files for valid options). If you use the ${..} syntax, +# we recommend that you wrap the entry in quotes, to avoid any surprise with YAML parsers. +# The ${..} syntax is actually more powerful than that, and can perform any python operation, +# with some restriction (e.g., imports or tinkering with global vars is prohibited, +# for security purposes. +# +# In addition to the ${..} syntax, CACTS also supports bash commands evaluation, +# with the syntax $(cmd). This can be used in conjunction with ${}. E.g., one can do +# NetCDF_Fortran_ROOT: $(${machine.env_setup} && nf-config --prefix) +# Python expressions ${..} are always evaluated first, bash expressions $(..) are +# evaluated afterwards. + +########################################################################################## +# PROJECT SETTINGS # +########################################################################################## + +project: + name: EAMxx + baseline_gen_label: baseline_gen + baseline_summary_file: baseline_list + cmake_vars_names: + enable_baselines: + SCREAM_ENABLE_BASELINE_TESTS: ON + generate_baselines: + SCREAM_ONLY_GENERATE_BASELINES: ON + baselines_dir: SCREAM_BASELINES_DIR + cdash: + drop_site: my.cdash.org + drop_location: /submit.php?project=E3SM + build_prefix: scream_unit_tests_ # final build name is build_prefix + build.longname + curl_ssl_off: True # Sets CTEST_CURL_OPTIONS to bypass ssl verification + # NOTE: CACTS will also set project.root_dir at runtime, so you can actually use + # ${project.root_dir} in the machines/configurations sections + +########################################################################################## +# MACHINES # +########################################################################################## + +machines: + # CACTS will also set an entry machine.name, where the value of name matches the yaml map section name + default: + cxx_compiler: mpicxx + c_compiler: mpicc + ftn_compiler: mpifort + mach_file: "${project.root_dir}/cmake/machine-files/${machine.name}.cmake" + gpu_arch: null + batch: null + num_bld_res: null + num_run_res: null + baselines_dir: null + valg_supp_file: null + node_regex: null + + mappy: + env_setup: + - 'module purge' + - 'module load sems-cmake/3.27.9 sems-git/2.42.0 sems-gcc/11.4.0 sems-openmpi-no-cuda/4.1.6 sems-netcdf-c/4.9.2 sems-netcdf-cxx/4.2 sems-netcdf-fortran/4.6.1 sems-parallel-netcdf/1.12.3 sems-openblas' + - 'export GATOR_INITIAL_MB=4000MB' + - 'export NetCDF_Fortran_ROOT=$(nf-config --prefix)' + - 'export NetCDF_C_ROOT=$(nc-config --prefix)' + - 'export PnetCDF_C_ROOT=$(pnetcdf-config --prefix)' + baselines_dir: "/sems-data-store/ACME/baselines/scream/master-baselines" + node_regex: mappy + valg_supp_file: "${project.root_dir}/scripts/jenkins/valgrind/mappy.supp" + + pm-cpu: + cxx_compiler: CC + c_compiler: cc + ftn_compiler: ftn + env_setup: ["eval $(${project.root_dir}/../../cime/CIME/Tools/get_case_env -c SMS.ne4pg2_ne4pg2.F2010-SCREAMv1.pm-cpu_gnu)"] + batch: "salloc --account e3sm_g --constraint=cpu --time 00:30:00 --nodes=1 -q debug" + baselines_dir: "/global/cfs/cdirs/e3sm/baselines/gnu/scream/pm-cpu" + + pm-gpu: + cxx_compiler: CC + c_compiler: cc + ftn_compiler: ftn + env_setup: ["eval $(${project.root_dir}/../../cime/CIME/Tools/get_case_env -c SMS.ne4pg2_ne4pg2.F2010-SCREAMv1.pm-gpu_gnugpu)"] + batch: "salloc --account e3sm_g --constraint=gpu --time 02:00:00 --nodes=4 --gpus-per-node=4 --gpu-bind=none --exclusive -q regular" + baselines_dir: "/global/cfs/cdirs/e3sm/baselines/gnu/scream/pm-gpu" + gpu_arch: cuda + num_run_res: 4 + + chrysalis: + cxx_compiler: "mpic++" + c_compiler : "mpicc" + ftn_compiler: "mpif90" + env_setup: ["eval $(${project.root_dir}/../../cime/CIME/Tools/get_case_env)", "export OMP_NUM_THREADS=1"] + batch: "srun --mpi=pmi2 -l -N 1 --kill-on-bad-exit --cpu_bind=cores" + baselines_dir: "/lcrc/group/e3sm/baselines/chrys/intel/scream" + + weaver: + env_setup: + - "source /etc/profile.d/modules.sh" + - "module purge" + - "module load cmake/3.25.1 git/2.39.1 python/3.10.8 py-netcdf4/1.5.8 gcc/11.3.0 cuda/11.8.0 openmpi netcdf-c netcdf-fortran parallel-netcdf netlib-lapack" + - "export HDF5_USE_FILE_LOCKING=FALSE" + + baselines_dir: "/home/projects/e3sm/scream/pr-autotester/master-baselines/weaver/" + batch: "bsub -I -q rhel8 -n 4 -gpu num=4" + num_run_res: 4 # four gpus + gpu_arch: "cuda" + + compy: + cxx_compiler: "mpiicpc" + c_compiler : "mpiicc" + ftn_compiler: "mpiifort" + env_setup: + - "export PROJECT=e3sm" + - "eval $(${project.root_dir}/../../cime/CIME/Tools/get_case_env -c SMS.ne4pg2_ne4pg2.F2010-SCREAMv1.compy_intel)" + batch: "srun --time 02:00:00 --nodes=1 -p short --exclusive --account e3sm" + + ghci-snl-cpu: + baselines_dir: "/projects/e3sm/baselines/scream/ghci-snl-cpu" + env_setup: ["export GATOR_INITIAL_MB=4000MB"] + + ghci-snl-cuda: + baselines_dir: "/projects/e3sm/baselines/scream/ghci-snl-cuda" + gpu_arch: "cuda" + num_run_res: "$(nvidia-smi --query-gpu=name --format=csv,noheader | wc -l)" + + ghci-oci: + env_setup: ["eval $(${project.root_dir}/../../cime/CIME/Tools/get_case_env -c SMS.ne4pg2_ne4pg2.F2010-SCREAMv1.ghci-oci_gnu)"] + + lassen: + baselines_dir: "/projects/e3sm/baselines/scream/master-baselines" + env_setup: + - "module --force purge" + - "module load git gcc/8.3.1 cuda/11.8.0 cmake/3.16.8 spectrum-mpi python/3.7.2" + - "export LLNL_USE_OMPI_VARS='y'" + - "export PATH=/usr/workspace/e3sm/netcdf/bin:$PATH" + - "export LD_LIBRARY_PATH=/usr/workspace/e3sm/netcdf/lib:$LD_LIBRARY_PATH" + batch: "bsub -Ip -qpdebug" + num_run_res: 4 # four gpus + gpu_arch: "cuda" + + ruby-intel: + env_setup: + - "module --force purge" + - "module use --append /usr/workspace/e3sm/install/quartz/modulefiles" + - "module load StdEnv cmake/3.19.2 mkl/2022.1.0 intel-classic/2021.6.0-magic mvapich2/2.3.7 hdf5/1.12.2 netcdf-c/4.9.0 netcdf-fortran/4.6.0 parallel-netcdf/1.12.3 python/3.9.12 screamML-venv/0.0.1" + batch: "salloc --partition=pdebug" + + dane-intel: + env_setup: + - "module --force purge" + - "module use --append /usr/workspace/e3sm/install/quartz/modulefiles" + - "module load StdEnv cmake/3.19.2 mkl/2022.1.0 intel-classic/2021.6.0-magic mvapich2/2.3.7 hdf5/1.12.2 netcdf-c/4.9.0 netcdf-fortran/4.6.0 parallel-netcdf/1.12.3 python/3.9.12 screamML-venv/0.0.1" + batch: "salloc --partition=pdebug" + + quartz-intel: + env_setup: + - "module --force purge" + - "module use --append /usr/workspace/e3sm/install/quartz/modulefiles" + - "module load StdEnv cmake/3.19.2 mkl/2022.1.0 intel-classic/2021.6.0-magic mvapich2/2.3.7 hdf5/1.12.2 netcdf-c/4.9.0 netcdf-fortran/4.6.0 parallel-netcdf/1.12.3 python/3.9.12 screamML-venv/0.0.1" + batch: "salloc --partition=pdebug" + + quartz-gcc: + env_setup: + - "module --force purge" + - "module load StdEnv cmake/3.16.8 mkl/2019.0 gcc-8.3.1 netcdf-fortran/4.4.4 netcdf/4.4.1.1 pnetcdf/1.9.0 mvapich2/2.3" + batch: "salloc --partition=pdebug" + + syrah: + env_setup: + - "module --force purge" + - "module load StdEnv cmake/3.16.8 mkl/2019.0 intel/19.0.4 netcdf-fortran/4.4.4 netcdf/4.4.1.1 pnetcdf/1.9.0 mvapich2/2.3" + batch: "salloc --partition=pdebug --time=60" + + anlgce: + env_setup: + - ". /nfs/gce/software/spack/opt/spack/linux-ubuntu20.04-x86_64/gcc-9.3.0/lmod-8.3-6fjdtku/lmod/lmod/init/sh" + - "module purge" + - "module load autoconf/2.69-bmnwajj automake/1.16.3-r7w24o4 libtool/2.4.6-uh3mpsu m4/1.4.19-7fztfyz cmake/3.20.5-zyz2eld gcc/11.1.0-qsjmpcg zlib/1.2.11-p7dmb5p" + - "export LD_LIBRARY_PATH=/nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/mpich/4.0/gcc-11.1.0/lib:$LD_LIBRARY_PATH" + - "export PATH=/nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/mpich/4.0/gcc-11.1.0/bin:/nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-serial/gcc-11.1.0/bin:$PATH" + - "export NetCDF_ROOT=/nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-serial/gcc-11.1.0" + - "export PERL5LIB=/nfs/gce/projects/climate/software/perl5/lib/perl5" + + anlgce-ub22: + env_setup: + - ". /nfs/gce/software/custom/linux-ubuntu22.04-x86_64/spack/opt/spack/linux-ubuntu22.04-x86_64/gcc-11.2.0/lmod-8.5.6-hkjjxhp/lmod/lmod/init/sh" + - "module purge" + - "module load gcc/12.1.0" + - "export LD_LIBRARY_PATH=/nfs/gce/projects/climate/software/linux-ubuntu22.04-x86_64/mpich/4.1.2/gcc-12.1.0/lib:$LD_LIBRARY_PATH" + - "export PATH=/nfs/gce/projects/climate/software/linux-ubuntu22.04-x86_64/mpich/4.1.2/gcc-12.1.0/bin:/nfs/gce/projects/climate/software/linux-ubuntu22.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-serial/gcc-12.1.0/bin:$PATH" + - "export NetCDF_ROOT=/nfs/gce/projects/climate/software/linux-ubuntu22.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-serial/gcc-12.1.0" + - "export PERL5LIB=/nfs/gce/projects/climate/software/perl5/lib/perl5" + +########################################################################################## +# PROJECT CONFIGURATIONS # +########################################################################################## + +configurations: + # CACTS will also set an entry build.name, where the value of name matches the yaml map section name + default: + longname: null # If not set, will default to build.name + description: null + uses_baselines: True + on_by_default: True + + dbg: + longname: full_debug + description: "debug build with double precision" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_DEFAULT_BFB: True + Kokkos_ENABLE_DEBUG_BOUNDS_CHECK: True + sp: + longname: full_sp_debug + description: "debug build with single precision" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_DEFAULT_BFB: True + SCREAM_DOUBLE_PRECISION: False + + fpe: + longname: debug_nopack_fpe + description: "debug build packsize=1 and floating point exceptions enabled" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_DEFAULT_BFB: True + SCREAM_PACK_SIZE: 1 + SCREAM_FPE: True + uses_baselines: False + on_by_default: "${machine.gpu_arch is None}" + + opt: + longname: release + description: "release build in double precision" + cmake_args: + CMAKE_BUILD_TYPE: Release + + cov: + longname: coverage + description: "debug build running gcov for coverage monitoring" + coverage: True + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_ENABLE_COVERAGE: True + SCREAM_TEST_SIZE: SHORT + uses_baselines: False + on_by_default: False + + valg: + longname: valgrind + description: "Release build where tests run through valgrind" + cmake_args: + CMAKE_BUILD_TYPE: RelWithDebInfo + EKAT_ENABLE_VALGRIND: True + SCREAM_PACK_SIZE: 1 + SCREAM_TEST_MAX_THREADS: 2 + SCREAM_TEST_SIZE: SHORT + EKAT_VALGRIND_SUPPRESSION_FILE: ${valg_supp_file} + uses_baselines: False + on_by_default: False + + csm: + longname: compute_sanitizer_memcheck + description: "debug with compute sanitizer memcheck" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_ENABLE_COMPUTE_SANITIZER: True + EKAT_COMPUTE_SANITIZER_OPTIONS: "--tool=memcheck" + SCREAM_TEST_SIZE: SHORT + uses_baselines: False + on_by_default: False + + csr: + longname: compute_sanitizer_racecheck + description: "debug with compute sanitizer racecheck" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_ENABLE_COMPUTE_SANITIZER: True + EKAT_COMPUTE_SANITIZER_OPTIONS: "--tool=racecheck --racecheck-detect-level=error" + SCREAM_TEST_SIZE: SHORT + uses_baselines: False + on_by_default: False + + csi: + longname: compute_sanitizer_initcheck + description: "debug with compute sanitizer initcheck" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_ENABLE_COMPUTE_SANITIZER: True + EKAT_COMPUTE_SANITIZER_OPTIONS: "--tool=initcheck" + SCREAM_TEST_SIZE: SHORT + uses_baselines: False + on_by_default: False + + css: + longname: compute_sanitizer_synccheck + description: "debug with compute sanitizer synccheck" + cmake_args: + CMAKE_BUILD_TYPE: Debug + EKAT_ENABLE_COMPUTE_SANITIZER: True + EKAT_COMPUTE_SANITIZER_OPTIONS: "--tool=synccheck" + SCREAM_TEST_SIZE: SHORT + uses_baselines: False + on_by_default: False + diff --git a/components/eamxx/cime_config/config_pes.xml b/components/eamxx/cime_config/config_pes.xml index 46288b58bcb1..070ee2cbafc1 100644 --- a/components/eamxx/cime_config/config_pes.xml +++ b/components/eamxx/cime_config/config_pes.xml @@ -3,37 +3,319 @@ - none + default eamxx, 1 node, no threads - 1 - 1 - 1 - 1 - 1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + + + + pm-gpu: ne4 eamxx F case, 1 nodes, 4x1 + + -1 + -1 + -1 + -1 + -1 + -1 + 1 + 1 + + + 16 + 16 + + + + + + frontier: ne4 eamxx 1 node, 7 threads in LND/ICE + + -1 + -1 + -1 + -1 + -1 + -1 + 1 + 1 + + + 7 + 7 + + + + + + pm-cpu: ne4 eamxx 1 node, 96x1 + + 96 + 96 + 96 + 96 + 96 + 96 + 1 + 1 + + + + + + anvil/compy: ne4 eamxx 1 node CPU + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + + chrysalis: ne4 eamxx 1 node CPU + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + + gcp12: ne4 eamxx F case, 1 nodes, 56x1 + + -1 + -1 + -1 + -1 + -1 + -1 + 1 + 1 + + + + + + + + pm-gpu: ne30 eamxx F case, 2 nodes, 4x1 + + -2 + -2 + -2 + -2 + -2 + -2 1 1 - 1 - 16 - 1 + 16 + 16 + + + + + + frontier: ne30 eamxx 2 nodes, 7 threads in LND/ICE + + -2 + -2 + -2 + -2 + -2 + -2 + 1 + 1 + + + 7 + 7 + + + + + + pm-cpu: ne30 eamxx 2 nodes, 128x1 + + -2 + -2 + -2 + -2 + -2 + -2 + 1 + 1 + + + + + + gcp12: ne30 eamxx F case, 4 nodes, 56x1 CPU + + -4 + -4 + -4 + -4 + -4 + -4 + 1 + 1 + + + + + + + + pm-gpu: ne120 eamxx F case, 8 nodes, 4x1 + + 32 + 32 + 32 + 32 + 32 + 32 + 1 + 1 + + + 16 + 16 + + + + + + + + pm-gpu: ne256 eamxx F case, 32 nodes, 4x1, 16 threads for LND/ICE + + 128 + 128 + 128 + 128 + 128 + 128 + 1 + 1 + + + 16 + 16 + + + + + + + + pm-gpu: ne512 eamxx F case, 128 nodes, 4x1, 16 threads for LND/ICE + + 512 + 512 + 512 + 512 + 512 + 512 + 1 + 1 + + + 16 + 16 + + + + + + + + pm-gpu: ne1024 eamxx F case, 512 nodes, 4x1, 16 threads for LND/ICE + + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + 1 + 1 + + + 16 + 16 + + + + + + + + frontier conus 2 nodes, 8x1 except 7 threads in LND + + -2 + -2 + -2 + -2 + -2 + -2 + -1 + -1 + + + 1 + 7 + 1 + 1 + 1 + 1 + + + + + + pm-gpu conus 2 nodes, 4x1 except 16 threads in LND + + -2 + -2 + -2 + -2 + -2 + -2 + -1 + -1 + + + 1 + 16 1 1 1 - 1 - 1 - 16 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + 1 + diff --git a/components/eamxx/cime_config/eamxx_buildnml.py b/components/eamxx/cime_config/eamxx_buildnml.py index 83b994dfe578..702b60f91fa8 100644 --- a/components/eamxx/cime_config/eamxx_buildnml.py +++ b/components/eamxx/cime_config/eamxx_buildnml.py @@ -15,7 +15,7 @@ # SCREAM imports from eamxx_buildnml_impl import get_valid_selectors, get_child, refine_type, \ - resolve_all_inheritances, gen_atm_proc_group, check_all_values, find_node + resolve_all_inheritances, gen_atm_proc_group, check_all_values from atm_manip import apply_atm_procs_list_changes_from_buffer, apply_non_atm_procs_list_changes_from_buffer from utils import ensure_yaml # pylint: disable=no-name-in-module @@ -29,7 +29,6 @@ # Cime imports from standard_script_setup import * # pylint: disable=wildcard-import from CIME.utils import expect, safe_copy, SharedArea -from CIME.test_status import TestStatus, RUN_PHASE logger = logging.getLogger(__name__) # pylint: disable=undefined-variable @@ -105,121 +104,6 @@ def do_cime_vars(entry, case, refine=False, extra=None): return entry -############################################################################### -def perform_consistency_checks(case, xml): -############################################################################### - """ - There may be separate parts of the xml that must satisfy some consistency - Here, we run any such check, so we can catch errors before submit time - - >>> from eamxx_buildnml_impl import MockCase - >>> xml_str = ''' - ... - ... - ... 3 - ... - ... - ... ''' - >>> import xml.etree.ElementTree as ET - >>> xml = ET.fromstring(xml_str) - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':24, 'REST_OPTION':'nsteps'}) - >>> perform_consistency_checks(case,xml) - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':2, 'REST_OPTION':'nsteps'}) - >>> perform_consistency_checks(case,xml) - Traceback (most recent call last): - CIME.utils.CIMEError: ERROR: rrtmgp::rad_frequency (3 steps) incompatible with restart frequency (2 steps). - Please, ensure restart happens on a step when rad is ON - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':10800, 'REST_OPTION':'nseconds'}) - >>> perform_consistency_checks(case,xml) - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':7200, 'REST_OPTION':'nseconds'}) - >>> perform_consistency_checks(case,xml) - Traceback (most recent call last): - CIME.utils.CIMEError: ERROR: rrtmgp::rad_frequency incompatible with restart frequency. - Please, ensure restart happens on a step when rad is ON - rest_tstep: 7200 - rad_testep: 10800.0 - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':180, 'REST_OPTION':'nminutes'}) - >>> perform_consistency_checks(case,xml) - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':120, 'REST_OPTION':'nminutes'}) - >>> perform_consistency_checks(case,xml) - Traceback (most recent call last): - CIME.utils.CIMEError: ERROR: rrtmgp::rad_frequency incompatible with restart frequency. - Please, ensure restart happens on a step when rad is ON - rest_tstep: 7200 - rad_testep: 10800.0 - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':6, 'REST_OPTION':'nhours'}) - >>> perform_consistency_checks(case,xml) - >>> case = MockCase({'ATM_NCPL':'24', 'REST_N':8, 'REST_OPTION':'nhours'}) - >>> perform_consistency_checks(case,xml) - Traceback (most recent call last): - CIME.utils.CIMEError: ERROR: rrtmgp::rad_frequency incompatible with restart frequency. - Please, ensure restart happens on a step when rad is ON - rest_tstep: 28800 - rad_testep: 10800.0 - >>> case = MockCase({'ATM_NCPL':'12', 'REST_N':2, 'REST_OPTION':'ndays'}) - >>> perform_consistency_checks(case,xml) - >>> case = MockCase({'ATM_NCPL':'10', 'REST_N':2, 'REST_OPTION':'ndays'}) - >>> perform_consistency_checks(case,xml) - Traceback (most recent call last): - CIME.utils.CIMEError: ERROR: rrtmgp::rad_frequency incompatible with restart frequency. - Please, ensure restart happens on a step when rad is ON - For daily (or less frequent) restart, rad_frequency must divide ATM_NCPL - """ - - # RRTMGP can be supercycled. Restarts cannot fall in the middle - # of a rad superstep - rrtmgp = find_node(xml,"rrtmgp") - rest_opt = case.get_value("REST_OPTION") - is_test = case.get_value("TEST") - caseraw = case.get_value("CASE") - caseroot = case.get_value("CASEROOT") - casebaseid = case.get_value("CASEBASEID") - if rrtmgp is not None and rest_opt is not None and rest_opt not in ["never","none"]: - rest_n = int(case.get_value("REST_N")) - rad_freq = int(find_node(rrtmgp,"rad_frequency").text) - atm_ncpl = int(case.get_value("ATM_NCPL")) - atm_tstep = 86400 / atm_ncpl - rad_tstep = atm_tstep * rad_freq - - # Some tests (ERS) make late (run-phase) changes, so we cannot validate restart - # settings until RUN phase - is_test_not_yet_run = False - if is_test: - test_name = casebaseid if casebaseid is not None else caseraw - ts = TestStatus(test_dir=caseroot, test_name=test_name) - phase = ts.get_latest_phase() - if phase != RUN_PHASE: - is_test_not_yet_run = True - - if rad_freq==1 or is_test_not_yet_run: - pass - elif rest_opt in ["nsteps", "nstep"]: - expect (rest_n % rad_freq == 0, - f"rrtmgp::rad_frequency ({rad_freq} steps) incompatible with " - f"restart frequency ({rest_n} steps).\n" - " Please, ensure restart happens on a step when rad is ON") - elif rest_opt in ["nseconds", "nsecond", "nminutes", "nminute", "nhours", "nhour"]: - if rest_opt in ["nseconds", "nsecond"]: - factor = 1 - elif rest_opt in ["nminutes", "nminute"]: - factor = 60 - else: - factor = 3600 - - rest_tstep = factor*rest_n - expect (rest_tstep % rad_tstep == 0, - "rrtmgp::rad_frequency incompatible with restart frequency.\n" - " Please, ensure restart happens on a step when rad is ON\n" - f" rest_tstep: {rest_tstep}\n" - f" rad_testep: {rad_tstep}") - - else: - # for "very infrequent" restarts, we request rad_freq to divide atm_ncpl - expect (atm_ncpl % rad_freq ==0, - "rrtmgp::rad_frequency incompatible with restart frequency.\n" - " Please, ensure restart happens on a step when rad is ON\n" - " For daily (or less frequent) restart, rad_frequency must divide ATM_NCPL") - ############################################################################### def ordered_dump(data, item, Dumper=yaml.SafeDumper, **kwds): ############################################################################### @@ -249,6 +133,66 @@ def _dict_representer(dumper, data): else: return yaml.dump(data, item, OrderedDumper, **kwds) +############################################################################### +def evaluate_selector(sel_name, sel_value, ez_selectors, case, child_name): +############################################################################### + # Parse and and ors into separate statements + and_syntax = " @@ " + or_syntax = " || " + statements = [] + if and_syntax in sel_value: + expect(or_syntax not in sel_value, "Cannot mix @@ and ||") + statements = sel_value.split(and_syntax) + elif or_syntax in sel_value: + statements = sel_value.split(or_syntax) + else: + statements = [sel_value] + + # Get relevant value from case + if sel_name in ez_selectors: + ez_env, ez_regex = ez_selectors[sel_name] + case_val = case.get_value(ez_env) + expect(case_val is not None, + "Bad easy selector '{}' definition. Relies on unknown case value '{}'".format(sel_name, ez_env)) + + ez_regex_re = re.compile(ez_regex) + m = ez_regex_re.match(case_val) + if m: + groups = m.groups() + expect(len(groups) == 1, + "Selector '{}' has invalid custom regex '{}' which does not capture exactly 1 group".format(sel_name, ez_regex)) + val = groups[0] + else: + # If the regex doesn't even match the case val, always fail the selector + return False + + else: + val = case.get_value(sel_name) + expect(val is not None, + "Bad selector '{0}' for child '{1}'. '{0}' is not a valid case value or easy selector".format(sel_name, child_name)) + + # Check value for matches with statements + result = False if or_syntax in sel_value else True + for statement in statements: + is_negation = statement.startswith("!") + if is_negation: + statement = statement.lstrip("!") + + val_re = re.compile(statement) + + found_match = val_re.match(val) is not None # check if regex yielded a match + desired_match = not is_negation # whether we want to match regex or not + curr_result = found_match == desired_match # check if the match was desired or not + + if and_syntax in sel_value: + result &= curr_result + elif or_syntax in sel_value: + result |= curr_result + else: + result = curr_result + + return result + ############################################################################### def evaluate_selectors(element, case, ez_selectors): ############################################################################### @@ -283,6 +227,24 @@ def evaluate_selectors(element, case, ez_selectors): ... foo_on ... bar_off ... bar_on + ... regex_wrong + ... regex_right + ... and_right + ... and_wrong + ... and_wrong + ... and_right + ... or_right + ... or_wrong + ... and_wrong + ... or_right + ... negation_right + ... negation_wrong + ... negation_wrong + ... negation_right + ... negation_right + ... negation_wrong + ... negation_wrong + ... negation_right ... ... ''' >>> import xml.etree.ElementTree as ET @@ -298,6 +260,24 @@ def evaluate_selectors(element, case, ez_selectors): True >>> get_child(good,'var4').text=="bar_off" True + >>> get_child(good,'var5').text=="regex_right" + True + >>> get_child(good,'var6').text=="and_right" + True + >>> get_child(good,'var6a').text=="and_right" + True + >>> get_child(good,'var6b').text=="or_right" + True + >>> get_child(good,'var6c').text=="or_right" + True + >>> get_child(good,'var7').text=="negation_right" + True + >>> get_child(good,'var8').text=="negation_right" + True + >>> get_child(good,'var9').text=="negation_right" + True + >>> get_child(good,'var10').text=="negation_right" + True >>> ############## BAD SELECTOR DEFINITION ##################### >>> xml_sel_bad1 = ''' ... @@ -393,42 +373,18 @@ def evaluate_selectors(element, case, ez_selectors): if selectors: all_match = True had_case_selectors = False - for k, v in selectors.items(): + for sel_name, sel_value in selectors.items(): # Metadata attributes are used only when it's time to generate the input files - if k in METADATA_ATTRIBS: - if k=="type" and child_name in selected_child.keys(): + if sel_name in METADATA_ATTRIBS: + if sel_name=="type" and child_name in selected_child.keys(): if "type" in selected_child[child_name].attrib: - expect (v==selected_child[child_name].attrib["type"], + expect (sel_value==selected_child[child_name].attrib["type"], f"The 'type' attribute of {child_name} is not consistent across different selectors") continue had_case_selectors = True - val_re = re.compile(v) - - if k in ez_selectors: - ez_env, ez_regex = ez_selectors[k] - case_val = case.get_value(ez_env) - expect(case_val is not None, - "Bad easy selector '{}' definition. Relies on unknown case value '{}'".format(k, ez_env)) - - ez_regex_re = re.compile(ez_regex) - m = ez_regex_re.match(case_val) - if m: - groups = m.groups() - expect(len(groups) == 1, - "Selector '{}' has invalid custom regex '{}' which does not capture exactly 1 group".format(k, ez_regex)) - val = groups[0] - else: - # If the regex doesn't even match the case val, then we consider - # string below should ensure the selector will never match. - val = None - - else: - val = case.get_value(k) - expect(val is not None, - "Bad selector '{0}' for child '{1}'. '{0}' is not a valid case value or easy selector".format(k, child_name)) - - if val is None or val_re.match(val) is None: + selectors_matched = evaluate_selector(sel_name, sel_value, ez_selectors, case, child_name) + if not selectors_matched: all_match = False children_to_remove.append(child) break @@ -671,8 +627,6 @@ def _create_raw_xml_file_impl(case, xml, filepath=None): raise e - perform_consistency_checks (case, xml) - return xml ############################################################################### diff --git a/components/eamxx/cime_config/namelist_defaults_eamxx.xml b/components/eamxx/cime_config/namelist_defaults_eamxx.xml index 8edbd1ff0abd..f6b9f0f78f30 100644 --- a/components/eamxx/cime_config/namelist_defaults_eamxx.xml +++ b/components/eamxx/cime_config/namelist_defaults_eamxx.xml @@ -85,7 +85,10 @@ be lost if SCREAM_HACK_XML is not enabled. 3) For a parameter whose elements all have selectors, if none of the selectors are matched, then the parameter will be omitted from the case XML - file ($case/namelist_scream.xml). + file ($case/namelist_scream.xml). If you want a selector to NOT match a string/regex, + you can prepend the string with a "!". The operation ' @@ ' (AND) and ' || ' (OR) are also + supported for more complex checks (' @@ ' is used because & is a reserved character in XML). + Note, the whitespaces around the AND and OR operators are NOT optional. 4) Parameter types will be inferred. You can override the inferred type via the 'type' metadata attribute. Types are: @@ -232,11 +235,11 @@ be lost if SCREAM_HACK_XML is not enabled. 0.304 1.0 true - false false false false + false @@ -256,6 +259,7 @@ be lost if SCREAM_HACK_XML is not enabled. 0.1 0.1 false + false @@ -547,6 +551,7 @@ be lost if SCREAM_HACK_XML is not enabled. true 1.0 + false diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/kokkos_rrtmgp/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/kokkos_rrtmgp/shell_commands deleted file mode 100644 index 817dcf42fef5..000000000000 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/kokkos_rrtmgp/shell_commands +++ /dev/null @@ -1,3 +0,0 @@ -./xmlchange --append SCREAM_CMAKE_OPTIONS='SCREAM_RRTMGP_ENABLE_YAKL Off' -./xmlchange --append SCREAM_CMAKE_OPTIONS='SCREAM_RRTMGP_ENABLE_KOKKOS On' - diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands index f78508b5e411..718ffad31e74 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands @@ -1,22 +1,13 @@ - -#------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations -#------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' # Add spa as RRTMG needs spa -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,spa,rrtmgp" -b +ATMCHANGE physics::atm_procs_list="mac_aero_mic,spa,rrtmgp" -b # Replace spa with mam4_aci to invoke mam4 aci scheme -$CIMEROOT/../components/eamxx/scripts/atmchange mac_aero_mic::atm_procs_list="tms,shoc,cld_fraction,mam4_aci,p3" -b +ATMCHANGE mac_aero_mic::atm_procs_list="tms,shoc,cld_fraction,mam4_aci,p3" -b #Set precribed ccn to false so that P3 uses input from ACI -$CIMEROOT/../components/eamxx/scripts/atmchange p3::do_prescribed_ccn=false -b +ATMCHANGE p3::do_prescribed_ccn=false -b #Set predicted ccn to true so that P3 uses input from ACI -$CIMEROOT/../components/eamxx/scripts/atmchange p3::do_predict_nc=true -b - - - - +ATMCHANGE p3::do_predict_nc=true -b \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands index 81b3d44b2219..6bcef1d53a7f 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands @@ -1,16 +1,11 @@ +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' -#!/bin/sh #------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations +# Add microphysics process #------------------------------------------------------ - -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b +ATMCHANGE physics::atm_procs_list="mac_aero_mic,rrtmgp,mam4_aero_microphys" -b #------------------------------------------------------ -# Add microphysics process +# Set rest of the options to default #------------------------------------------------------ -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,rrtmgp,mam4_aero_microphys" -b - - - +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/all_mam4xx_procs/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/all_mam4xx_procs/shell_commands deleted file mode 100644 index 62f916f07188..000000000000 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/all_mam4xx_procs/shell_commands +++ /dev/null @@ -1,19 +0,0 @@ -#------------------------------------------------------ -# MAM4xx adds additional tracers to the simulation -# Increase the number of tracers for MAM4xx simulations -#------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh - -# Add all MAM4 processes (except ACI) -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mam4_constituent_fluxes,mac_aero_mic,mam4_wetscav,mam4_optics,rrtmgp,mam4_srf_online_emiss,mam4_aero_microphys,mam4_drydep" -b - -# Add mam4_aci in mac_aero_mic -$CIMEROOT/../components/eamxx/scripts/atmchange mac_aero_mic::atm_procs_list="tms,shoc,cld_fraction,mam4_aci,p3" -b - -#Set precribed ccn to false so that P3 uses input from ACI -$CIMEROOT/../components/eamxx/scripts/atmchange p3::do_prescribed_ccn=false -b - -#Set predicted ccn to true so that P3 uses input from ACI -$CIMEROOT/../components/eamxx/scripts/atmchange p3::do_predict_nc=true -b - - diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands index 02b4594dbc9f..18502d0a1eea 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands @@ -1,16 +1,11 @@ +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' -#!/bin/sh #------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations +# Add drydep process #------------------------------------------------------ - -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b +ATMCHANGE physics::atm_procs_list="mac_aero_mic,rrtmgp,mam4_drydep" -b #------------------------------------------------------ -# Add drydep process +# Set rest of the options to default #------------------------------------------------------ -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,rrtmgp,mam4_drydep" -b - - - +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands index b62620e7fe05..3089df2ab728 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands @@ -1,9 +1,9 @@ -#------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations -#------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh - -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,mam4_optics,rrtmgp" -b +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' +# Add mam4_optics to the list of processes +ATMCHANGE physics::atm_procs_list="mac_aero_mic,mam4_optics,rrtmgp" -b +#------------------------------------------------------ +# Set rest of the options to default +#------------------------------------------------------ +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands index 9d0bbd39d976..6ada3a7e933f 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands @@ -1,11 +1,4 @@ -#!/bin/sh -#------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations -#------------------------------------------------------ - -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b #------------------------------------------------------ # Add aerosol microphysics process, force ne4pg2 @@ -16,6 +9,15 @@ alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' ATMCHANGE physics::atm_procs_list="mac_aero_mic,rrtmgp,mam4_aero_microphys" -b +#------------------------------------------------------ +# Set rest of the options to default +#------------------------------------------------------ +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options + +#------------------------------------------------------ +# Files for ne4pg2 emissions +#------------------------------------------------------ + ATMCHANGE mam4_aero_microphys::mam4_so2_elevated_emiss_file_name='${DIN_LOC_ROOT}/atm/scream/mam4xx/emissions/ne4pg2/elevated/cmip6_mam4_so2_elev_1x1_2010_clim_ne4pg2_c20241008.nc' -b ATMCHANGE mam4_aero_microphys::mam4_so4_a1_elevated_emiss_file_name='${DIN_LOC_ROOT}/atm/scream/mam4xx/emissions/ne4pg2/elevated/cmip6_mam4_so4_a1_elev_1x1_2010_clim_ne4pg2_c20241008.nc' -b ATMCHANGE mam4_aero_microphys::mam4_so4_a2_elevated_emiss_file_name='${DIN_LOC_ROOT}/atm/scream/mam4xx/emissions/ne4pg2/elevated/cmip6_mam4_so4_a2_elev_1x1_2010_clim_ne4pg2_c20241008.nc' -b @@ -25,4 +27,4 @@ ATMCHANGE mam4_aero_microphys::mam4_num_a1_elevated_emiss_file_name='${DIN_LOC_R ATMCHANGE mam4_aero_microphys::mam4_num_a2_elevated_emiss_file_name='${DIN_LOC_ROOT}/atm/scream/mam4xx/emissions/ne4pg2/elevated/cmip6_mam4_num_a2_elev_1x1_2010_clim_ne4pg2_c20241008.nc' -b ATMCHANGE mam4_aero_microphys::mam4_num_a4_elevated_emiss_file_name='${DIN_LOC_ROOT}/atm/scream/mam4xx/emissions/ne4pg2/elevated/cmip6_mam4_num_a4_elev_1x1_2010_clim_ne4pg2_c20241008.nc' -b ATMCHANGE mam4_aero_microphys::mam4_soag_elevated_emiss_file_name='${DIN_LOC_ROOT}/atm/scream/mam4xx/emissions/ne4pg2/elevated/cmip6_mam4_soag_elev_1x1_2010_clim_ne4pg2_c20241008.nc' -b -ATMCHANGE mam4_aero_microphys::aero_microphys_remap_file='${DIN_LOC_ROOT}/atm/scream/maps/map_ne4pg2_to_ne30pg2_nco_c20241108.nc' -b +ATMCHANGE mam4_aero_microphys::aero_microphys_remap_file='${DIN_LOC_ROOT}/atm/scream/maps/map_ne4pg2_to_ne30pg2_nco_c20241108.nc' -b \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options new file mode 100755 index 000000000000..a0d168def5f6 --- /dev/null +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options @@ -0,0 +1,17 @@ +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' + +#------------------------------------------------------ +# Set options to default +#------------------------------------------------------ + +# Set mac_aero_mic to default +ATMCHANGE mac_aero_mic::atm_procs_list="tms,shoc,cld_fraction,spa,p3" -b + +#Set precribed ccn to the default value +ATMCHANGE p3::do_prescribed_ccn=true -b + +#Set predicted ccn to the default value (it is TRUE by default) +ATMCHANGE p3::do_predict_nc=true -b + +#Switch to turn on heterogeneous freezing due to prognostic aerosols +ATMCHANGE p3::use_hetfrz_classnuc=false -b \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands index 249d7c2371eb..365f16558001 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands @@ -1,16 +1,11 @@ +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' -#!/bin/sh #------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations +# Add the processes #------------------------------------------------------ - -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b +ATMCHANGE physics::atm_procs_list="mam4_constituent_fluxes,mac_aero_mic,rrtmgp,mam4_srf_online_emiss" -b #------------------------------------------------------ -# Add the processes +# Set rest of the options to default #------------------------------------------------------ -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mam4_constituent_fluxes,mac_aero_mic,rrtmgp,mam4_srf_online_emiss" -b - - - +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh deleted file mode 100755 index c533123847ef..000000000000 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh +++ /dev/null @@ -1,24 +0,0 @@ -#!/bin/sh - -#------------------------------------------------------ -# MAM4xx adds additional tracers to the simulation -# Increase number of tracers for MAM4xx simulations -#------------------------------------------------------ - -# Additional MAM4xx tracers (MAM4xx adds 31 tracers) -ADDITIONAL_MAM4xx_TRACERS=31 - -# Original CMAKE options in env_build.xml -orig_cmake_opt=`./xmlquery --value SCREAM_CMAKE_OPTIONS` - -# Extract the number of tracers -orig_tracer_num=$(echo $orig_cmake_opt | grep -oP 'SCREAM_NUM_TRACERS \K[0-9]+') - -# Update number of tracers -new_tracer_num=$((orig_tracer_num + ADDITIONAL_MAM4xx_TRACERS)) - -# Form the new CMake options string by replacing the original number with the new number -new_cmake_opt=$(echo $orig_cmake_opt | sed "s/SCREAM_NUM_TRACERS $orig_tracer_num/SCREAM_NUM_TRACERS $new_tracer_num/") - -# Update cmake options string -`./xmlchange SCREAM_CMAKE_OPTIONS="$new_cmake_opt"` diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands index d8436d38450a..914add251814 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands @@ -1,12 +1,11 @@ -#!/bin/sh +alias ATMCHANGE='$CIMEROOT/../components/eamxx/scripts/atmchange' + #------------------------------------------------------ -# MAM4xx adds additionaltracers to the simulation -# Increase number of tracers for MAM4xx simulations +# Add wetscav process #------------------------------------------------------ - -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b +ATMCHANGE physics::atm_procs_list="mac_aero_mic,mam4_wetscav,rrtmgp" -b #------------------------------------------------------ -# Add wetscav process +# Set rest of the options to default #------------------------------------------------------ -$CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,mam4_wetscav,rrtmgp" -b +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/set_default_eamxx_options \ No newline at end of file diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyAVG_native.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyAVG_native.yaml deleted file mode 100644 index b4cf6c664aa5..000000000000 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyAVG_native.yaml +++ /dev/null @@ -1,15 +0,0 @@ -%YAML 1.1 ---- -filename_prefix: eamxx_output.decadal.1dailyAVG_native.h -iotype: pnetcdf -averaging_type: average -max_snapshots_per_file: 1 -fields: - physics_pg2: - field_names: - - snow_depth_land -output_control: - frequency: 1 - frequency_units: ndays -restart: - force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyAVG_native.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyAVG_native.yaml new file mode 100644 index 000000000000..d9864dc8cc08 --- /dev/null +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyAVG_native.yaml @@ -0,0 +1,20 @@ +%YAML 1.1 +--- +filename_prefix: eamxx_output.decadal.1hourlyAVG_native.h +iotype: pnetcdf +averaging_type: average +max_snapshots_per_file: 1 # only one snapshot per file +fields: + physics_pg2: + field_names: + - snow_depth_land + - isccp_ctptau + - modis_ctptau + - misr_cthtau + - cosp_sunlit + - isccp_cldtot +output_control: + frequency: 1 + frequency_units: nhours +restart: + force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_arm.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_arm.yaml index 1aacfbf4a3ea..667728af909c 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_arm.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_arm.yaml @@ -3,7 +3,7 @@ filename_prefix: eamxx_output.decadal.1hourlyINST_arm.h iotype: pnetcdf averaging_type: instant -max_snapshots_per_file: 24 # one file per day +max_snapshots_per_file: 1 # only one snapshot per file horiz_remap_file: ${DIN_LOC_ROOT}/atm/scream/maps/map_ne1024pg2_to_DecadalSites_c20240130.nc fields: physics_pg2: diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_native.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_native.yaml index ff79e4f5e98f..e9e53d4ae36e 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_native.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyINST_native.yaml @@ -3,7 +3,7 @@ filename_prefix: eamxx_output.decadal.1hourlyINST_native.h iotype: pnetcdf averaging_type: instant -max_snapshots_per_file: 24 +max_snapshots_per_file: 1 # only one snapshot per file fields: physics_pg2: field_names: diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyMAX_native.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyMAX_native.yaml similarity index 58% rename from components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyMAX_native.yaml rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyMAX_native.yaml index 60415b3f7313..d7aad9bf181d 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyMAX_native.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyMAX_native.yaml @@ -1,9 +1,9 @@ %YAML 1.1 --- -filename_prefix: eamxx_output.decadal.1dailyMAX_native.h +filename_prefix: eamxx_output.decadal.1hourlyMAX_native.h iotype: pnetcdf averaging_type: max -max_snapshots_per_file: 1 +max_snapshots_per_file: 1 # only one snapshot per file fields: physics_pg2: field_names: @@ -11,6 +11,6 @@ fields: - precip_total_surf_mass_flux output_control: frequency: 1 - frequency_units: ndays + frequency_units: nhours restart: force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyMIN_native.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyMIN_native.yaml similarity index 54% rename from components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyMIN_native.yaml rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyMIN_native.yaml index 31f5c37383a3..c597ec40f1b1 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1dailyMIN_native.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.1hourlyMIN_native.yaml @@ -1,15 +1,15 @@ %YAML 1.1 --- -filename_prefix: eamxx_output.decadal.1dailyMIN_native.h +filename_prefix: eamxx_output.decadal.1hourlyMIN_native.h iotype: pnetcdf +max_snapshots_per_file: 1 # only one snapshot per file averaging_type: min -max_snapshots_per_file: 1 fields: physics_pg2: field_names: - T_2m output_control: frequency: 1 - frequency_units: ndays + frequency_units: nhours restart: force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyAVG_coarse.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyAVG_coarse.yaml index 7e058ca0d76f..e2f4905fd32f 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyAVG_coarse.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyAVG_coarse.yaml @@ -3,7 +3,7 @@ filename_prefix: eamxx_output.decadal.3hourlyAVG_coarse.h iotype: pnetcdf averaging_type: average -max_snapshots_per_file: 8 # one file per day +max_snapshots_per_file: 1 # only one snapshot per file horiz_remap_file: ${DIN_LOC_ROOT}/atm/scream/maps/map_ne1024pg2_to_ne30pg2_mono.20230901.nc fields: physics_pg2: diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyINST_coarse.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyINST_coarse.yaml index 279348e2073c..fa9809b60084 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyINST_coarse.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.3hourlyINST_coarse.yaml @@ -3,7 +3,7 @@ filename_prefix: eamxx_output.decadal.3hourlyINST_coarse.h iotype: pnetcdf averaging_type: instant -max_snapshots_per_file: 8 # one file per day +max_snapshots_per_file: 1 # only one snapshot per file horiz_remap_file: ${DIN_LOC_ROOT}/atm/scream/maps/map_ne1024pg2_to_ne30pg2_mono.20230901.nc fields: physics_pg2: diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyAVG_coarse.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyAVG_coarse.yaml similarity index 88% rename from components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyAVG_coarse.yaml rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyAVG_coarse.yaml index 08a6759c8125..0dbbe26554af 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyAVG_coarse.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyAVG_coarse.yaml @@ -1,9 +1,9 @@ %YAML 1.1 --- -filename_prefix: eamxx_output.decadal.6hourlyAVG_coarse.h +filename_prefix: eamxx_output.decadal.4hourlyAVG_coarse.h iotype: pnetcdf averaging_type: average -max_snapshots_per_file: 4 # one file per day +max_snapshots_per_file: 1 # only one snapshot per file horiz_remap_file: ${DIN_LOC_ROOT}/atm/scream/maps/map_ne1024pg2_to_ne30pg2_mono.20230901.nc fields: physics_pg2: @@ -41,7 +41,7 @@ fields: - SW_flux_dn_at_model_top - LW_flux_up_at_model_top output_control: - frequency: 6 + frequency: 4 frequency_units: nhours restart: force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyINST_coarse.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyINST_coarse.yaml similarity index 82% rename from components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyINST_coarse.yaml rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyINST_coarse.yaml index 6c790b6b4ebb..14a018bdb22a 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyINST_coarse.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyINST_coarse.yaml @@ -1,9 +1,9 @@ %YAML 1.1 --- -filename_prefix: eamxx_output.decadal.6hourlyINST_coarse.h +filename_prefix: eamxx_output.decadal.4hourlyINST_coarse.h iotype: pnetcdf averaging_type: instant -max_snapshots_per_file: 4 # one file per day +max_snapshots_per_file: 1 # only one snapshot per file horiz_remap_file: ${DIN_LOC_ROOT}/atm/scream/maps/map_ne1024pg2_to_ne30pg2_mono.20230901.nc fields: physics_pg2: @@ -32,7 +32,7 @@ fields: - ocnfrac - landfrac output_control: - frequency: 6 + frequency: 4 frequency_units: nhours restart: force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyINST_native.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyINST_native.yaml similarity index 78% rename from components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyINST_native.yaml rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyINST_native.yaml index 9d3b105a054e..ce3ce3305e33 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.6hourlyINST_native.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.4hourlyINST_native.yaml @@ -1,9 +1,9 @@ %YAML 1.1 --- -filename_prefix: eamxx_output.decadal.6hourlyINST_native.h +filename_prefix: eamxx_output.decadal.4hourlyINST_native.h iotype: pnetcdf averaging_type: instant -max_snapshots_per_file: 4 # one file per day +max_snapshots_per_file: 1 # only one snapshot per file fields: physics_pg2: field_names: @@ -21,7 +21,7 @@ fields: - omega_at_500hPa - omega_at_850hPa output_control: - frequency: 6 + frequency: 1 frequency_units: nhours restart: force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.dailyAVG_coarse.yaml b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.hourlyAVG_coarse.yaml similarity index 93% rename from components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.dailyAVG_coarse.yaml rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.hourlyAVG_coarse.yaml index 32d4f70d654c..1f285433a4ac 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.dailyAVG_coarse.yaml +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/prod/yaml_outs/eamxx_output.decadal.hourlyAVG_coarse.yaml @@ -1,9 +1,9 @@ %YAML 1.1 --- -filename_prefix: eamxx_output.decadal.dailyAVG_coarse.h +filename_prefix: eamxx_output.decadal.hourlyAVG_coarse.h iotype: pnetcdf averaging_type: average -max_snapshots_per_file: 1 +max_snapshots_per_file: 1 # only one snapshot per file horiz_remap_file: ${DIN_LOC_ROOT}/atm/scream/maps/map_ne1024pg2_to_ne30pg2_mono.20230901.nc fields: physics_pg2: @@ -89,6 +89,6 @@ fields: output_control: frequency: 1 - frequency_units: ndays + frequency_units: nhours restart: force_new_file: true diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/yakl_rrtmgp/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/yakl_rrtmgp/shell_commands deleted file mode 100644 index 61d571c95974..000000000000 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/yakl_rrtmgp/shell_commands +++ /dev/null @@ -1,2 +0,0 @@ -./xmlchange --append SCREAM_CMAKE_OPTIONS='SCREAM_RRTMGP_ENABLE_YAKL On' -./xmlchange --append SCREAM_CMAKE_OPTIONS='SCREAM_RRTMGP_ENABLE_KOKKOS Off' diff --git a/components/eamxx/cmake/machine-files/alvarez.cmake b/components/eamxx/cmake/machine-files/alvarez-cpu.cmake similarity index 83% rename from components/eamxx/cmake/machine-files/alvarez.cmake rename to components/eamxx/cmake/machine-files/alvarez-cpu.cmake index 037da48eaf03..c4e8fa5e9094 100644 --- a/components/eamxx/cmake/machine-files/alvarez.cmake +++ b/components/eamxx/cmake/machine-files/alvarez-cpu.cmake @@ -8,7 +8,7 @@ include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) set(CMAKE_CXX_FLAGS "-DTHRUST_IGNORE_CUB_VERSION_CHECK" CACHE STRING "" FORCE) -#message(STATUS "alvarez CMAKE_CXX_COMPILER_ID=${CMAKE_CXX_COMPILER_ID} CMAKE_Fortran_COMPILER_VERSION=${CMAKE_Fortran_COMPILER_VERSION}") +#message(STATUS "alvarez-cpu CMAKE_CXX_COMPILER_ID=${CMAKE_CXX_COMPILER_ID} CMAKE_Fortran_COMPILER_VERSION=${CMAKE_Fortran_COMPILER_VERSION}") if ("${PROJECT_NAME}" STREQUAL "E3SM") if ("${CMAKE_CXX_COMPILER_ID}" STREQUAL "GNU") if (CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) diff --git a/components/eamxx/cmake/machine-files/alvarez-gpu.cmake b/components/eamxx/cmake/machine-files/alvarez-gpu.cmake new file mode 100644 index 000000000000..71a57ace6f5b --- /dev/null +++ b/components/eamxx/cmake/machine-files/alvarez-gpu.cmake @@ -0,0 +1,33 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +message(STATUS "alvarez-gpu PROJECT_NAME=${PROJECT_NAME} USE_CUDA=${USE_CUDA} KOKKOS_ENABLE_CUDA=${KOKKOS_ENABLE_CUDA}") +if ("${PROJECT_NAME}" STREQUAL "E3SM") + if (USE_CUDA) + include (${EKAT_MACH_FILES_PATH}/kokkos/nvidia-a100.cmake) + include (${EKAT_MACH_FILES_PATH}/kokkos/cuda.cmake) + else() + include (${EKAT_MACH_FILES_PATH}/kokkos/amd-zen3.cmake) + include (${EKAT_MACH_FILES_PATH}/kokkos/openmp.cmake) + #include (${EKAT_MACH_FILES_PATH}/kokkos/serial.cmake) + endif() +else() + include (${EKAT_MACH_FILES_PATH}/kokkos/nvidia-a100.cmake) + include (${EKAT_MACH_FILES_PATH}/kokkos/cuda.cmake) +endif() + +include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) + +#option(Kokkos_ARCH_AMPERE80 "" ON) +set(CMAKE_CXX_FLAGS "-DTHRUST_IGNORE_CUB_VERSION_CHECK" CACHE STRING "" FORCE) + +message(STATUS "alvarez-gpu CMAKE_CXX_COMPILER_ID=${CMAKE_CXX_COMPILER_ID} CMAKE_Fortran_COMPILER_VERSION=${CMAKE_Fortran_COMPILER_VERSION}") +if ("${PROJECT_NAME}" STREQUAL "E3SM") + if ("${CMAKE_CXX_COMPILER_ID}" STREQUAL "GNU") + if (CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "-fallow-argument-mismatch" CACHE STRING "" FORCE) # only works with gnu v10 and above + endif() + endif() +else() + set(CMAKE_Fortran_FLAGS "-fallow-argument-mismatch" CACHE STRING "" FORCE) # only works with gnu v10 and above +endif() diff --git a/components/eamxx/cmake/machine-files/aurora.cmake b/components/eamxx/cmake/machine-files/aurora.cmake index d2aaf9cd852f..d1c2f40c9b64 100644 --- a/components/eamxx/cmake/machine-files/aurora.cmake +++ b/components/eamxx/cmake/machine-files/aurora.cmake @@ -9,7 +9,7 @@ set(EKAT_MPI_EXTRA_ARGS "--label --cpu-bind depth -envall" CACHE STRING "") set(EKAT_MPI_THREAD_FLAG "-d" CACHE STRING "") SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") -SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") +SET(SYCL_LINK_FLAGS "-fsycl -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") -set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) -set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) +set(CMAKE_CXX_FLAGS " --intel -mlong-double-64 ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore --intel -lsycl -mlong-double-64 ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) diff --git a/components/eamxx/cmake/machine-files/ghost.cmake b/components/eamxx/cmake/machine-files/ghost.cmake new file mode 100644 index 000000000000..8b587c1feed8 --- /dev/null +++ b/components/eamxx/cmake/machine-files/ghost.cmake @@ -0,0 +1,15 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +set(EKAT_MACH_FILES_PATH ${CMAKE_CURRENT_LIST_DIR}/../../../../externals/ekat/cmake/machine-files) + +# Get AMD arch settings +include(${EKAT_MACH_FILES_PATH}/kokkos/intel-skx.cmake) + +# Add OpenMP settings in standalone mode OR e3sm with compile_threaded=ON +if (NOT "${PROJECT_NAME}" STREQUAL "E3SM" OR compile_threaded) + include(${EKAT_MACH_FILES_PATH}/kokkos/openmp.cmake) +endif() + +# Use srun for standalone testing +include(${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) diff --git a/components/eamxx/cmake/machine-files/lychee.cmake b/components/eamxx/cmake/machine-files/lychee.cmake new file mode 100644 index 000000000000..cb7d8c19939f --- /dev/null +++ b/components/eamxx/cmake/machine-files/lychee.cmake @@ -0,0 +1,13 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +set(SCREAM_INPUT_ROOT "/home/projects/e3sm/eamxx/data" CACHE STRING "") + +set(CMAKE_Fortran_FLAGS "-fallow-argument-mismatch" CACHE STRING "" FORCE) + +# Things take forever to build without this +set(SCREAM_SMALL_KERNELS On CACHE BOOL "" FORCE) + +# Load H100/HOPPER arch and cuda backend for kokkos +include (${EKAT_MACH_FILES_PATH}/kokkos/nvidia-h100.cmake) +include (${EKAT_MACH_FILES_PATH}/kokkos/cuda.cmake) diff --git a/components/eamxx/docs/developer/style/format.md b/components/eamxx/docs/developer/style/format.md new file mode 100644 index 000000000000..afa722b3df21 --- /dev/null +++ b/components/eamxx/docs/developer/style/format.md @@ -0,0 +1,55 @@ +# EAMxx Code Formatting Standards + +To enforce consistent code format throughout EAMxx, we make use of an +autoformatting workflow, carried out via Github Actions in the E3SM repository. + +- The tool we employ is + [`clang-format`](https://clang.llvm.org/docs/ClangFormat.html), + and the version we have chosen is v14.[^v14] + +- The standard we maintain is largely identical to the + [LLVM Coding Standards](https://llvm.org/docs/CodingStandards.html), + and a list of the handful of customizations of this convention are + enumerated in the configuration file [`$EAMXX_ROOT/.clang-format`](https://github.com/E3SM-Project/E3SM/blob/master/components/eamxx/.clang-format). + - See this [How-to Guide](resources/clang-format_HOWTO.md) + for additional details on how to configure `clang-format` on your chosen + development machine. + +## Automated Workflow Summary + +- The `eamxx-format` workflow runs automatically and passes or fails based on + adherence to our formatting standard. +- The workflow is triggered by any Pull Request (PR) that modifies EAMxx code. + - It is also triggered by other PR-related triggers, such as pushing + changes, or converting from **draft** to **ready**. +- All code modified by a PR must be formatted prior to **merging**. +- It is not necessary for your code to be formatted upon ***opening*** a + Pull Request, but feel free to `clang-format` as you develop if that is + your preference. + - The one situation for which opening a pre-formatted PR may not be + preferred is if the file has never previously been `clang-format`-ed + and requires a large number of changes. + - I.e., touching the majority of lines in a file for format-only + changes will make it difficult for a reviewer to determine which + lines were changed for substantive reasons. + - In this case, please refrain from formatting the code prior to + opening the PR, and, instead, run `clang-format` once the PR is + approved to be merged and make that the final commit. +- As of now, the `eamxx-format` workflow only considers files that are edited + by the Pull Request. +- In addition to the pass/fail status, the workflow, provides the path to any + files that caused the failure. + - This information is found on the ***Summary*** page for any failed + `eamxx-format` ***Job***.[^huh-where] + +[^v14]: It turns out that this is important because there really are +differences in behavior across versions. +[^huh-where]: To get to this summary, select the ***Checks*** tab at the top of +the PR page and select the `eamxx-format` workflow from the left sidebar. +The summary is in the main pane of the page with the title +**clang-format-linter summary**.[^also] +[^also]: Note that this can also be accessed the long way around by following the +***Actions*** link at the top of the E3SM repository page; +select `eamxx-format` from the ***All workflows*** section of the ***Actions*** +sidebar; then choose the most recent run that is associated with your PR, +which should be near the top of the list. diff --git a/components/eamxx/docs/developer/style/functions.md b/components/eamxx/docs/developer/style/functions.md new file mode 100644 index 000000000000..b536dfe669ab --- /dev/null +++ b/components/eamxx/docs/developer/style/functions.md @@ -0,0 +1,66 @@ +# Functions and Methods + +## Naming + +- Please name functions (methods) to be ***descriptive*** and ***verb**-ish* so + that the name describes what the function *does*. + - For example, `install_flux_capacitor()` instead of `f_capacitor_method()` + or `ifc()`. + - To note, if your function cannot be named verb-ishly, that is probably a + sign that there is a fundamental issue with your function. +- In general, functions should use `snake_case` and not contain capitalization, + unless capitalizing that quantity is a standard convention (e.g., + `find_Doc_Brown()`). + +## Usage + +- In situations where multiple class-member variables are passed as function + arguments, favor passing the object, rather than the individual variables, + for the sake of shorter lines and function signatures. +- As a rule of thumb, developers should prefer passing arguments by reference, + rather than by value, especially in cases for which the argument is ***large*** + or structurally ***complex***. + - E.g., prefer `func(Type &x) { ... }` versus `func(Type x) { ... }`. + - This holds true much of the time because passing by value creates a copy + of the argument for use by the function, and this increases memory + pressure and a resultant performance penalty. +- To be more in-depth on the topic, we echo the guidance from the + [***C++ Core Guidelines***](https://isocpp.github.io/CppCoreGuidelines/CppCoreGuidelines#S-introduction) + and would encourage the curious to read more deeply on the topic. + + > - For "in" parameters, pass cheaply-copied types by value and others by + > reference to `const`. + > - For "in-out" parameters, pass by reference to non-`const`. + > - For "out" parameters, prefer return values to output parameters. + + - The authors go on to explain that "cheap to copy" includes variables + holding 2 or 3 words--for example a double, pointer, or reference. + - To illustrate, the below function adheres to the provided guidance. + + ```c++ + SmallStruct func(LargeNComplex ¬Small, double forty_two, + const int *laser, const BigStruct &lotsaData) { + + // SmallStruct object is only assigned-to and then returned, so it is + // defined as the return type + SmallStruct ans; + // forty_two, a scalar double, is considered small and so passed by value + ans.val = forty_two; + // lotsaData, a BigStruct object, is only accessed and so is + // passed by const reference + ans.other_val = lotsaData.small_piece; + + // we pass laser by value and as const because pointers are cheap to copy, + // and the value is not changed + for (int i = 0; i < forty_two; ++i) { + ans.val_vector.push_back(laser[i] + notSmall.epsilon[i]); + } + + // notSmall is large and also modified in the function, so we pass by + // reference + // it is also accessed, above, so it must be an argument and not the + // return value + notSmall.ans_struct = ans; + return ans; + } + ``` diff --git a/components/eamxx/docs/developer/style/resources/clang-format_HOWTO.md b/components/eamxx/docs/developer/style/resources/clang-format_HOWTO.md new file mode 100644 index 000000000000..dfd2a142fa51 --- /dev/null +++ b/components/eamxx/docs/developer/style/resources/clang-format_HOWTO.md @@ -0,0 +1,208 @@ +# How-to Guide: `clang-format` + +This guide is for developers who wish to apply `clang-format` on their chosen +development machine, whether that be their personal machine or a multi-user +cluster. +In this guide, we will describe how to configure/run `clang-format` on EAMxx +code and also how to install it if necessary. + +## Configure and Run `clang-format` + +Running `clang-format` according to the defined EAMxx standard ***can*** be +done using only command line arguments; however, the command is quite long. +The easier route is to reference the configuration file +(`$EAMXX_ROOT/.clang-format`). +In this case the command is + +```bash {.copy} +clang-format [-i] --style="file:${EAMXX_ROOT}/.clang-format" +``` + +where the `-i` (`--in-place`) argument controls whether the formatting edits +are conducted and change the source file(s) ("in place") or the required edits +are printed to `stdout` (flag omitted). +Also, note that the `--style` flag can also fully define the options without +the configuration file as follows, but this is not recommended as the +configuration could change before this guide is updated to reflect as such. + + +??? Danger "Terminal One-(long-)liner" + + ```bash {.copy} + clang-format [-i] --style="{BasedOnStyle: llvm, ColumnLimit: 100, AlignConsecutiveAssignments: true, AlignConsecutiveBitFields: true, AlignConsecutiveMacros: true, AlignEscapedNewlines: true, AlignTrailingComments: true}" + ``` + + +## Installing `clang-format` + +On a personal machine, which we will consider to be one for which you have +`sudo` privileges, installation can be conducted via package manager or by +building `llvm v14` from scratch. +If you are a non-admin user of a multi-user cluster, HPC platform, etc., then +it is likely to be an ***easy*** process, though potentially not immediate. + + +??? Note "If you require or already have multiple versions of `clang-format` installed" + + Note that, depending on your requirements, this could be placed in your shell + config file (`.bashrc`, `.zshrc`), or if only needed for a shell session, it + can be done directly from the command line. + + The other option is to add a versioned symbolic link to your `PATH`. + This is sometimes included in the package's `bin/` directory by default and, + if not, can be added there after of placed somewhere that is already on your + `PATH`. + + ```c++ + $ cd /opt/homebrew/opt/llvm@14/bin + $ ls clang-format* + clang-format + // no versioned binary so we create symlink + $ ln -s ./clang-format ./clang-format-14 + $ which clang-format + /opt/homebrew/opt/llvm@14/bin/clang-format-14 + ``` + + **OR** + + ```c++ + $ cd /opt/homebrew/opt/llvm@14/bin + $ ls clang-format* + clang-format + // no versioned binary so we create symlink in a directory already on PATH + $ echo $PATH + /usr/bin:/usr/local/bin + $ ln -s ./clang-format /usr/local/bin/clang-format-14 + $ which clang-format + /usr/local/bin/clang-format-14 + ``` + + +=== "Personal Machine" + + + === "Mac Users (Homebrew Package Manager)" + + For Mac users, the [Homebrew](https://brew.sh) + package manager (`brew`) is the quickest and most straightforward way + to get `clang-format` installed. + Since `clang-format` v14 is not available to install directly from + Homebrew, we install the entire LLVM package at version 14, and this + is as simple as + + ```bash {.copy} + brew install llvm@14 + ``` + + It it likely that Homebrew will issue a message about not linking the + `clang`-related tools by default, so next we add the binary to our `PATH`. + + ```bash {.copy} + $ export PATH="/opt/homebrew/opt/llvm@14/bin/clang-format:$PATH" + # Note: this is the default location for a recent Mac running Apple silicon. + # It may be different on another system. + # You can confirm where yours is installed via 'brew info llvm@14' + $ which clang-format + /opt/homebrew/opt/llvm@14/bin/clang-format + ``` + + Note also, that if your system has multiple version of `clang-format` installed, + it may be preferable to instead set a versioned alias to `clang-format` + (`clang-format-14`) as in + + ```c++ + // create a shell-alias + alias clang-format-14="/opt/homebrew/opt/llvm@14/bin/clang-format" + ``` + + === "Linux Users (Package Manager)" + + Given the many flavors of Linux, it is difficult to generalize, but there + is a high probability the proper version of `clang-format` or `llvm` is + provided by the built-in package manager. + The commands will differ based on your Linux distribution, but using the + Debian/Ubuntu `apt` syntax, it could be accomplished via something like + + ```bash {.copy} + $ apt search clang-format + [...] + clang-format-14/... + $ apt install clang-format-14 + ``` + + === "Build from Source" + + If you do not succeed in the above, `clang-format` can also be fully built + from the [LLVM Compiler Infrastructure](https://github.com/llvm/llvm-project). + It will begin with something like + + ```bash {.copy} + git clone git@github.com:llvm/llvm-project.git + git checkout llvmorg-14.0.6 # version tag + ``` + + Also, if you only need `clang-format` and not any of the other tooling, + it will build faster/smaller if you use the CMake flag + `-DLLVM_ENABLE_PROJECTS="clang"` to only build `clang` and it's friends, + rather than all of `llvm`. + And finally, the README for [LLVM version 14.0.6](https://github.com/llvm/llvm-project/tree/llvmorg-14.0.6) + is far more comprehensive that the one for the latest version, and it contains + instructions specific to that build. + +=== "Multi-user System" + + In many cases `llvm`, `clang`, or `clang-format` will be available as a module, + though whether version 14 is an option could be less likely. + In the optimistic case, it could be as simple as (using Lmod syntax) + + ```bash {.copy} + $ module avail llvm # [clang, clang-format] + [... list ] + $ module load llvm/14.0.6 + ``` + + If it is not available, you will probably need to reach out to a system + administrator to get an official version installed.[^but-conda] + + +--- + + +??? Tip "Unnecessary but Convenient Workflow Customization (`direnv`)" + + If you'd like to add a layer of automation/complexity to ensure you only use + `clang-format v14` on `EAMxx` and/or want to use a newer version on the rest + of your system, there is a very handy terminal tool called + [direnv](https://direnv.net/) + (`brew install direnv`) that allows you to automatically load and unload + environment variables based on `$PWD` using a `.envrc` file. + As an example, here's my `.envrc` that adds `clang-format v14` to the path + when I'm working on `EAMxx`. + + ```bash {.copy} + PATH_add /opt/homebrew/opt/llvm@14/bin/clang-format + + # also, since I often forget to load a python environment that's required for + # running ctest, this creates or loads a python 3 virtual environment with numpy + layout python3 + pip install --upgrade pip + # the upgrade isn't strictly necessary but trades a little extra setup on + # the front end to avoid pip endlessly reminding you to update + pip install numpy + ``` + + This file can be placed in the top-level `EAMxx` directory, and running + `direnv allow` enables the functionality. + Namely, executing `cd EAMxx` loads the defined environment that stays loaded + in any subdirectories, and resets the standard environment when exiting to a + directory above/outside of `EAMxx`. + + For the `conda` fans, this tool can also be used to auto-load a + pre-configured `conda` environment since the `.envrc` is essentially a bash + script with a few bells and whistles tacked on. + + + +[^but-conda]: There are rumors of using `conda` creatively to do a user-install, +but that is not an option we support or suggest. + diff --git a/components/eamxx/docs/developer/style/style.md b/components/eamxx/docs/developer/style/style.md new file mode 100644 index 000000000000..72345b5af902 --- /dev/null +++ b/components/eamxx/docs/developer/style/style.md @@ -0,0 +1,56 @@ +# EAMxx Code Style Standards + +EAMxx does not currently impose strict styling standards, other than those of +the autoformatter. +However, if we can follow consistent style and usage guidelines, we can make +EAMxx developers' lives easier and turnaround times quicker. +In the age of modern text editors with autocomplete and running our code on +machines with enormous storage capacity, there is no real need to save screen +or disk space with minimal naming strategies or other meaning-obscuring style +choices. +So, please adhere to the spirit of these guidelines, and your fellow developers +will thank you for it! + +## General Guidelines + +- Please give ***descriptive***, rather than ***terse***, names to your + variables, functions, classes, etc. +- Avoid idiosyncratic naming or styling conventions. + - If the utility of a style decision would not be immediately apparent to + a reasonable developer, please avoid its usage. +- In the hierarchy of coding concerns, correctness and speed take the top + tiers, but below that level, please favor readability and clarity over + space savings, line-breaking, heavy use of arcane language features, etc. + - That said, if an arcane language feature ***is*** the correct tool to + be used, please do so. + - And perhaps add a comment to aid the non-Jedi-Master developers who + read the code next. :slightly_smiling_face: +- With regard to comments, the general wisdom is that the correct amount of + comments is the amount required to make the code clear and easy to understand. + - To quote + [Jeff Atwood](https://blog.codinghorror.com/code-tells-you-how-comments-tell-you-why/) + from his essay about code comments: + > Only at the point where the code *cannot* be made easier to understand + should you begin to add comments. + - However, since that does not offer much in the way of prescriptive + guidance, here are some guidelines gathered from around the internet. + - A general rule of thumb, though not always true, is that comments + should explain ***why*** something is being done in the code, + rather than ***what*** the code is doing.[^butwhattabout] + - Comments should dispel confusion and not cause it. + - Comments should not duplicate the code.[^dupe] + - Provide links or references when using code from elsewhere or + whenever it is otherwise appropriate. + - A bad comment is worse than no comment. + - Add comments to explain non-standard usage or unidiomatic code. + +[^butwhattabout]: An obvious exception to this is explaining complex or opaque +parts of the code that cannot be made simpler--for instance, a clever arithmetic +trick in a complicated interpolation scheme. +[^dupe]: For example, this type of comment does not add any information and +is unnecessary. + + ```c++ + // perform initialization + this->initialize(); + ``` diff --git a/components/eamxx/docs/developer/style/style_guide_overview.md b/components/eamxx/docs/developer/style/style_guide_overview.md new file mode 100644 index 000000000000..93691250a0d6 --- /dev/null +++ b/components/eamxx/docs/developer/style/style_guide_overview.md @@ -0,0 +1,25 @@ +# EAMxx C++ Style Guide + +EAMxx enforces some standards on ***style*** and ***format***. +For the purpose of this guide, we draw a distinction between these two related +topics and loosely define them as: + +- **Style** + - Style is concerned with how the code ***reads*** on a lexical level as + well as with the structural and technical decisions that determine how + the code ***runs***. + - For example: + - Descriptive, as opposed to terse, variable names. + - Employing small, single-purpose functions. + - Usage or non-usage of advanced C++ features. + - The usage and content of comments. +- **Format** + - Format is the domain of how the code ***looks*** or how the code is + organized. + - The good news for formatting is that we enforce a strict, LLVM-based + formatting standard, and we employ + [`clang-format`](https://clang.llvm.org/docs/ClangFormat.html) + to automatically conduct and enforce this standard. + +More detail regarding each of these topics is contained in the following +sections. diff --git a/components/eamxx/docs/developer/style/templates.md b/components/eamxx/docs/developer/style/templates.md new file mode 100644 index 000000000000..402991b27ead --- /dev/null +++ b/components/eamxx/docs/developer/style/templates.md @@ -0,0 +1,31 @@ +# Templating + +- Templating and polymorphism are arguably the most powerful features of C++, + but with great power comes great potential pain. + - EAMxx makes extensive use of templates, throughout, and this is encouraged + but should be done judiciously. + - Adding complexity should only be done in service of improved + functionality or speed because these typically come at the price of + clarity and readability. +- Template parameters should mostly obey the same naming conventions of the + type they correspond to. + - `lower_snake_case` for variables. + - E.g., variables of integral types or objects. + - `UpperCamelCase` for types, classes, or structs. + - However, terseness that follows EAMxx or Kokkos conventions can improve + readability, though favoring ***descriptiveness*** should be the default + case. + - Take this `update()` function declaration as an example. + + ```c++ + template + void update(const Field &x, const ST alpha, const ST beta); + ``` + + - The first template parameter is an integer-pointer that self-describes. + - The second template parameter, `HD` (`enum` type), is + tersely-named but the type provides sufficient descriptive + information. + - The second and third template parameters, including `ST` + ("scalar type"), are standard conventions used throughout EAMxx, and + the abbreviation saves an enormous amount of space in aggregate. diff --git a/components/eamxx/docs/developer/style/types.md b/components/eamxx/docs/developer/style/types.md new file mode 100644 index 000000000000..61bc0575651a --- /dev/null +++ b/components/eamxx/docs/developer/style/types.md @@ -0,0 +1,95 @@ +# Types, Classes, Structures + +## Naming + +- Please name types (classes, structures/`struct`, enumerations/`enum`) as + ***descriptive nouns***, + that describe what the type *is* or what its *purpose* is. + - As an example, `AtmosphericManipulator` and not `Manipulator` or `AtMnp`. + - If you find yourself unable to name your type this way, that may + indicate that it should be broken into independent classes, variables, + or functions. + - See FIXME: below for an example. +- Types, classes, or structs should make use of `UpperCamelCase`. + - Variables containing an object or an instance of a type, class, or struct, + should follow the + [naming convention for variables](variables.md#naming) + and be `lower_snake_case`. + +## Usage + +- There should be a logical grouping among the variables and classes contained + in a type, such that the name captures that association. + - To demonstrate, consider the following `Fruit` class. + + ```c++ + class Fruit { + enum FruitName {Apple, Banana, Orange}; + + FruitName m_fruit_name; + + void is_juiceable(FruitName fruit_) { ... }; + + enum Color {Red, Green, Blue}; + + Color fruit_color; + + bool is_favorite_color(Color color_) { ... }; + }; + ``` + + - It would be better to break this into a separate `Fruit` and `Color` + class because: + 1. `Color` is not inherently associated with fruits--it could also + belong to, for instance, a `Vegetable` class. + 2. There is no strong reason the `is_favorite_color()` needs to be a + part of `Fruit`, since it would work the same way if it knew nothing + about fruits. +- Related to the previous guideline, types/classes/structs should ideally + encapsulate ***concepts*** to improve both readability and usability. + - This implies that even a small struct has a reason to exist when it + serves the goal of shrinking or simplifying the outer class. + - An example of this in EAMxx is the + [`TimeInterval`](https://github.com/E3SM-Project/E3SM/blob/75b5b0a0c9078e18736860b2445a8975d7de750d/components/eamxx/src/share/util/eamxx_time_stamp.hpp#L114) + struct that only contains 4 class variables and 3 relatively simple + methods; yet, it serves to keep the + [`DataInterpolation`](https://github.com/E3SM-Project/E3SM/blob/75b5b0a0c9078e18736860b2445a8975d7de750d/components/eamxx/src/share/util/eamxx_data_interpolation.hpp#L14) + class smaller and better-organized. + +### Organization + +For the sake of consistency to aid readability and findability, we recommend +classes be organized (ordered) according to the following rules. + +- Public interfaces should appear at the top of a class declaration. + - These are the typically what other developers or users will be looking + for when reading or interacting with your code. +- Place methods first and class variables last, according to the same logic as + above. +- Group methods of the same "kind" or "purpose." + - E.g., group *getters* together and separate them from state-changing + methods that are also grouped together. + - Avoid interleaving functions of different kind. +- Seek to group class-variable declarations together in a meaningful way. + - This could be according to the actual C++ ***type***, but even better + would be done according to how the variables will be used or what + other parts of the code they will interact with. + - To illustrate, in the snippet below, a class storing 2 grid-types and + a `bool` should prefer `class A` to `class B` + + ```c++ + class A { + MyGrid source; + MyGrid target; + bool forward; + }; + class B { + MyGrid source; + bool forward; + MyGrid target; + }; + ``` + +We acknowledge that these rules do not form a complete logical schema, and so, +we defer to the judgement of the developer and their willingness to consider +the poor souls that will one day read their code. :slightly_smiling_face: diff --git a/components/eamxx/docs/developer/style/variables.md b/components/eamxx/docs/developer/style/variables.md new file mode 100644 index 000000000000..ad1324037c16 --- /dev/null +++ b/components/eamxx/docs/developer/style/variables.md @@ -0,0 +1,69 @@ +# Variables + +## Naming + +- Please name variables as ***descriptive nouns***. + - That is, for a variable holding data related to *horizontal winds*, choose + `horizontal_winds` or even `horiz_winds` versus `wh`. + - In cases for which this may be untenable, add comments explaining + non-obvious variable names. +- In general, variables should use `snake_case` and be entirely lowercase, + unless capitalizing is a standard convention (e.g., `T` for temperature). +- We do not currently employ a stylistic distinction between different types of + variables--e.g., `const`, `static`, member variables, etc. +- We do, however, ask that some convention is employed to identify member + variables of a class. + - Some commonly used techniques include distinguishing member variables + with a leading `m_` (`m_var` $\approx$ "my var"), or a trailing/leading + underscore (`var_` or `_var`). + - That said, this convention should be ***locally consistent*** within a + given class, struct, or otherwise. +- As to favoring ***nouns*** for naming, one should avoid using articles or + verbs in variable names. + - The key "exception" here would be prefixes like `is_`, `has_`, `can_` + that are commonly used with boolean variables. + +## Usage + +### Intermediate Variables + +There is a balance to be struck between introducing extra, or intermediate, +variables and avoiding excess allocations/de-allocations or minimizing clutter. + +- In line with the hierarchy of correct/fast/understandable, mentioned in + the [Style Standards Overview](style.md#general-guidelines), + it often improves matters to introduce an intermediate variable, + pointer, subview, etc., rather than triply-indexing into a variable + that's contained within a class-member struct. +- This principle applies to calculations as well, as there are situations + in which readability is improved by breaking complex operations into + multiple steps. +- **Generally speaking**, unless the code is highly-optimized and/or + performance-critical, **usage of intermediate variables is preferred**. + - Here, readability and bug-safety are the top concerns, so the clarity + provided by descriptive intermediate variables and resultant shorter + lines, trumps most other factors. + +### Descriptive Power vs. Brevity in Naming + +There is obvious a crossover point at which a name becomes **too** descriptive +or simply too long, so as to be cumbersome to use. +Thus, the issue of descriptive naming should be balanced against brevity in +name choice, and we give some examples and rules of thumb. + +- Consider synonyms that may shorten a variable name without sacrificing clarity. +- Make use of common word truncations or abbreviations. + - E.g., `mgr` instead of `manager` or `dev` in place of `device`. + - However, avoid non-standard abbreviations that may only be common + parlance within a small group. + - This includes names that correspond to standard arithmetic variables + in an equation (`gamma`, `y_hat`), ***unless*** the equation is + included as a comment and the connection is readily apparent. +- The converse of the previous is avoid making contractions that negatively + impact clarity. + - A notorious example of this is removing vowels. + - E.g., `loop_cnt`, rather than `loop_count` provides little savings, + at the expense of clarity.[^funfact] + +[^funfact]: Much like some [dangerous options-trading strategies](https://www.investopedia.com/ask/answers/050115/what-types-options-positions-create-unlimited-liability.asp), +this practice offers limited upside, yet the potential downside is unlimited. diff --git a/components/eamxx/docs/developer/style_guide.md b/components/eamxx/docs/developer/style_guide.md deleted file mode 100644 index 102f4d7b489f..000000000000 --- a/components/eamxx/docs/developer/style_guide.md +++ /dev/null @@ -1,9 +0,0 @@ -# EAMxx C++ Style Guide - -Here's our style guide. Let the holy wars begin! - -## Types - -## Functions and Methods - -## Variables diff --git a/components/eamxx/docs/refs/aerocom_cldtop.bib b/components/eamxx/docs/refs/aerocom_cldtop.bib deleted file mode 100644 index 45ed58088600..000000000000 --- a/components/eamxx/docs/refs/aerocom_cldtop.bib +++ /dev/null @@ -1,24 +0,0 @@ - -@techreport{tiedtke_ecmwf_1979, - address = {Shinfield Park, Reading}, - type = {Technical {Report}}, - title = {{ECMWF} model parameterisation of sub-grid scale processes}, - language = {en}, - institution = {ECMWF}, - author = {Tiedtke, M. and Geleyn, J.-F. and Hollingsworth, A. and Louis, J.-F.}, - month = jan, - year = {1979}, - note = {10}, - pages = {146}, -} - -@article{raisanen2004stochastic, - title={Stochastic generation of subgrid-scale cloudy columns for large-scale models}, - author={R{\"a}is{\"a}nen, Petri and Barker, Howard W and Khairoutdinov, Marat F and Li, Jiangnan and Randall, David A}, - journal={Quarterly Journal of the Royal Meteorological Society: A journal of the atmospheric sciences, applied meteorology and physical oceanography}, - volume={130}, - number={601}, - pages={2047--2067}, - year={2004}, - publisher={Wiley Online Library} -} diff --git a/components/eamxx/docs/refs/general.bib b/components/eamxx/docs/refs/eamxx.bib similarity index 87% rename from components/eamxx/docs/refs/general.bib rename to components/eamxx/docs/refs/eamxx.bib index b87994f796db..75ea44c1517f 100644 --- a/components/eamxx/docs/refs/general.bib +++ b/components/eamxx/docs/refs/eamxx.bib @@ -122,3 +122,27 @@ @article{Taylor_et20 note = {e2019MS001783 10.1029/2019MS001783}, year = {2020} } + +@techreport{tiedtke_ecmwf_1979, + address = {Shinfield Park, Reading}, + type = {Technical {Report}}, + title = {{ECMWF} model parameterisation of sub-grid scale processes}, + language = {en}, + institution = {ECMWF}, + author = {Tiedtke, M. and Geleyn, J.-F. and Hollingsworth, A. and Louis, J.-F.}, + month = jan, + year = {1979}, + note = {10}, + pages = {146}, +} + +@article{raisanen2004stochastic, + title={Stochastic generation of subgrid-scale cloudy columns for large-scale models}, + author={R{\"a}is{\"a}nen, Petri and Barker, Howard W and Khairoutdinov, Marat F and Li, Jiangnan and Randall, David A}, + journal={Quarterly Journal of the Royal Meteorological Society: A journal of the atmospheric sciences, applied meteorology and physical oceanography}, + volume={130}, + number={601}, + pages={2047--2067}, + year={2004}, + publisher={Wiley Online Library} +} diff --git a/components/eamxx/docs/user/diags/field_contraction.md b/components/eamxx/docs/user/diags/field_contraction.md new file mode 100644 index 000000000000..935e9d93855c --- /dev/null +++ b/components/eamxx/docs/user/diags/field_contraction.md @@ -0,0 +1,104 @@ +# Field contraction diagnostics + +In EAMxx, we can automatically calculate field reductions +across the horizontal columns and across the model vertical levels. +We call these horizontal and vertical reductions. +We can also automatically calculate zonal averages. + +## Horizontal reduction + +We currently offer only one horizontal reduction $C$, and it is defined as + +$$ +C_{\dots k} = \sum_{i} w_{i} \cdot F_{i \dots k} +$$ + +where $F_\text{i...k}$ is the field at column $i$ and level $k$, +and $w_{i}$ is the weight at column $i$. +We note that the field $F$ can have other dimensions ($\dots$). +The weight $w$ is defined as the area fraction in column $i$, +that is, the area in column $i$ divided by the total area in all columns. + +To select the horizontal reduction, you only need to suffix +a field name `X` with `_horiz_avg` in the output requests. + +| Reduction | Weight | Description | +| --------- | ------ | ----------- | +| `X_horiz_avg` | Area fraction | Average across all columns | + +## Vertical reduction + +We currently offer three vertical reductions $C$, defined as + +$$ +C_{\dots} = \sum_{k} w_{k} \cdot F_{\dots k} +$$ + +where $F_{\dots k}$ is the field at level $k$, +and $w_{k}$ is the weight at level $k$. + +To select the vertical reduction, you only need to suffix +a field name `X` with `_vert_(avg|sum)_(dp|dz)_weighted` or +`_vert_(avg|sum)` in the output yaml files. + +| Reduction | Weight | Description | +| --------- | ------ | ----------- | +| `X_vert_avg_dp_weighted` | $\Delta p_{k}$ | Average across all levels, weighted by $\Delta p_{k}$ | +| `X_vert_sum_dp_weighted` | $\Delta p_{k}$ | Sum across all levels, weighted by $\Delta p_{k}$ | +| `X_vert_avg_dz_weighted` | $\Delta z_{k}$ | Average across all levels, weighted by $\Delta z_{k}$ | +| `X_vert_sum_dz_weighted` | $\Delta z_{k}$ | Sum across all levels, weighted by $\Delta z_{k}$ | +| `X_vert_avg` | 1 | Average across all levels | +| `X_vert_sum` | 1 | Sum across all levels | + +The supported weighting options for now are + +- `pseudo_density` field in EAMxx, $\Delta p_{k}$, in units of Pa; +- `dz` field in EAMxx, $\Delta z_{k}$, in units of m; +- and no weighting, which is equivalent to using a weight of 1. + +In the case of `pseudo_density`, the weighting is scaled by 1/g, +where g is the gravitational acceleration, in units of m/s$^2$. + +## Zonal reduction + +We currently have a utility to calculate zonal averages online. +To select the zonal average, you need to suffix +a field name `X` with `_zonal_avg` and the +number of bins `Y` as `_Y_bins`. All zonal averages are calculated +using the area fraction in each bin as the weight. + +For 180 latitude bins, the bins are defined +as follows: [-90, -89), [-89, -88), ..., [89, 90). +For 90 latitude bins, the bins are defined as follows: +[-90, -88), [-88, -86), ..., [88, 90). +And so on... + +| Reduction | Weight | Description | +| --------- | ------ | ----------- | +| `X_zonal_avg_Y_bins` | Area fraction | Average across the zonal direction | + +## Example + +```yaml +%YAML 1.1 +--- +filename_prefix: monthly.outputs +averaging_type: average +max_snapshots_per_file: 1 +fields: + physics_pg2: + field_names: + # in this example, we use T_mid in units of K + - T_mid_horiz_avg # K + - T_mid_vert_avg_dp_weighted # K + - T_mid_vert_sum_dp_weighted # K * Pa * s / (m * m) + - T_mid_vert_avg_dz_weighted # K + - T_mid_vert_sum_dz_weighted # K * m + - T_mid_vert_avg # K + - T_mid_vert_sum # K + - T_mid_zonal_avg_180_bins # K + - T_mid_zonal_avg_90_bins # K +output_control: + frequency: 1 + frequency_units: nmonths +``` diff --git a/components/eamxx/docs/user/diags/index.md b/components/eamxx/docs/user/diags/index.md new file mode 100644 index 000000000000..14d3701d8cee --- /dev/null +++ b/components/eamxx/docs/user/diags/index.md @@ -0,0 +1,7 @@ +# Online diagnostics + +EAMxx has facilities to output optional diagnostics +that are computed during runtime. These diagnostics +are designed generically and composably, and are requestable by users. + +More details to follow. diff --git a/components/eamxx/mkdocs.yml b/components/eamxx/mkdocs.yml index 752a6213b397..edb6c516558d 100644 --- a/components/eamxx/mkdocs.yml +++ b/components/eamxx/mkdocs.yml @@ -2,12 +2,9 @@ site_name: EAMxx nav: - 'Home': 'index.md' - # - 'WIP Sandbox': 'WIP.md' - 'User Guide': - 'Overview': 'user/index.md' - # - 'Quick-start Guide': 'user/user_quickstart.md' - 'EAMxx case basics': 'user/eamxx_cases.md' - # - 'Testing': 'user/user_testing.md' - 'Model Configuration': 'user/model_configuration.md' - 'Nudging': 'user/nudging.md' - 'Extra radiation calls': 'user/clean_clear_sky.md' @@ -18,21 +15,30 @@ nav: - 'IO Metadata': 'user/io_metadata.md' - 'Multi-Instance and NBFB': 'user/multi-instance-mvk.md' - 'EAMxx runtime parameters': 'user/eamxx_params.md' + - 'Diagnostics': + - 'Overview': 'user/diags/index.md' + - 'Field contraction diagnostics': 'user/diags/field_contraction.md' - 'Presentations': 'user/presentations.md' - 'Developer Guide': - # - 'Overview': 'developer/index.md' - 'Quick-start Guide': 'developer/dev_quickstart.md' - 'Code Structure and Organization': 'developer/code_structure.md' - # - 'Installation': 'common/installation.md' - - 'Style Guide': 'developer/style_guide.md' + - 'Style Guide': + - 'Overview': 'developer/style/style_guide_overview.md' + - 'Code Formatting Standards': 'developer/style/format.md' + - 'Code Style Standards': + - 'Overview': 'developer/style/style.md' + - 'Types, Classes, Structures': 'developer/style/types.md' + - 'Functions and Methods': 'developer/style/functions.md' + - 'Variables': 'developer/style/variables.md' + - 'Templating': 'developer/style/templates.md' + - 'Resources': + - 'How-to Guide: clang-format': 'developer/style/resources/clang-format_HOWTO.md' - 'Testing': - 'Overview': 'developer/dev_testing/index.md' - 'Testing for Development': 'developer/dev_testing/testing_for_development.md' - 'Automated Standalone Testing': 'developer/dev_testing/test_all_eamxx.md' - 'Full model (CIME)': 'developer/dev_testing/full_model_testing.md' - 'CI and Nightly Testing': 'developer/dev_testing/ci_nightly.md' - # - 'Supported Computing Platforms': 'developer/dev_testing/supported_machines.md' - # - 'Testing Locally': 'developer/dev_testing/local_test.md' - 'Important Tools and Objects': - 'Kokkos and EKAT': 'developer/kokkos_ekat.md' - 'Fields': 'developer/field.md' @@ -43,7 +49,6 @@ nav: - 'Technical Guide': - 'Overview': 'technical/index.md' - 'AeroCom cloud top': 'technical/aerocom_cldtop.md' - # - 'Glossary': 'common/glossary.md' edit_uri: "" diff --git a/components/eamxx/scripts/eamxx-cacts b/components/eamxx/scripts/eamxx-cacts new file mode 100755 index 000000000000..cac749dd4e47 --- /dev/null +++ b/components/eamxx/scripts/eamxx-cacts @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +# Ensure cacts package is installed and up to date +pip install --user --upgrade cacts + +# Run cacts +cacts "$@" diff --git a/components/eamxx/scripts/gen_boiler.py b/components/eamxx/scripts/gen_boiler.py index fcbce1ab4f21..c3897cded416 100644 --- a/components/eamxx/scripts/gen_boiler.py +++ b/components/eamxx/scripts/gen_boiler.py @@ -18,7 +18,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "physics/{phys}/{phys}_functions.hpp" -#include "physics/{phys}/{phys}_functions_f90.hpp" +#include "physics/{phys}/tests/infra/{phys}_test_data.hpp" #include "{phys}_unit_tests_common.hpp" @@ -27,7 +27,7 @@ namespace unit_test {{ template -struct UnitWrap::UnitTest::{get_data_test_struct_name(sub)} {{ +struct UnitWrap::UnitTest::{get_data_test_struct_name(sub)} : public UnitWrap::UnitTest::Base {{ {gen_code} @@ -43,7 +43,8 @@ {{ using TestStruct = scream::{phys}::unit_test::UnitWrap::UnitTest::{get_data_test_struct_name(sub)}; - TestStruct::run_bfb(); + TestStruct t; + t.run_bfb(); }} }} // empty namespace @@ -84,7 +85,7 @@ FILEPATH, FILECREATE, INSERT_REGEX, ID_SELF_BEGIN_REGEX, ID_SELF_END_REGEX, DESC = range(6) PIECES = OrderedDict([ ("f90_c2f_bind", ( - lambda phys, sub, gb: f"{phys}_iso_c.f90", + lambda phys, sub, gb: f"tests/infra/{phys}_iso_c.f90", lambda phys, sub, gb: expect_exists(phys, sub, gb, "f90_c2f_bind"), lambda phys, sub, gb: re.compile(fr"^\s*end\s+module\s{phys}_iso_c"), # put at end of module lambda phys, sub, gb: get_subroutine_begin_regex(sub + "_c"), # sub_c begin @@ -92,17 +93,17 @@ lambda *x : "The c to f90 fortran subroutine(_c)" )), - ("f90_f2c_bind" , ( - lambda phys, sub, gb: f"{phys}_iso_f.f90", - lambda phys, sub, gb: expect_exists(phys, sub, gb, "f90_f2c_bind"), - lambda phys, sub, gb: re.compile(r"^\s*end\s+interface"), # put at end of interface - lambda phys, sub, gb: get_subroutine_begin_regex(sub + "_f"), # sub_f begin - lambda phys, sub, gb: get_subroutine_end_regex(sub + "_f"), # sub_f begin - lambda *x : "The f90 to c fortran subroutine(_f)" - )), + # ("f90_f2c_bind" , ( + # lambda phys, sub, gb: f"{phys}_iso_f.f90", + # lambda phys, sub, gb: expect_exists(phys, sub, gb, "f90_f2c_bind"), + # lambda phys, sub, gb: re.compile(r"^\s*end\s+interface"), # put at end of interface + # lambda phys, sub, gb: get_subroutine_begin_regex(sub + "_f"), # sub_f begin + # lambda phys, sub, gb: get_subroutine_end_regex(sub + "_f"), # sub_f begin + # lambda *x : "The f90 to c fortran subroutine(_f)" + # )), ("cxx_c2f_bind_decl" , ( - lambda phys, sub, gb: f"{phys}_functions_f90.cpp", + lambda phys, sub, gb: f"tests/infra/{phys}_test_data.cpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_c2f_bind_decl"), lambda phys, sub, gb: get_cxx_close_block_regex(comment='extern "C" : end _c decls'), # reqs special comment lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_c"), # cxx_c decl @@ -111,7 +112,7 @@ )), ("cxx_c2f_glue_decl" , ( - lambda phys, sub, gb: f"{phys}_functions_f90.hpp", + lambda phys, sub, gb: f"tests/infra/{phys}_test_data.hpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_c2f_glue_decl"), lambda phys, sub, gb: re.compile(r'^\s*extern\s+"C"'), # put before _f decls lambda phys, sub, gb: get_cxx_function_begin_regex(sub), # cxx(data) decl @@ -120,7 +121,7 @@ )), ("cxx_c2f_glue_impl" , ( - lambda phys, sub, gb: f"{phys}_functions_f90.cpp", + lambda phys, sub, gb: f"tests/infra/{phys}_test_data.cpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_c2f_glue_impl"), lambda phys, sub, gb: re.compile(r"^\s*// end _c impls"), # reqs special comment lambda phys, sub, gb: get_cxx_function_begin_regex(sub), # cxx(data) @@ -129,7 +130,7 @@ )), ("cxx_c2f_data" , ( - lambda phys, sub, gb: f"{phys}_functions_f90.hpp", + lambda phys, sub, gb: f"tests/infra/{phys}_test_data.hpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_c2f_data"), lambda phys, sub, gb: re.compile(r"^\s*// Glue functions to call fortran"), # reqs special comment lambda phys, sub, gb: get_cxx_struct_begin_regex(get_data_struct_name(sub)), # struct Sub @@ -137,23 +138,23 @@ lambda *x : "The cxx data struct definition(struct Data)" )), - ("cxx_f2c_bind_decl" , ( - lambda phys, sub, gb: f"tests/infra/{phys}_test_data.hpp", - lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_f2c_bind_decl"), - lambda phys, sub, gb: get_plain_comment_regex(comment="end _host function decls"), # reqs special comment - lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_host"), # cxx_host decl - lambda phys, sub, gb: re.compile(r".*;\s*$"), # ; - lambda *x : "The f90 to cxx function declaration(_host)" - )), - - ("cxx_f2c_bind_impl" , ( - lambda phys, sub, gb: f"tests/infra/{phys}_test_data.cpp", - lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_f2c_bind_impl"), - lambda phys, sub, gb: get_namespace_close_regex(phys), # insert at end of namespace - lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_host"), # cxx_f - lambda phys, sub, gb: get_cxx_close_block_regex(at_line_start=True), # terminating } - lambda *x : "The f90 to cxx function implementation(_host)" - )), + # ("cxx_f2c_bind_decl" , ( + # lambda phys, sub, gb: f"tests/infra/{phys}_test_data.hpp", + # lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_f2c_bind_decl"), + # lambda phys, sub, gb: get_plain_comment_regex(comment="end _f function decls"), # reqs special comment + # lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_f"), # cxx_f decl + # lambda phys, sub, gb: re.compile(r".*;\s*$"), # ; + # lambda *x : "The f90 to cxx function declaration(_f)" + # )), + + # ("cxx_f2c_bind_impl" , ( + # lambda phys, sub, gb: f"tests/infra/{phys}_test_data.cpp", + # lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_f2c_bind_impl"), + # lambda phys, sub, gb: get_namespace_close_regex(phys), # insert at end of namespace + # lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_f"), # cxx_f + # lambda phys, sub, gb: get_cxx_close_block_regex(at_line_start=True), # terminating } + # lambda *x : "The f90 to cxx function implementation(_f)" + # )), ("cxx_func_decl", ( lambda phys, sub, gb: f"{phys}_functions.hpp", @@ -183,9 +184,9 @@ )), ("cxx_bfb_unit_decl", ( - lambda phys, sub, gb: f"tests/{phys}_unit_tests_common.hpp", + lambda phys, sub, gb: f"tests/infra/{phys}_unit_tests_common.hpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_bfb_unit_decl"), - lambda phys, sub, gb: get_cxx_close_block_regex(semicolon=True), # insert at end of test struct + lambda phys, sub, gb: get_cxx_close_block_regex(semicolon=True, comment="UnitWrap"), # Insert at end of UnitWrap struc lambda phys, sub, gb: get_cxx_struct_begin_regex(get_data_test_struct_name(sub)), # struct decl lambda phys, sub, gb: re.compile(r".*;\s*$"), # end of struct decl lambda *x : "The cxx unit test struct declaration" @@ -202,7 +203,7 @@ ("cxx_eti", ( lambda phys, sub, gb: f"eti/{phys}_{sub}.cpp", - lambda phys, sub, gb: create_template(phys, sub, gb, "cxx_eti"), + lambda phys, sub, gb: create_template(phys, sub, gb, "cxx_eti", force=True), lambda phys, sub, gb: re.compile(".*"), # insert at top of file lambda phys, sub, gb: re.compile(".*"), # start at top of file lambda phys, sub, gb: get_namespace_close_regex("scream"), #end of file @@ -230,7 +231,7 @@ ]) # physics map. maps the name of a physics packages containing the original fortran subroutines to: -# (path-to-origin, path-to-cxx-src) +# (path-to-origin, path-to-cxx-src, init-code) ORIGIN_FILES, CXX_ROOT, INIT_CODE = range(3) PHYSICS = { "p3" : ( @@ -248,6 +249,16 @@ "components/eamxx/src/physics/dp", "dp_init(d.plev, true);" ), + "gw" : ( + ("components/eam/src/physics/cam/gw/gw_common.F90", + "components/eam/src/physics/cam/gw/gw_convect.F90", + "components/eam/src/physics/cam/gw/gw_diffusion.F90", + "components/eam/src/physics/cam/gw/gw_oro.F90", + "components/eam/src/physics/cam/gw/gw_utils.F90", + "components/eam/src/physics/cam/gw/gw_front.F90"), + "components/eamxx/src/physics/gw", + "gw_init();" + ), } # A good set of arg data for unit testing @@ -749,6 +760,9 @@ def parse_f90_args(line): [('elem', 'type::element_t', 'inout', (':',))] >>> parse_f90_args('character*(max_path_len), intent(out), optional :: iopfile_out') [('iopfile_out', 'type::string', 'out', None)] + >>> parse_f90_args('real(r8), intent(out) :: nm(ncol,pver), ni(ncol,0:pver)') + [('nm', 'real', 'out', ('ncol', 'pver')), ('ni', 'real', 'out', ('ncol', '0:pver'))] + """ expect(line.count("::") == 1, f"Expected line format 'type-info :: names' for: {line}") metadata_str, names_str = line.split("::") @@ -774,18 +788,19 @@ def parse_f90_args(line): dims = tuple(item.replace(" ", "") for item in dims_raw.split(",")) names = [] + all_dims = [] for name_dim in names_dims: if "(" in name_dim: name, dims_raw = name_dim.split("(") dims_raw = dims_raw.rstrip(")").strip() dims_check = tuple(item.replace(" ", "") for item in dims_raw.split(",")) - expect(dims is None or dims_check == dims, f"Inconsistent dimensions in line: {line}") - dims = dims_check + all_dims.append(dims_check) names.append(name.strip()) else: + all_dims.append(dims) names.append(name_dim.strip()) - return [(name, argtype, intent, dims) for name in names] + return [(name, argtype, intent, dims) for name, dims in zip(names, all_dims)] ############################################################################### def parse_origin(contents, subs): @@ -1105,6 +1120,23 @@ def gen_arg_cxx_decls(arg_data, kokkos=False): get_type = get_kokkos_type if kokkos else get_cxx_type arg_types = [get_type(item) for item in arg_data] arg_sig_list = [f"{arg_type} {arg_name}" for arg_name, arg_type in zip(arg_names, arg_types)] + + # For permanent sigs, we want them to look nice + if kokkos: + list_with_comments = [] + intent_map = {"in" : "Inputs", "inout" : "Inputs/Outputs", "out" : "Outputs"} + curr = None + for arg_sig, arg_datum in zip(arg_sig_list, arg_data): + intent = arg_datum[ARG_INTENT] + if intent != curr: + fullname = intent_map[intent] + list_with_comments.append(f"// {fullname}") + curr = intent + + list_with_comments.append(arg_sig) + + arg_sig_list = list_with_comments + return arg_sig_list ############################################################################### @@ -1358,6 +1390,17 @@ def group_data(arg_data, filter_out_intent=None, filter_scalar_custom_types=Fals return fst_dims, snd_dims, trd_dims, all_dims, scalars, real_data, int_data, bool_data +############################################################################### +def get_list_of_lists(items, indent): +############################################################################### + result = "{\n" + for item in items: + result += f"{indent}{{{item}}},\n" + result = result.rstrip(",\n") + result += f"\n{indent[0:-2]}}}" + + return result + ############################################################################### def gen_struct_api(physics, struct_name, arg_data): ############################################################################### @@ -1385,20 +1428,27 @@ def gen_struct_api(physics, struct_name, arg_data): bool_vec = [] for data, data_vec in zip([real_data, int_data, bool_data], [real_vec, int_vec, bool_vec]): for dims, items in data.items(): - dim_cxx_vec.append(f"{{ {', '.join(['{}_'.format(item) for item in dims])} }}") - data_vec.append(f"{{ {', '.join(['&{}'.format(item) for item in items])} }}") + dim_cxx_vec.append(f"{', '.join(['{}_'.format(item) for item in dims])}") + data_vec.append(f"{', '.join(['&{}'.format(item) for item in items])}") + + parent_call = " PhysicsTestData(" + parent_call += get_list_of_lists(dim_cxx_vec, " ") + parent_call += ",\n " + parent_call += get_list_of_lists(real_vec, " ") - parent_call = f" PhysicsTestData({{{', '.join(dim_cxx_vec)}}}, {{{', '.join(real_vec)}}}" - if int_vec or bool_vec: - parent_call += f", {{{', '.join(int_vec)}}}" + if int_vec: + parent_call += ",\n " + parent_call += get_list_of_lists(int_vec, " ") if bool_vec: - parent_call += f", {{{', '.join(bool_vec)}}}" - parent_call += ")" + parent_call += ",\n " + parent_call += get_list_of_lists(bool_vec, " ") - parent_call += f", {', '.join(['{0}({0}_)'.format(name) for name, _ in cons_args])}" + parent_call += "),\n" + + parent_call += f" {', '.join(['{0}({0}_)'.format(name) for name, _ in cons_args])}" - parent_call += " {}" result.append(parent_call) + result.append("{}") result.append("") result.append("PTD_STD_DEF({}, {}, {});".\ @@ -1761,6 +1811,9 @@ def gen_cxx_c2f_data(self, phys, sub, force_arg_data=None): }}; """ + + result = "\n".join([item.rstrip() for item in result.splitlines()]) + return result ########################################################################### @@ -1774,7 +1827,7 @@ def gen_cxx_f2c_bind_decl(self, phys, sub, force_arg_data=None): arg_data = force_arg_data if force_arg_data else self._get_arg_data(phys, sub) arg_decls = gen_arg_cxx_decls(arg_data) - return f"void {sub}_host({', '.join(arg_decls)});" + return f"void {sub}_f({', '.join(arg_decls)});" ########################################################################### def gen_cxx_f2c_bind_impl(self, phys, sub, force_arg_data=None): @@ -1784,7 +1837,104 @@ def gen_cxx_f2c_bind_impl(self, phys, sub, force_arg_data=None): >>> print(gb.gen_cxx_f2c_bind_impl("shoc", "fake_sub", force_arg_data=UT_ARG_DATA)) void fake_sub_f(Real* foo1, Real* foo2, Real* bar1, Real* bar2, Real* bak1, Real* bak2, Real* tracerd1, Real* tracerd2, Real gag, Real* baz, Int* bag, Int* bab1, Int* bab2, bool val, bool* vals, Int shcol, Int nlev, Int nlevi, Int ntracers, Int* ball1, Int* ball2) { - // TODO + #if 0 + using SHF = Functions; + using Scalar = typename SHF::Scalar; + using Spack = typename SHF::Spack; + using KT = typename SHF::KT; + using ExeSpace = typename KT::ExeSpace; + using MemberType = typename SHF::MemberType; + + using view_2d = typename SHF::view_2d; + using view_1d = typename SHF::view_1d; + using view_3d = typename SHF::view_3d; + using iview_1d = typename SHF::view_1d; + using bview_1d = typename SHF::view_1d; + + static constexpr Int num_arrays_2 = 4; + std::vector temp_d_2(num_arrays_2); + std::vector dim_2_0_sizes = {shcol, shcol, shcol, shcol}; + std::vector dim_2_1_sizes = {nlevi, nlevi, nlev, nlev}; + ekat::host_to_device({bak1, bak2, bar1, bar2}, dim_2_0_sizes, dim_2_1_sizes, temp_d_2); + + static constexpr Int num_arrays_1 = 3; + std::vector temp_d_1(num_arrays_1); + std::vector dim_1_0_sizes = {shcol, shcol, shcol}; + ScreamDeepCopy::copy_to_device({baz, foo1, foo2}, dim_1_0_sizes, temp_d_1); + + static constexpr Int num_arrays_3 = 2; + std::vector temp_d_3(num_arrays_3); + std::vector dim_3_0_sizes = {shcol, shcol}; + std::vector dim_3_1_sizes = {nlev, nlev}; + std::vector dim_3_2_sizes = {ntracers, ntracers}; + ekat::host_to_device({tracerd1, tracerd2}, dim_3_0_sizes, dim_3_1_sizes, dim_3_2_sizes, temp_d_3); + + static constexpr Int inum_arrays_1 = 3; + std::vector itemp_d_1(inum_arrays_1); + std::vector idim_1_0_sizes = {shcol, shcol, shcol}; + ScreamDeepCopy::copy_to_device({bag, ball1, ball2}, idim_1_0_sizes, itemp_d_1); + + static constexpr Int bnum_arrays_1 = 1; + std::vector btemp_d_1(bnum_arrays_1); + std::vector bdim_1_0_sizes = {shcol}; + ScreamDeepCopy::copy_to_device({vals}, bdim_1_0_sizes, btemp_d_1); + + view_2d + bak1_d(temp_d_2[0]), + bak2_d(temp_d_2[1]), + bar1_d(temp_d_2[2]), + bar2_d(temp_d_2[3]); + + view_1d + baz_d(temp_d_1[0]), + foo1_d(temp_d_1[1]), + foo2_d(temp_d_1[2]); + + view_3d + tracerd1_d(temp_d_3[0]), + tracerd2_d(temp_d_3[1]); + + iview_1d + bag_d(itemp_d_1[0]), + ball1_d(itemp_d_1[1]), + ball2_d(itemp_d_1[2]); + + bview_1d + vals_d(btemp_d_1[0]); + + const Int nk_pack = ekat::npack(nlev); + const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(shcol, nk_pack); + Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { + const Int i = team.league_rank(); + + const auto bak1_s = ekat::subview(bak1_d, i); + const auto bak2_s = ekat::subview(bak2_d, i); + const auto bar1_s = ekat::subview(bar1_d, i); + const auto bar2_s = ekat::subview(bar2_d, i); + const Scalar baz_s = baz_d(i); + const Scalar foo1_s = foo1_d(i); + const Scalar foo2_s = foo2_d(i); + const auto tracerd1_s = ekat::subview(tracerd1_d, i); + const auto tracerd2_s = ekat::subview(tracerd2_d, i); + + const Scalar bag_s = bag_d(i); + const Scalar ball1_s = ball1_d(i); + const Scalar ball2_s = ball2_d(i); + + const Scalar vals_s = vals_d(i); + + SHF::fake_sub(foo1_s, foo2_s, bar1_s, bar2_s, bak1_s, bak2_s, tracerd1_s, tracerd2_s, gag, baz_s, bag_s, bab1, bab2, val, vals_s, shcol, nlev, nlevi, ntracers, ball1_s, ball2_s); + }); + std::vector tempout_d_1(num_arrays_1); + std::vector dim_1_0_out_sizes = {shcol}; + ScreamDeepCopy::copy_to_host({baz}, dim_1_0_out_sizes, tempout_d_1); + + std::vector itempout_d_1(inum_arrays_1); + std::vector idim_1_0_out_sizes = {shcol, shcol}; + ScreamDeepCopy::copy_to_host({ball1, ball2}, idim_1_0_out_sizes, itempout_d_1); + + #endif + } >>> print(gb.gen_cxx_f2c_bind_impl("shoc", "fake_sub", force_arg_data=UT_ARG_DATA_ALL_SCALAR)) @@ -2134,7 +2284,9 @@ def gen_cxx_func_decl(self, phys, sub, force_arg_data=None): arg_data = force_arg_data if force_arg_data else self._get_arg_data(phys, sub) arg_decls = gen_arg_cxx_decls(arg_data, kokkos=True) - return f" KOKKOS_FUNCTION\n static void {sub}({', '.join(arg_decls)});" + arg_decls_str = ("\n ".join([item if item.startswith("//") else f"{item}," for item in arg_decls])).rstrip(",") + + return f" KOKKOS_FUNCTION\n static void {sub}(\n {arg_decls_str});" ########################################################################### def gen_cxx_incl_impl(self, phys, sub, force_arg_data=None): @@ -2191,36 +2343,36 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): >>> print(gb.gen_cxx_bfb_unit_impl("shoc", "fake_sub", force_arg_data=UT_ARG_DATA)) static void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - FakeSubData f90_data[] = { + FakeSubData baseline_data[] = { // TODO }; - static constexpr Int num_runs = sizeof(f90_data) / sizeof(FakeSubData); + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(FakeSubData); // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by test. Needs to happen before read calls so that // inout data is in original state - FakeSubData cxx_data[] = { + FakeSubData test_data[] = { // TODO }; // Assume all data is in C layout // Get data from fortran - for (auto& d : f90_data) { + for (auto& d : baseline_data) { // expects data in C layout fake_sub(d); } - // Get data from cxx - for (auto& d : cxx_data) { + // Get data from test + for (auto& d : test_data) { d.transpose(); // _f expects data in fortran layout fake_sub_f(d.foo1, d.foo2, d.bar1, d.bar2, d.bak1, d.bak2, d.tracerd1, d.tracerd2, d.gag, d.baz, d.bag, &d.bab1, &d.bab2, d.val, d.vals, d.shcol, d.nlev, d.nlevi, d.ntracers, d.ball1, d.ball2); d.transpose(); // go back to C layout @@ -2229,17 +2381,17 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING) { for (Int i = 0; i < num_runs; ++i) { - FakeSubData& d_f90 = f90_data[i]; - FakeSubData& d_cxx = cxx_data[i]; - REQUIRE(d_f90.bab1 == d_cxx.bab1); - REQUIRE(d_f90.bab2 == d_cxx.bab2); - for (Int k = 0; k < d_f90.total(d_f90.baz); ++k) { - REQUIRE(d_f90.total(d_f90.baz) == d_cxx.total(d_cxx.baz)); - REQUIRE(d_f90.baz[k] == d_cxx.baz[k]); - REQUIRE(d_f90.total(d_f90.baz) == d_cxx.total(d_cxx.ball1)); - REQUIRE(d_f90.ball1[k] == d_cxx.ball1[k]); - REQUIRE(d_f90.total(d_f90.baz) == d_cxx.total(d_cxx.ball2)); - REQUIRE(d_f90.ball2[k] == d_cxx.ball2[k]); + FakeSubData& d_baseline = baseline_data[i]; + FakeSubData& d_test = test_data[i]; + REQUIRE(d_baseline.bab1 == d_test.bab1); + REQUIRE(d_baseline.bab2 == d_test.bab2); + for (Int k = 0; k < d_baseline.total(d_baseline.baz); ++k) { + REQUIRE(d_baseline.total(d_baseline.baz) == d_test.total(d_test.baz)); + REQUIRE(d_baseline.baz[k] == d_test.baz[k]); + REQUIRE(d_baseline.total(d_baseline.baz) == d_test.total(d_test.ball1)); + REQUIRE(d_baseline.ball1[k] == d_test.ball1[k]); + REQUIRE(d_baseline.total(d_baseline.baz) == d_test.total(d_test.ball2)); + REQUIRE(d_baseline.ball2[k] == d_test.ball2[k]); } } @@ -2248,80 +2400,80 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): >>> print(gb.gen_cxx_bfb_unit_impl("shoc", "fake_sub", force_arg_data=UT_ARG_DATA_ALL_SCALAR)) static void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - FakeSubData f90_data[max_pack_size] = { + FakeSubData baseline_data[max_pack_size] = { // TODO }; - static constexpr Int num_runs = sizeof(f90_data) / sizeof(FakeSubData); + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(FakeSubData); // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx and sync it to device. Needs to happen before fortran calls so that + // Create copies of data for use by test and sync it to device. Needs to happen before fortran calls so that // inout data is in original state - view_1d cxx_device("cxx_device", max_pack_size); - const auto cxx_host = Kokkos::create_mirror_view(cxx_device); - std::copy(&f90_data[0], &f90_data[0] + max_pack_size, cxx_host.data()); - Kokkos::deep_copy(cxx_device, cxx_host); + view_1d test_device("test_device", max_pack_size); + const auto test_host = Kokkos::create_mirror_view(test_device); + std::copy(&baseline_data[0], &baseline_data[0] + max_pack_size, test_host.data()); + Kokkos::deep_copy(test_device, test_host); // Get data from fortran - for (auto& d : f90_data) { + for (auto& d : baseline_data) { fake_sub(d); } - // Get data from cxx. Run fake_sub from a kernel and copy results back to host + // Get data from test. Run fake_sub from a kernel and copy results back to host Kokkos::parallel_for(num_test_itrs, KOKKOS_LAMBDA(const Int& i) { const Int offset = i * Spack::n; // Init pack inputs Spack bar1, bar2, foo1, foo2; for (Int s = 0, vs = offset; s < Spack::n; ++s, ++vs) { - bar1[s] = cxx_device(vs).bar1; - bar2[s] = cxx_device(vs).bar2; - foo1[s] = cxx_device(vs).foo1; - foo2[s] = cxx_device(vs).foo2; + bar1[s] = test_device(vs).bar1; + bar2[s] = test_device(vs).bar2; + foo1[s] = test_device(vs).foo1; + foo2[s] = test_device(vs).foo2; } // Init outputs Spack baz1(0), baz2(0); - Functions::fake_sub(foo1, foo2, bar1, bar2, baz1, baz2, cxx_device(0).gag1, cxx_device(0).gag2, cxx_device(0).gal1, cxx_device(0).gal2, cxx_device(0).bal1, cxx_device(0).bal2, cxx_device(0).bit1, cxx_device(0).bit2, cxx_device(0).gut1, cxx_device(0).gut2, cxx_device(0).gat1, cxx_device(0).gat2); + Functions::fake_sub(foo1, foo2, bar1, bar2, baz1, baz2, test_device(0).gag1, test_device(0).gag2, test_device(0).gal1, test_device(0).gal2, test_device(0).bal1, test_device(0).bal2, test_device(0).bit1, test_device(0).bit2, test_device(0).gut1, test_device(0).gut2, test_device(0).gat1, test_device(0).gat2); - // Copy spacks back into cxx_device view + // Copy spacks back into test_device view for (Int s = 0, vs = offset; s < Spack::n; ++s, ++vs) { - cxx_device(vs).bar1 = bar1[s]; - cxx_device(vs).bar2 = bar2[s]; - cxx_device(vs).baz1 = baz1[s]; - cxx_device(vs).baz2 = baz2[s]; + test_device(vs).bar1 = bar1[s]; + test_device(vs).bar2 = bar2[s]; + test_device(vs).baz1 = baz1[s]; + test_device(vs).baz2 = baz2[s]; } }); - Kokkos::deep_copy(cxx_host, cxx_device); + Kokkos::deep_copy(test_host, test_device); // Verify BFB results if (SCREAM_BFB_TESTING) { for (Int i = 0; i < num_runs; ++i) { - FakeSubData& d_f90 = f90_data[i]; - FakeSubData& d_cxx = cxx_host[i]; - REQUIRE(d_f90.bar1 == d_cxx.bar1); - REQUIRE(d_f90.bar2 == d_cxx.bar2); - REQUIRE(d_f90.baz1 == d_cxx.baz1); - REQUIRE(d_f90.baz2 == d_cxx.baz2); - REQUIRE(d_f90.gal1 == d_cxx.gal1); - REQUIRE(d_f90.gal2 == d_cxx.gal2); - REQUIRE(d_f90.bal1 == d_cxx.bal1); - REQUIRE(d_f90.bal2 == d_cxx.bal2); - REQUIRE(d_f90.gut1 == d_cxx.gut1); - REQUIRE(d_f90.gut2 == d_cxx.gut2); - REQUIRE(d_f90.gat1 == d_cxx.gat1); - REQUIRE(d_f90.gat2 == d_cxx.gat2); + FakeSubData& d_baseline = baseline_data[i]; + FakeSubData& d_test = test_host[i]; + REQUIRE(d_baseline.bar1 == d_test.bar1); + REQUIRE(d_baseline.bar2 == d_test.bar2); + REQUIRE(d_baseline.baz1 == d_test.baz1); + REQUIRE(d_baseline.baz2 == d_test.baz2); + REQUIRE(d_baseline.gal1 == d_test.gal1); + REQUIRE(d_baseline.gal2 == d_test.gal2); + REQUIRE(d_baseline.bal1 == d_test.bal1); + REQUIRE(d_baseline.bal2 == d_test.bal2); + REQUIRE(d_baseline.gut1 == d_test.gut1); + REQUIRE(d_baseline.gut2 == d_test.gut2); + REQUIRE(d_baseline.gat1 == d_test.gat1); + REQUIRE(d_baseline.gat2 == d_test.gat2); } } } // run_bfb @@ -2336,15 +2488,15 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): """ // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); }""" _, _, _, _, scalars, real_data, int_data, bool_data = group_data(arg_data, filter_out_intent="in") check_scalars, check_arrays = "", "" for scalar in scalars: - check_scalars += f" REQUIRE(d_f90.{scalar[0]} == d_cxx.{scalar[0]});\n" + check_scalars += f" REQUIRE(d_baseline.{scalar[0]} == d_test.{scalar[0]});\n" if has_array: c2f_transpose_code = "" if not need_transpose else \ @@ -2363,52 +2515,57 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): all_data[k] = v for _, data in all_data.items(): - check_arrays += f" for (Int k = 0; k < d_f90.total(d_f90.{data[0]}); ++k) {{\n" + check_arrays += f" for (Int k = 0; k < d_baseline.total(d_baseline.{data[0]}); ++k) {{\n" for datum in data: - check_arrays += f" REQUIRE(d_f90.total(d_f90.{data[0]}) == d_cxx.total(d_cxx.{datum}));\n" - check_arrays += f" REQUIRE(d_f90.{datum}[k] == d_cxx.{datum}[k]);\n" + check_arrays += f" REQUIRE(d_baseline.total(d_baseline.{data[0]}) == d_test.total(d_test.{datum}));\n" + check_arrays += f" REQUIRE(d_baseline.{datum}[k] == d_test.{datum}[k]);\n" check_arrays += " }\n" if has_array: result = \ -""" static void run_bfb() +""" void run_bfb() {{ - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - {data_struct} f90_data[] = {{ + // Set up inputs + {data_struct} baseline_data[] = {{ // TODO }}; - static constexpr Int num_runs = sizeof(f90_data) / sizeof({data_struct});{gen_random} + static constexpr Int num_runs = sizeof(baseline_data) / sizeof({data_struct});{gen_random} - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by test. Needs to happen before read calls so that // inout data is in original state - {data_struct} cxx_data[] = {{ + {data_struct} test_data[] = {{ // TODO }}; - // Assume all data is in C layout - - // Get data from fortran - for (auto& d : f90_data) {{ - // expects data in C layout - {sub}(d); + // Read baseline data + if (this->m_baseline_action == COMPARE) {{ + for (auto& d : baseline_data) {{ + d.read(Base::m_fid); + }} }} - // Get data from cxx - for (auto& d : cxx_data) {{{c2f_transpose_code} - {sub}_f({arg_data_args});{f2c_transpose_code} + // Get data from test + for (auto& d : test_data) {{ + {sub}(d); }} // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) {{ + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) {{ for (Int i = 0; i < num_runs; ++i) {{ - {data_struct}& d_f90 = f90_data[i]; - {data_struct}& d_cxx = cxx_data[i]; + {data_struct}& d_baseline = baseline_data[i]; + {data_struct}& d_test = test_data[i]; {check_scalars}{check_arrays} }} }} + else if (this->m_baseline_action == GENERATE) {{ + for (Int i = 0; i < num_runs; ++i) {{ + test_data[i].write(Base::m_fid); + }} + }} }} // run_bfb""".format(data_struct=data_struct, sub=sub, gen_random=gen_random, @@ -2435,7 +2592,7 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): for (Int s = 0, vs = offset; s < Spack::n; ++s, ++vs) {{ {ireal_assigns} }} -""".format(ireals=", ".join(ireals), ireal_assigns="\n ".join(["{0}[s] = cxx_device(vs).{0};".format(ireal) for ireal in ireals])) +""".format(ireals=", ".join(ireals), ireal_assigns="\n ".join(["{0}[s] = test_device(vs).{0};".format(ireal) for ireal in ireals])) spack_output_init = "" if ooreals: @@ -2445,41 +2602,41 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): """ scalars = group_data(arg_data)[4] - func_call = f"Functions::{sub}({', '.join([(scalar if scalar in reals else 'cxx_device(0).{}'.format(scalar)) for scalar, _ in scalars])});" + func_call = f"Functions::{sub}({', '.join([(scalar if scalar in reals else 'test_device(0).{}'.format(scalar)) for scalar, _ in scalars])});" spack_output_to_dview = "" if oreals: spack_output_to_dview = \ -"""// Copy spacks back into cxx_device view +"""// Copy spacks back into test_device view for (Int s = 0, vs = offset; s < Spack::n; ++s, ++vs) {{ {} }} -""".format("\n ".join(["cxx_device(vs).{0} = {0}[s];".format(oreal) for oreal in oreals])) +""".format("\n ".join(["test_device(vs).{0} = {0}[s];".format(oreal) for oreal in oreals])) result = \ -""" static void run_bfb() +""" void run_bfb() {{ - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - {data_struct} f90_data[max_pack_size] = {{ + {data_struct} baseline_data[max_pack_size] = {{ // TODO }}; - static constexpr Int num_runs = sizeof(f90_data) / sizeof({data_struct});{gen_random} + static constexpr Int num_runs = sizeof(baseline_data) / sizeof({data_struct});{gen_random} - // Create copies of data for use by cxx and sync it to device. Needs to happen before fortran calls so that + // Create copies of data for use by test and sync it to device. Needs to happen before read calls so that // inout data is in original state - view_1d<{data_struct}> cxx_device("cxx_device", max_pack_size); - const auto cxx_host = Kokkos::create_mirror_view(cxx_device); - std::copy(&f90_data[0], &f90_data[0] + max_pack_size, cxx_host.data()); - Kokkos::deep_copy(cxx_device, cxx_host); + view_1d<{data_struct}> test_device("test_device", max_pack_size); + const auto test_host = Kokkos::create_mirror_view(test_device); + std::copy(&baseline_data[0], &baseline_data[0] + max_pack_size, test_host.data()); + Kokkos::deep_copy(test_device, test_host); // Get data from fortran - for (auto& d : f90_data) {{ + for (auto& d : baseline_data) {{ {sub}(d); }} - // Get data from cxx. Run {sub} from a kernel and copy results back to host + // Get data from test. Run {sub} from a kernel and copy results back to host Kokkos::parallel_for(num_test_itrs, KOKKOS_LAMBDA(const Int& i) {{ const Int offset = i * Spack::n; @@ -2491,13 +2648,13 @@ def gen_cxx_bfb_unit_impl(self, phys, sub, force_arg_data=None): {spack_output_to_dview} }}); - Kokkos::deep_copy(cxx_host, cxx_device); + Kokkos::deep_copy(test_host, test_device); // Verify BFB results if (SCREAM_BFB_TESTING) {{ for (Int i = 0; i < num_runs; ++i) {{ - {data_struct}& d_f90 = f90_data[i]; - {data_struct}& d_cxx = cxx_host[i]; + {data_struct}& d_baseline = baseline_data[i]; + {data_struct}& d_test = test_host[i]; {check_scalars} }} }} }} // run_bfb""".format(data_struct=data_struct, @@ -2598,7 +2755,7 @@ def gen_piece(self, phys, sub, piece, force_arg_data=None, force_file_lines=None ... "fake_line_after_2", ... ] >>> gb.gen_piece("shoc", "fake_sub", "cxx_c2f_glue_impl", force_arg_data=UT_ARG_DATA, force_file_lines=force_file_lines) - In file shoc_functions_f90.cpp, would replace: + In file tests/infra/shoc_test_data.cpp, would replace: void fake_sub(FakeSubData& d) { // bad line @@ -2622,7 +2779,7 @@ def gen_piece(self, phys, sub, piece, force_arg_data=None, force_file_lines=None ... "fake_line_after_2", ... ] >>> gb.gen_piece("shoc", "fake_sub", "cxx_c2f_glue_impl", force_arg_data=UT_ARG_DATA, force_file_lines=force_file_lines) - In file shoc_functions_f90.cpp, at line 2, would insert: + In file tests/infra/shoc_test_data.cpp, at line 2, would insert: void fake_sub(FakeSubData& d) { shoc_init(d.nlev, true); @@ -2651,7 +2808,7 @@ def gen_piece(self, phys, sub, piece, force_arg_data=None, force_file_lines=None ... "fake_line_after_2", ... ] >>> gb.gen_piece("shoc", "fake_sub", "cxx_c2f_bind_decl", force_arg_data=UT_ARG_DATA, force_file_lines=force_file_lines) - In file shoc_functions_f90.cpp, would replace: + In file tests/infra/shoc_test_data.cpp, would replace: void fake_sub_c(); WITH: @@ -2723,4 +2880,10 @@ def gen_boiler(self): print(f"Warning: failed to generate subroutine {sub} piece {piece} for physics {phys}, error: {e}") all_success = False + print("ALL_SUCCESS" if all_success else "THERE WERE FAILURES") + return all_success + +if __name__ == "__main__": + import doctest + doctest.run_docstring_examples(parse_f90_args, globals()) diff --git a/components/eamxx/scripts/machines_specs.py b/components/eamxx/scripts/machines_specs.py index a167e26e8453..e9d18987e4e9 100644 --- a/components/eamxx/scripts/machines_specs.py +++ b/components/eamxx/scripts/machines_specs.py @@ -107,6 +107,25 @@ def setup_cray(cls,name): cls.c_compiler = "cc" cls.ftn_compiler = "ftn" +############################################################################### +class Aurora(Machine): +############################################################################### + concrete = True + @classmethod + def setup(cls): + super().setup_base("aurora") + + cls.cxx_compiler = "mpicxx" + cls.c_compiler = "mpicc" + cls.ftn_compiler = "mpifort" + + compiler = "oneapi-ifxgpu" + + cls.env_setup = [f"eval $({CIMEROOT}/CIME/Tools/get_case_env -c SMS.ne4pg2_ne4pg2.F2010-SCREAMv1.{cls.name}_{compiler})"] + + cls.batch = "qsub -q debug_scaling -l walltime=01:00:00 -A E3SM_Dec" + cls.num_run_res = 12 # twelve gpus + ############################################################################### class PM(CrayMachine): ############################################################################### @@ -146,6 +165,21 @@ def setup(cls): cls.num_run_res = 4 # four gpus cls.gpu_arch = "cuda" +############################################################################### +class Polaris(CrayMachine): +############################################################################### + concrete = True + @classmethod + def setup(cls): + super().setup_base("polaris") + + compiler = "gnugpu" + + cls.env_setup = [f"eval $({CIMEROOT}/CIME/Tools/get_case_env -c SMS.ne4pg2_ne4pg2.F2010-SCREAMv1.{cls.name}_{compiler})"] + + cls.batch = "qsub -q debug_scaling -l walltime=01:00:00 -A E3SM_RRM" + cls.num_run_res = 4 # four gpus + ############################################################################### class Chrysalis(Machine): ############################################################################### @@ -195,6 +229,25 @@ def setup(cls): cls.num_run_res = 4 # four gpus cls.gpu_arch = "cuda" +############################################################################### +class Lychee(Machine): +############################################################################### + concrete = True + @classmethod + def setup(cls): + super().setup_base("lychee") + + cls.env_setup = ["source /projects/sems/install/rhel9-x86_64/sems/lmod/lmod/8.7.24/gcc/11.4.1/base/lnirq74/lmod/lmod/init/sh", + "module purge", + "module load sems-gcc/12.3.0 sems-cuda/12.6.2 sems-cmake/3.30.5 sems-openmpi/4.1.6 sems-netlib-lapack/3.11.0 sems-netcdf-c/4.9.2 sems-netcdf-fortran/4.6.1 sems-parallel-netcdf/1.12.3", + "export HDF5_USE_FILE_LOCKING=FALSE" + ] + cls.baselines_dir = "/home/projects/e3sm/eamxx/baselines" + #cls.batch = "bsub -I -q rhel8 -n 4 -gpu num=4" + + cls.num_run_res = 4 # four gpus + cls.gpu_arch = "cuda" + ############################################################################### class Compy(Machine): ############################################################################### diff --git a/components/eamxx/scripts/test_all_eamxx.py b/components/eamxx/scripts/test_all_eamxx.py index 1fd656fcdf81..3b3d289c1e33 100644 --- a/components/eamxx/scripts/test_all_eamxx.py +++ b/components/eamxx/scripts/test_all_eamxx.py @@ -496,6 +496,8 @@ def generate_baselines(self, test): expect(test.uses_baselines, f"Something is off. generate_baseline should have not be called for test {test}") + self._machine.setup() + baseline_dir = self.get_test_dir(self._baseline_dir, test) test_dir = self.get_test_dir(self._work_dir, test) if test_dir.exists(): @@ -593,6 +595,8 @@ def generate_all_baselines(self): ############################################################################### def run_test(self, test): ############################################################################### + self._machine.setup() + git_head = get_current_head() print("===============================================================================") diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index 27fc364fc8e7..4b2b114e88ef 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -537,7 +537,6 @@ void AtmosphereDriver::create_fields() // Create FM m_field_mgr = std::make_shared(m_grids_manager); - m_field_mgr->registration_begins(); // Before registering fields, check that Field Requests for tracers are compatible // and store the correct type of turbulence advection for each tracer @@ -1621,9 +1620,11 @@ void AtmosphereDriver::run (const int dt) { EKAT_REQUIRE_MSG (dt>0, "Error! Input time step must be positive.\n"); // Print current timestamp information + auto end_of_step = m_current_ts + dt; m_atm_logger->log(ekat::logger::LogLevel::info, - "Atmosphere step = " + std::to_string(m_current_ts.get_num_steps()) + "\n" + - " model start-of-step time = " + m_current_ts.get_date_string() + " " + m_current_ts.get_time_string() + "\n"); + "Atmosphere step = " + std::to_string(end_of_step.get_num_steps()) + "\n" + + " model beg-of-step timestamp: " + m_current_ts.get_date_string() + " " + m_current_ts.get_time_string() + "\n" + " model end-of-step timestamp: " + end_of_step.get_date_string() + " " + end_of_step.get_time_string() + "\n"); // Reset accum fields to 0 // Note: at the 1st timestep this is redundant, since we did it at init, diff --git a/components/eamxx/src/diagnostics/CMakeLists.txt b/components/eamxx/src/diagnostics/CMakeLists.txt index 0795f9e54694..8d722ffd2f0b 100644 --- a/components/eamxx/src/diagnostics/CMakeLists.txt +++ b/components/eamxx/src/diagnostics/CMakeLists.txt @@ -22,6 +22,8 @@ set(DIAGNOSTIC_SRCS virtual_temperature.cpp water_path.cpp wind_speed.cpp + vert_contract.cpp + zonal_avg.cpp ) add_library(diagnostics ${DIAGNOSTIC_SRCS}) diff --git a/components/eamxx/src/diagnostics/aodvis.cpp b/components/eamxx/src/diagnostics/aodvis.cpp index 00deb828d23e..242b810a1ea5 100644 --- a/components/eamxx/src/diagnostics/aodvis.cpp +++ b/components/eamxx/src/diagnostics/aodvis.cpp @@ -36,6 +36,29 @@ set_grids(const std::shared_ptr grids_manager) FieldIdentifier fid(name(), scalar2d, nondim, grid_name); m_diagnostic_output = Field(fid); m_diagnostic_output.allocate_view(); + +} + +void AODVis::initialize_impl(const RunType /*run_type*/) { + // we use initialize_impl to primarily deal with the mask + using namespace ekat::units; + using namespace ShortFieldTagsNames; + + auto nondim = ekat::units::Units::nondimensional(); + const auto &grid_name = + m_diagnostic_output.get_header().get_identifier().get_grid_name(); + const auto var_fill_value = constants::DefaultFillValue().value; + + m_mask_val = m_params.get("mask_value", var_fill_value); + + std::string mask_name = name() + " mask"; + FieldLayout mask_layout({COL}, {m_ncols}); + FieldIdentifier mask_fid(mask_name, mask_layout, nondim, grid_name); + Field diag_mask(mask_fid); + diag_mask.allocate_view(); + + m_diagnostic_output.get_header().set_extra_data("mask_data", diag_mask); + m_diagnostic_output.get_header().set_extra_data("mask_value", m_mask_val); } void AODVis::compute_diagnostic_impl() { @@ -43,24 +66,28 @@ void AODVis::compute_diagnostic_impl() { using MT = typename KT::MemberType; using ESU = ekat::ExeSpaceUtils; - Real var_fill_value = constants::DefaultFillValue().value; - const auto aod = m_diagnostic_output.get_view(); + const auto mask = m_diagnostic_output.get_header() + .get_extra_data("mask_data") + .get_view(); const auto tau_vis = get_field_in("aero_tau_sw") .subfield(1, m_vis_bnd) .get_view(); const auto sunlit = get_field_in("sunlit").get_view(); const auto num_levs = m_nlevs; + const auto var_fill_value = m_mask_val; const auto policy = ESU::get_default_team_policy(m_ncols, m_nlevs); Kokkos::parallel_for( "Compute " + m_diagnostic_output.name(), policy, KOKKOS_LAMBDA(const MT &team) { const int icol = team.league_rank(); if(sunlit(icol) == 0.0) { aod(icol) = var_fill_value; + Kokkos::single(Kokkos::PerTeam(team), [&] { mask(icol) = 0; }); } else { auto tau_icol = ekat::subview(tau_vis, icol); aod(icol) = ESU::view_reduction(team, 0, num_levs, tau_icol); + Kokkos::single(Kokkos::PerTeam(team), [&] { mask(icol) = 1; }); } }); } diff --git a/components/eamxx/src/diagnostics/aodvis.hpp b/components/eamxx/src/diagnostics/aodvis.hpp index 73f180bf33b0..d366d0ed6376 100644 --- a/components/eamxx/src/diagnostics/aodvis.hpp +++ b/components/eamxx/src/diagnostics/aodvis.hpp @@ -22,6 +22,9 @@ class AODVis : public AtmosphereDiagnostic { void set_grids( const std::shared_ptr grids_manager) override; + void initialize_impl( + const RunType /*run_type*/) override; + protected: #ifdef KOKKOS_ENABLE_CUDA public: @@ -33,6 +36,8 @@ class AODVis : public AtmosphereDiagnostic { int m_swbands = eamxx_swbands(); int m_vis_bnd = eamxx_vis_swband_idx(); + + Real m_mask_val; }; } // namespace scream diff --git a/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp b/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp index 20c1d0668ca9..ebdbea9cf3c6 100644 --- a/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp +++ b/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp @@ -63,27 +63,29 @@ void PrecipSurfMassFlux::compute_diagnostic_impl() const auto use_liq = m_type & s_liq; const auto use_ice = m_type & s_ice; - std::int64_t dt; + double dt = 0; if (use_ice) { auto mass_ice = get_field_in("precip_ice_surf_mass"); mass_ice_d = mass_ice.get_view(); const auto& t_start = mass_ice.get_header().get_tracking().get_accum_start_time (); const auto& t_now = mass_ice.get_header().get_tracking().get_time_stamp (); - dt = t_now-t_start; - } - if (use_liq) { + dt = t_now.seconds_from(t_start); + if (use_liq) { + // Ensure liq/ice have same accumulation times + auto mass_liq = get_field_in("precip_liq_surf_mass"); + mass_liq_d = mass_liq.get_view(); + EKAT_REQUIRE_MSG (t_now==mass_liq.get_header().get_tracking().get_time_stamp() and + t_start==mass_liq.get_header().get_tracking().get_accum_start_time(), + "Error! Liquid and ice precip mass fields have different accumulation time stamps!\n"); + } + } else if (use_liq) { auto mass_liq = get_field_in("precip_liq_surf_mass"); mass_liq_d = mass_liq.get_view(); const auto& t_start = mass_liq.get_header().get_tracking().get_accum_start_time (); const auto& t_now = mass_liq.get_header().get_tracking().get_time_stamp (); - if (use_ice) { - EKAT_REQUIRE_MSG (dt==(t_now-t_start), - "Error! Liquid and ice precip mass fields have different accumulation time stamps!\n"); - } else { - dt = t_now-t_start; - } + dt = t_now.seconds_from(t_start); } if (dt==0) { diff --git a/components/eamxx/src/diagnostics/register_diagnostics.hpp b/components/eamxx/src/diagnostics/register_diagnostics.hpp index 67119416705d..67298fda51cb 100644 --- a/components/eamxx/src/diagnostics/register_diagnostics.hpp +++ b/components/eamxx/src/diagnostics/register_diagnostics.hpp @@ -25,6 +25,8 @@ #include "diagnostics/aerocom_cld.hpp" #include "diagnostics/atm_backtend.hpp" #include "diagnostics/horiz_avg.hpp" +#include "diagnostics/vert_contract.hpp" +#include "diagnostics/zonal_avg.hpp" namespace scream { @@ -53,6 +55,8 @@ inline void register_diagnostics () { diag_factory.register_product("AeroComCld",&create_atmosphere_diagnostic); diag_factory.register_product("AtmBackTendDiag",&create_atmosphere_diagnostic); diag_factory.register_product("HorizAvgDiag",&create_atmosphere_diagnostic); + diag_factory.register_product("VertContractDiag",&create_atmosphere_diagnostic); + diag_factory.register_product("ZonalAvgDiag",&create_atmosphere_diagnostic); } } // namespace scream diff --git a/components/eamxx/src/diagnostics/tests/CMakeLists.txt b/components/eamxx/src/diagnostics/tests/CMakeLists.txt index 736253f9bee7..9eca934e0da4 100644 --- a/components/eamxx/src/diagnostics/tests/CMakeLists.txt +++ b/components/eamxx/src/diagnostics/tests/CMakeLists.txt @@ -74,3 +74,9 @@ CreateDiagTest(atm_backtend "atm_backtend_test.cpp") # Test horizontal averaging CreateDiagTest(horiz_avg "horiz_avg_test.cpp") + +# Test for vertical contraction +CreateDiagTest(vert_contract "vert_contract_test.cpp") + +# Test zonal averaging +CreateDiagTest(zonal_avg "zonal_avg_test.cpp" MPI_RANKS 1 ${SCREAM_TEST_MAX_RANKS}) diff --git a/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp b/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp index 4a816558ac45..e5c491774a25 100644 --- a/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp +++ b/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp @@ -168,7 +168,6 @@ std::shared_ptr get_test_fm(std::shared_ptr gr // Register fields with fm // Make sure packsize isn't bigger than the packsize for this machine, but not so big that we end up with only 1 pack. - fm->registration_begins(); fm->register_field(FR{fid1,Pack::n}); fm->register_field(FR{fid2,Pack::n}); fm->register_field(FR{fid3,Pack::n}); diff --git a/components/eamxx/src/diagnostics/tests/precip_surf_mass_flux_tests.cpp b/components/eamxx/src/diagnostics/tests/precip_surf_mass_flux_tests.cpp index c6dc2a2eab75..0062aad8036f 100644 --- a/components/eamxx/src/diagnostics/tests/precip_surf_mass_flux_tests.cpp +++ b/components/eamxx/src/diagnostics/tests/precip_surf_mass_flux_tests.cpp @@ -48,7 +48,7 @@ void run(std::mt19937_64& engine) auto gm = create_gm(comm,ncols); // Create timestep - const int dt=1800; + const double dt=1800; // Construct random input data using RPDF = std::uniform_real_distribution; @@ -120,28 +120,29 @@ void run(std::mt19937_64& engine) diag_liq->compute_diagnostic(); diag_ice->compute_diagnostic(); - Field preicp_total_f = diag_total->get_diagnostic().clone(); - Field preicp_liq_f = diag_liq->get_diagnostic().clone(); - Field preicp_ice_f = diag_ice->get_diagnostic().clone(); - preicp_total_f.deep_copy(0); - preicp_liq_f.deep_copy(0); - preicp_ice_f.deep_copy(0); - auto precip_total_v = preicp_total_f.get_view(); - auto precip_liq_v = preicp_liq_f.get_view(); - auto precip_ice_v = preicp_ice_f.get_view(); + Field precip_total_f = diag_total->get_diagnostic().clone(); + Field precip_liq_f = diag_liq->get_diagnostic().clone(); + Field precip_ice_f = diag_ice->get_diagnostic().clone(); + precip_total_f.deep_copy(0); + precip_liq_f.deep_copy(0); + precip_ice_f.deep_copy(0); + auto precip_total_v = precip_total_f.get_view(); + auto precip_liq_v = precip_liq_f.get_view(); + auto precip_ice_v = precip_ice_f.get_view(); const auto rhodt = PC::RHO_H2O*dt; Kokkos::parallel_for("precip_total_surf_mass_flux_test", typename KT::RangePolicy(0,ncols), KOKKOS_LAMBDA(const int& icol) { precip_liq_v(icol) = precip_liq_surf_mass_v(icol)/rhodt; precip_ice_v(icol) = precip_ice_surf_mass_v(icol)/rhodt; - precip_total_v(icol) = precip_liq_v(icol) + precip_ice_v(icol); + precip_total_v(icol) = precip_ice_v(icol); + precip_total_v(icol) += precip_liq_surf_mass_v(icol)/rhodt; }); Kokkos::fence(); - REQUIRE(views_are_equal(diag_total->get_diagnostic(),preicp_total_f)); - REQUIRE(views_are_equal(diag_liq->get_diagnostic(),preicp_liq_f)); - REQUIRE(views_are_equal(diag_ice->get_diagnostic(),preicp_ice_f)); + REQUIRE(views_are_equal(diag_total->get_diagnostic(),precip_total_f)); + REQUIRE(views_are_equal(diag_liq->get_diagnostic(),precip_liq_f)); + REQUIRE(views_are_equal(diag_ice->get_diagnostic(),precip_ice_f)); // Finalize the diagnostic diag_total->finalize(); diff --git a/components/eamxx/src/diagnostics/tests/vert_contract_test.cpp b/components/eamxx/src/diagnostics/tests/vert_contract_test.cpp new file mode 100644 index 000000000000..886df3eaf045 --- /dev/null +++ b/components/eamxx/src/diagnostics/tests/vert_contract_test.cpp @@ -0,0 +1,303 @@ +#include "catch2/catch.hpp" +#include "diagnostics/register_diagnostics.hpp" +#include "physics/share/physics_constants.hpp" +#include "share/field/field_utils.hpp" +#include "share/grid/mesh_free_grids_manager.hpp" +#include "share/util/eamxx_setup_random_test.hpp" +#include "share/util/eamxx_universal_constants.hpp" + +namespace scream { + +std::shared_ptr create_gm(const ekat::Comm &comm, const int ncols, + const int nlevs) { + const int num_global_cols = ncols * comm.size(); + + using vos_t = std::vector; + ekat::ParameterList gm_params; + gm_params.set("grids_names", vos_t{"Point Grid"}); + auto &pl = gm_params.sublist("Point Grid"); + pl.set("type", "point_grid"); + pl.set("aliases", vos_t{"Physics"}); + pl.set("number_of_global_columns", num_global_cols); + pl.set("number_of_vertical_levels", nlevs); + + auto gm = create_mesh_free_grids_manager(comm, gm_params); + gm->build_grids(); + + return gm; +} + +TEST_CASE("vert_contract") { + using namespace ShortFieldTagsNames; + using namespace ekat::units; + + // A world comm + ekat::Comm comm(MPI_COMM_WORLD); + + // A time stamp + util::TimeStamp t0({2024, 1, 1}, {0, 0, 0}); + + // Create a grids manager - single column for these tests + constexpr int nlevs = 30; + constexpr int dim3 = 5; + const int ngcols = 95 * comm.size(); + + auto gm = create_gm(comm, ngcols, nlevs); + auto grid = gm->get_grid("Physics"); + + // Input (randomized) qc + FieldLayout scalar1d_layout{{LEV}, {nlevs}}; + FieldLayout scalar2d_layout{{COL, LEV}, {ngcols, nlevs}}; + FieldLayout scalar3d_layout{{COL, CMP, LEV}, {ngcols, dim3, nlevs}}; + + FieldIdentifier fin2_fid("qc", scalar2d_layout, kg / kg, grid->name()); + FieldIdentifier fin3_fid("qc", scalar3d_layout, kg / kg, grid->name()); + FieldIdentifier dp_fid("pseudo_density", scalar2d_layout, Pa, grid->name()); + FieldIdentifier dz_fid("dz", scalar2d_layout, m, grid->name()); + + Field fin2(fin2_fid); + Field fin3(fin3_fid); + Field dp(dp_fid); + // Field dz(dz_fid); + + fin2.allocate_view(); + fin3.allocate_view(); + dp.allocate_view(); + // dz.allocate_view(); + + // Construct random number generator stuff + using RPDF = std::uniform_real_distribution; + RPDF pdf(sp(0.0), sp(200.0)); + auto engine = scream::setup_random_test(); + + // Construct the diagnostics factory + std::map> diags; + auto &diag_factory = AtmosphereDiagnosticFactory::instance(); + register_diagnostics(); + + ekat::ParameterList params; + // instantiation works because we don't do anything in the constructor + auto bad_diag = diag_factory.create("VertContractDiag", comm, params); + SECTION("bad_diag") { + // this will throw because no field_name was provided + REQUIRE_THROWS(bad_diag->set_grids(gm)); + } + + fin2.get_header().get_tracking().update_time_stamp(t0); + fin3.get_header().get_tracking().update_time_stamp(t0); + dp.get_header().get_tracking().update_time_stamp(t0); + // dz.get_header().get_tracking().update_time_stamp(t0); + randomize(fin2, engine, pdf); + randomize(fin3, engine, pdf); + randomize(dp, engine, pdf); + // randomize(dz, engine, pdf); + + // Create and set up the diagnostic + params.set("grid_name", grid->name()); + params.set("field_name", "qc"); + SECTION("bad_diag_2") { + // this will throw because no contract_method was provided + auto bad_diag_2 = diag_factory.create("VertContractDiag", comm, params); + REQUIRE_THROWS(bad_diag_2->set_grids(gm)); + } + + SECTION("bad_diag_3") { + // this will throw because bad contract_method was provided + params.set("contract_method", "xyz"); + auto bad_diag_3 = diag_factory.create("VertContractDiag", comm, params); + REQUIRE_THROWS(bad_diag_3->set_grids(gm)); + } + + // dp_weighted_avg + params.set("contract_method", "avg"); + params.set("weighting_method", "dp"); + auto dp_weighted_avg = diag_factory.create("VertContractDiag", comm, params); + + // dp_weighted_sum + params.set("contract_method", "sum"); + params.set("weighting_method", "dp"); + auto dp_weighted_sum = diag_factory.create("VertContractDiag", comm, params); + + // TODO: for some reason the dz field keeps getting set to 0 + // TODO: as a workaround, just calculate dz here (sigh...) + // TODO: commenting out all the dz stuff for now + // // dz_weighted_avg + // params.set("contract_method", "avg"); + // params.set("weighting_method", "dz"); + // auto dz_weighted_avg = diag_factory.create("VertContractDiag", comm, params); + + // // dz_weighted_sum + // params.set("contract_method", "sum"); + // params.set("weighting_method", "dz"); + // auto dz_weighted_sum = diag_factory.create("VertContractDiag", comm, params); + + // unweighted_sum + params.set("contract_method", "sum"); + params.set("weighting_method", "none"); + auto unweighted_sum = diag_factory.create("VertContractDiag", comm, params); + + // unweighted_avg + params.set("contract_method", "avg"); + params.set("weighting_method", "none"); + auto unweighted_avg = diag_factory.create("VertContractDiag", comm, params); + + dp_weighted_avg->set_grids(gm); + dp_weighted_sum->set_grids(gm); + // dz_weighted_sum->set_grids(gm); + // dz_weighted_avg->set_grids(gm); + unweighted_sum->set_grids(gm); + unweighted_avg->set_grids(gm); + + // Fields for manual calculation + FieldIdentifier diag1_fid("qc_vert_contract_manual", scalar2d_layout.clone().strip_dim(LEV), kg / kg, grid->name()); + FieldIdentifier diag2_fid("qc_vert_contract_manual", scalar3d_layout.clone().strip_dim(LEV), kg / kg, grid->name()); + Field diag1_m(diag1_fid); + Field diag2_m(diag2_fid); + diag1_m.allocate_view(); + diag2_m.allocate_view(); + + // Fields for scaling + FieldIdentifier dps_fid ("dps", scalar2d_layout.clone().strip_dim(LEV), Pa, grid->name()); + // FieldIdentifier dzs_fid ("dzs", scalar2d_layout.clone().strip_dim(LEV), m, grid->name()); + Field dps(dps_fid); + // Field dzs(dzs_fid); + dps.allocate_view(); + // dzs.allocate_view(); + + auto dp_ones = dp.clone("dp_ones"); + dp_ones.deep_copy(1); + // auto dz_ones = dz.clone("dz_ones"); + // dz_ones.deep_copy(1); + + auto dp_scaled = dp.clone("dp_scaled"); + // auto dz_scaled = dz.clone("dz_scaled"); + + dp_scaled.scale(sp(1.0) / scream::physics::Constants::gravit); + + vert_contraction(dps, dp_scaled, dp_ones); + // vert_contraction(dzs, dz_scaled, dz_ones); + + SECTION("dp_weighted_avg") { + // scale dp_scaled by 1/dps (because we are averaging) + dps.sync_to_host(); + auto dps_v = dps.get_view(); + dp_scaled.sync_to_host(); + auto dp_scaled_v = dp_scaled.get_view(); + for (std::size_t i = 0; i < dp_scaled_v.extent(0); ++i) { + for (std::size_t j = 0; j < dp_scaled_v.extent(1); ++j) { + if(dps_v(i) == 0) { + dp_scaled_v(i, j) = 0; // Handle division by zero by setting to 0 + } else { + dp_scaled_v(i, j) /= dps_v(i); + } + } + } + dp_scaled.sync_to_dev(); + + // calculate weighted avg directly + vert_contraction(diag1_m, fin2, dp_scaled); + + // Calculate weighted avg through diagnostics + dp_weighted_avg->set_required_field(fin2); + dp_weighted_avg->set_required_field(dp); + dp_weighted_avg->initialize(t0, RunType::Initial); + dp_weighted_avg->compute_diagnostic(); + auto dp_weighted_avg_f = dp_weighted_avg->get_diagnostic(); + + REQUIRE(views_are_equal(dp_weighted_avg_f, diag1_m)); + } + + SECTION("dp_weighted_sum") { + // calculate weighted sum directly + vert_contraction(diag2_m, fin3, dp_scaled); + // Calculate weighted sum through diagnostics + dp_weighted_sum->set_required_field(fin3); + dp_weighted_sum->set_required_field(dp); + dp_weighted_sum->initialize(t0, RunType::Initial); + dp_weighted_sum->compute_diagnostic(); + auto dp_weighted_sum_f = dp_weighted_sum->get_diagnostic(); + + REQUIRE(views_are_equal(dp_weighted_sum_f, diag2_m)); + } + + // SECTION("dz_weighted_avg") { + // // scale dz_scaled by 1/dzs (because we are averaging) + // dzs.sync_to_host(); + // auto dzs_v = dzs.get_view(); + // dz_scaled.sync_to_host(); + // auto dz_scaled_v = dz_scaled.get_view(); + // for (std::size_t i = 0; i < dz_scaled_v.extent(0); ++i) { + // for (std::size_t j = 0; j < dz_scaled_v.extent(1); ++j) { + // if(dzs_v(i) == 0) { + // dz_scaled_v(i, j) = 0; // Handle division by zero by setting to 0 + // } else { + // dz_scaled_v(i, j) /= dzs_v(i); + // } + // } + // } + // dz_scaled.sync_to_dev(); + + // // calculate weighted avg directly + // vert_contraction(diag1_m, fin2, dz_scaled); + + // // Calculate weighted avg through diagnostics + // dz_weighted_avg->set_required_field(fin2); + // dz_weighted_avg->set_required_field(dz); + // dz_weighted_avg->initialize(t0, RunType::Initial); + // dz_weighted_avg->compute_diagnostic(); + // auto dz_weighted_avg_f = dz_weighted_avg->get_diagnostic(); + + // REQUIRE(views_are_equal(dz_weighted_avg_f, diag1_m)); + // } + + // SECTION("dz_weighted_sum") { + // // calculate weighted sum directly + // vert_contraction(diag2_m, fin3, dz_scaled); + // // Calculate weighted sum through diagnostics + // dz_weighted_sum->set_required_field(fin3); + // dz_weighted_sum->set_required_field(dz); + // dz_weighted_sum->initialize(t0, RunType::Initial); + // dz_weighted_sum->compute_diagnostic(); + // auto dz_weighted_sum_f = dz_weighted_sum->get_diagnostic(); + + // REQUIRE(views_are_equal(dz_weighted_sum_f, diag2_m)); + // } + + SECTION("unweighted_sum") { + // calculate unweighted sum directly + vert_contraction(diag1_m, fin2, dp_ones); + + // Calculate unweighted sum through diagnostics + unweighted_sum->set_required_field(fin2); + unweighted_sum->initialize(t0, RunType::Initial); + unweighted_sum->compute_diagnostic(); + auto unweighted_sum_f = unweighted_sum->get_diagnostic(); + + REQUIRE(views_are_equal(unweighted_sum_f, diag1_m)); + } + + SECTION("unweighted_avg") { + // since we are averaging, we need to scale by the sum + auto dp_ones_scaled = dp_ones.clone("dz_ones_scaled"); + dp_ones_scaled.sync_to_host(); + auto dp_ones_scaled_v = dp_ones_scaled.get_view(); + for (std::size_t i = 0; i < dp_ones_scaled_v.extent(0); ++i) { + for (std::size_t j = 0; j < dp_ones_scaled_v.extent(1); ++j) { + const int nlevs = dp_ones_scaled_v.extent(1); + dp_ones_scaled_v(i, j) /= nlevs; + } + } + dp_ones_scaled.sync_to_dev(); + // calculate unweighted avg directly + vert_contraction(diag2_m, fin3, dp_ones_scaled); + // Calculate unweighted avg through diagnostics + unweighted_avg->set_required_field(fin3); + unweighted_avg->initialize(t0, RunType::Initial); + unweighted_avg->compute_diagnostic(); + auto unweighted_avg_f = unweighted_avg->get_diagnostic(); + + REQUIRE(views_are_equal(unweighted_avg_f, diag2_m)); + } +} + +} // namespace scream diff --git a/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp b/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp index 56e9df9debd2..a33f9f2cddb0 100644 --- a/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp +++ b/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp @@ -134,10 +134,10 @@ void run (const std::string& diag_name, const std::string& location) // If interface, check value, otherwise perform int->mid averaging and check value auto int_val = prev_int_val + delta; if (location=="interfaces") { - REQUIRE_THAT(d_h(icol,ilev), Catch::Matchers::WithinRel(int_val,1e-5)); + REQUIRE_THAT(d_h(icol,ilev), Catch::Matchers::WithinRel(int_val,Real(1e-5))); } else { auto mid_val = (int_val + prev_int_val) / 2; - REQUIRE_THAT(d_h(icol,ilev), Catch::Matchers::WithinRel(mid_val,1e-5)); + REQUIRE_THAT(d_h(icol,ilev), Catch::Matchers::WithinRel(mid_val,Real(1e-5))); } prev_int_val = int_val; } diff --git a/components/eamxx/src/diagnostics/tests/zonal_avg_test.cpp b/components/eamxx/src/diagnostics/tests/zonal_avg_test.cpp new file mode 100644 index 000000000000..3e2150a65bfc --- /dev/null +++ b/components/eamxx/src/diagnostics/tests/zonal_avg_test.cpp @@ -0,0 +1,197 @@ +#include "catch2/catch.hpp" +#include "diagnostics/register_diagnostics.hpp" +#include "share/field/field_utils.hpp" +#include "share/grid/mesh_free_grids_manager.hpp" +#include "share/util/eamxx_setup_random_test.hpp" +#include "share/util/eamxx_universal_constants.hpp" + +namespace scream { + +std::shared_ptr create_gm(const ekat::Comm &comm, const int ncols, const int nlevs) { + const int num_global_cols = ncols * comm.size(); + + using vos_t = std::vector; + ekat::ParameterList gm_params; + gm_params.set("grids_names", vos_t{"Point Grid"}); + auto &pl = gm_params.sublist("Point Grid"); + pl.set("type", "point_grid"); + pl.set("aliases", vos_t{"Physics"}); + pl.set("number_of_global_columns", num_global_cols); + pl.set("number_of_vertical_levels", nlevs); + + auto gm = create_mesh_free_grids_manager(comm, gm_params); + gm->build_grids(); + + return gm; +} + +TEST_CASE("zonal_avg") { + using namespace ShortFieldTagsNames; + using namespace ekat::units; + + // A numerical tolerance + auto tol = std::numeric_limits::epsilon() * 100; + + // A world comm + ekat::Comm comm(MPI_COMM_WORLD); + + // A time stamp + util::TimeStamp t0({2024, 1, 1}, {0, 0, 0}); + + // Create a grids manager - single column for these tests + constexpr int nlevs = 3; + constexpr int dim3 = 4; + const int ngcols = 6 * comm.size(); + const int nlats = 4; + + auto gm = create_gm(comm, ngcols, nlevs); + auto grid = gm->get_grid("Physics"); + + Field area = grid->get_geometry_data("area"); + auto area_view_h = area.get_view(); + + // Set latitude values + Field lat = gm->get_grid_nonconst("Physics")->create_geometry_data( + "lat", grid->get_2d_scalar_layout(), Units::nondimensional()); + auto lat_view_h = lat.get_view(); + const Real lat_delta = sp(180.0) / nlats; + std::vector zonal_areas(nlats, 0.0); + for (int i = 0; i < ngcols; i++) { + lat_view_h(i) = sp(-90.0) + (i % nlats + sp(0.5)) * lat_delta; + zonal_areas[i % nlats] += area_view_h[i]; + } + lat.sync_to_dev(); + + // Input (randomized) qc + FieldLayout scalar1d_layout{{COL}, {ngcols}}; + FieldLayout scalar2d_layout{{COL, LEV}, {ngcols, nlevs}}; + FieldLayout scalar3d_layout{{COL, CMP, LEV}, {ngcols, dim3, nlevs}}; + + FieldIdentifier qc1_id("qc", scalar1d_layout, kg / kg, grid->name()); + FieldIdentifier qc2_fid("qc", scalar2d_layout, kg / kg, grid->name()); + FieldIdentifier qc3_fid("qc", scalar3d_layout, kg / kg, grid->name()); + + Field qc1(qc1_id); + Field qc2(qc2_fid); + Field qc3(qc3_fid); + + qc1.allocate_view(); + qc2.allocate_view(); + qc3.allocate_view(); + + // Construct random number generator stuff + using RPDF = std::uniform_real_distribution; + RPDF pdf(sp(0.0), sp(200.0)); + auto engine = scream::setup_random_test(); + + // Set time for qc and randomize its values + qc1.get_header().get_tracking().update_time_stamp(t0); + qc2.get_header().get_tracking().update_time_stamp(t0); + qc3.get_header().get_tracking().update_time_stamp(t0); + randomize(qc1, engine, pdf); + randomize(qc2, engine, pdf); + randomize(qc3, engine, pdf); + + // Construct the Diagnostics + std::map> diags; + auto &diag_factory = AtmosphereDiagnosticFactory::instance(); + register_diagnostics(); + + // Create and set up the diagnostic + ekat::ParameterList params; + REQUIRE_THROWS(diag_factory.create("ZonalAvgDiag", comm, + params)); // Bad construction + + params.set("grid_name", grid->name()); + REQUIRE_THROWS(diag_factory.create("ZonalAvgDiag", comm, + params)); // Still no field_name + + params.set("field_name", "qc"); + REQUIRE_THROWS(diag_factory.create("ZonalAvgDiag", comm, + params)); // Still no number_of_zonal_bins + + params.set("number_of_zonal_bins", std::to_string(nlats)); + // Now we should be good to go... + auto diag1 = diag_factory.create("ZonalAvgDiag", comm, params); + auto diag2 = diag_factory.create("ZonalAvgDiag", comm, params); + auto diag3 = diag_factory.create("ZonalAvgDiag", comm, params); + diag1->set_grids(gm); + diag2->set_grids(gm); + diag3->set_grids(gm); + + // Test the zonal average of qc1 + diag1->set_required_field(qc1); + diag1->initialize(t0, RunType::Initial); + diag1->compute_diagnostic(); + auto diag1_field = diag1->get_diagnostic(); + + // Manual calculation + const std::string bin_dim_name = diag1_field.get_header().get_identifier().get_layout().name(0); + FieldLayout diag0_layout({CMP}, {nlats}, {bin_dim_name}); + FieldIdentifier diag0_id("qc_zonal_avg_manual", diag0_layout, kg / kg, grid->name()); + Field diag0_field(diag0_id); + diag0_field.allocate_view(); + + // calculate the zonal average + auto qc1_view_h = qc1.get_view(); + auto diag0_view_h = diag0_field.get_view(); + for (int i = 0; i < ngcols; i++) { + const int nlat = i % nlats; + diag0_view_h(nlat) += area_view_h(i) / zonal_areas[nlat] * qc1_view_h(i); + } + diag0_field.sync_to_dev(); + + // Compare + REQUIRE(views_are_equal(diag1_field, diag0_field)); + + // Try other known cases + // Set qc1_v to 1.0 to get zonal averages of 1.0/nlats + const Real zavg1 = sp(1.0); + qc1.deep_copy(zavg1); + diag1->compute_diagnostic(); + auto diag1_view_host = diag1_field.get_view(); + for (int nlat = 0; nlat < nlats; nlat++) { + REQUIRE_THAT(diag1_view_host(nlat), Catch::Matchers::WithinRel(zavg1, tol)); + } + + // other diags + // Set qc2_v to 5.0 to get weighted average of 5.0 + const Real zavg2 = sp(5.0); + qc2.deep_copy(zavg2); + diag2->set_required_field(qc2); + diag2->initialize(t0, RunType::Initial); + diag2->compute_diagnostic(); + auto diag2_field = diag2->get_diagnostic(); + + auto diag2_view_host = diag2_field.get_view(); + for (int i = 0; i < nlevs; ++i) { + for (int nlat = 0; nlat < nlats; nlat++) { + REQUIRE_THAT(diag2_view_host(nlat, i), Catch::Matchers::WithinRel(zavg2, tol)); + } + } + + // Try a random case with qc3 + FieldLayout diag3m_layout({CMP, CMP, LEV}, {nlats, dim3, nlevs}, + {bin_dim_name, e2str(CMP), e2str(LEV)}); + FieldIdentifier diag3m_id("qc_zonal_avg_manual", diag3m_layout, kg / kg, grid->name()); + Field diag3m_field(diag3m_id); + diag3m_field.allocate_view(); + auto qc3_view_h = qc3.get_view(); + auto diag3m_view_h = diag3m_field.get_view(); + for (int i = 0; i < ngcols; i++) { + const int nlat = i % nlats; + for (int j = 0; j < dim3; j++) { + for (int k = 0; k < nlevs; k++) { + diag3m_view_h(nlat, j, k) += area_view_h(i) / zonal_areas[nlat] * qc3_view_h(i, j, k); + } + } + } + diag3m_field.sync_to_dev(); + diag3->set_required_field(qc3); + diag3->initialize(t0, RunType::Initial); + diag3->compute_diagnostic(); + auto diag3_field = diag3->get_diagnostic(); + REQUIRE(views_are_equal(diag3_field, diag3m_field)); +} + +} // namespace scream diff --git a/components/eamxx/src/diagnostics/vert_contract.cpp b/components/eamxx/src/diagnostics/vert_contract.cpp new file mode 100644 index 000000000000..aa6c316793ea --- /dev/null +++ b/components/eamxx/src/diagnostics/vert_contract.cpp @@ -0,0 +1,193 @@ +#include "diagnostics/vert_contract.hpp" + +#include "physics/share/physics_constants.hpp" +#include "share/field/field_utils.hpp" +#include "share/util/eamxx_common_physics_functions.hpp" + +namespace scream { + +VertContractDiag::VertContractDiag(const ekat::Comm &comm, + const ekat::ParameterList ¶ms) + : AtmosphereDiagnostic(comm, params) {} + +void VertContractDiag::set_grids( + const std::shared_ptr grids_manager) { + using namespace ShortFieldTagsNames; + using namespace ekat::units; + + const auto &fn = m_params.get("field_name"); + const auto &gn = m_params.get("grid_name"); + const auto g = grids_manager->get_grid(gn); + + add_field(fn, gn); + + // we support either sum or avg + m_contract_method = m_params.get("contract_method"); + EKAT_REQUIRE_MSG( + m_contract_method == "avg" || m_contract_method == "sum", + "Error! VertContractDiag only supports 'avg' or 'sum' as contract_method.\n" + " - contract_method: " + m_contract_method + "\n"); + // we support either dp or dz weighting, or no weighting at all (none) + m_weighting_method = m_params.get("weighting_method", "none"); + EKAT_REQUIRE_MSG( + m_weighting_method == "dp" || m_weighting_method == "dz" || m_weighting_method == "none", + "Error! VertContractDiag only supports 'dp' or 'dz' or 'none' as weighting_method.\n" + " - weighting_method: " + m_weighting_method + "\n"); + m_diag_name = fn + m_contract_method + "_" + m_weighting_method; + + auto scalar3d = g->get_3d_scalar_layout(true); + if (m_weighting_method == "dp") { + add_field("pseudo_density", scalar3d, Pa, gn); + } else if (m_weighting_method == "dz") { + // TODO: for some reason the dz field keeps getting set to 0 + // TODO: as a workaround, just calculate dz here (sigh...) + // add_field("dz", scalar3d, m, gn); + add_field("pseudo_density", scalar3d, Pa, gn); + add_field("qv", scalar3d, kg / kg, gn); + add_field("p_mid", scalar3d, Pa, gn); + add_field("T_mid", scalar3d, K, gn); + + } +} + +void VertContractDiag::initialize_impl(const RunType /*run_type*/) { + using namespace ShortFieldTagsNames; + using namespace ekat::units; + + const auto &f = get_fields_in().front(); + const auto &fid = f.get_header().get_identifier(); + const auto &layout = fid.get_layout(); + + EKAT_REQUIRE_MSG(layout.rank() >= 1 && layout.rank() <= 3, + "Error! Field rank not supported by VertContractDiag.\n" + " - field name: " + fid.name() + "\n" + " - field layout: " + layout.to_string() + "\n"); + EKAT_REQUIRE_MSG(layout.tags().back() == LEV, + "Error! VertContractDiag diagnostic expects a layout ending " + "with the 'LEV' tag.\n" + " - field name : " + fid.name() + "\n" + " - field layout: " + layout.to_string() + "\n"); + + ekat::units::Units diag_units = fid.get_units(); + + // set up the weighting fields + if (m_weighting_method == "dp") { + m_weighting = get_field_in("pseudo_density").clone("vert_contract_wts"); + } else if (m_weighting_method == "dz") { + // TODO: for some reason the dz field keeps getting set to 0 + // TODO: as a workaround, just calculate dz here (sigh...) + // m_weighting = get_field_in("dz").clone("vert_contract_wts"); + m_weighting = get_field_in("pseudo_density").clone("vert_contract_wts"); + } else { + // no weighting needed, so we set it to 1 with layout of (col, lev) + FieldLayout layout_wts = {{COL, LEV}, {layout.dim(COL), layout.dim(LEV)}}; + FieldIdentifier f_id("vert_contract_wts", layout_wts, ekat::units::Units::nondimensional(), fid.get_grid_name()); + m_weighting = Field(f_id); + m_weighting.allocate_view(); + m_weighting.deep_copy(sp(1)); + } + + if (m_weighting_method == "dp" && m_contract_method == "sum") { + // we scale by the weighting, so we use fid units * Pa (but we scale by 1/g for dp) + diag_units = fid.get_units() * Pa / (m/(s*s)); + } else if (m_weighting_method == "dz" && m_contract_method == "sum") { + // we scale by the weighting, so we use fid units * m + diag_units = fid.get_units() * m; + } + + if (m_contract_method == "avg") { + auto wts_layout = m_weighting.get_header().get_identifier().get_layout(); + FieldIdentifier wts_sum_fid("vert_contract_wts_sum", wts_layout.clone().strip_dim(LEV), diag_units, fid.get_grid_name()); + m_weighting_sum = Field(wts_sum_fid); + m_weighting_sum.allocate_view(); + m_weighting_one = m_weighting.clone("vert_contract_wts_one"); + m_weighting_one.deep_copy(sp(1)); + vert_contraction(m_weighting_sum, m_weighting, m_weighting_one); + VertContractDiag::scale_wts(m_weighting, m_weighting_sum); + } + + FieldIdentifier d_fid(m_diag_name, layout.clone().strip_dim(LEV), diag_units, fid.get_grid_name()); + m_diagnostic_output = Field(d_fid); + m_diagnostic_output.allocate_view(); +} + +// TODO: move this to field_utils.hpp +// by allowing update fxns there to op +// on fields of ranks \in ranks, e.g., +// f1.scale_inv(f2) should work for: +// - f2 scalar (rank-0) +// - f2 with same layout as f1 +// - f2 with layout that is a subset of f1 +// (ncol,lev) is subset of (ncol, dim, lev) +// (ncol) is subset of (ncol, lev), etc. +void VertContractDiag::scale_wts(Field &wts, const Field &wts_sum) { + using KT = KokkosTypes; + using RP = typename KT::RangePolicy; + + auto wts_l = wts.get_header().get_identifier().get_layout(); + const int ncols = wts_l.dim(0); + const int nlevs = wts_l.dim(1); + + const auto wts_v = wts.get_view(); + const auto wts_sum_v = wts_sum.get_view(); + + Kokkos::parallel_for("VertContractDiag::scale_wts" + m_diag_name, RP(0, nlevs*ncols), + KOKKOS_LAMBDA(const int& idx) { + const int icol = idx / nlevs; + const int ilev = idx % nlevs; + if (wts_sum_v(icol) != 0) { + wts_v(icol, ilev) /= wts_sum_v(icol); + } else { + wts_v(icol, ilev) = 0; // Handle division by zero by setting to 0 + } + }); +} + +void VertContractDiag::compute_diagnostic_impl() { + const auto &f = get_fields_in().front(); + const auto &d = m_diagnostic_output; + + // update the weights; if weighting by dp, we need to scale by 1/g + if (m_weighting_method == "dp") { + auto g = scream::physics::Constants::gravit; + m_weighting.update(get_field_in("pseudo_density"), 1 / g, sp(0.0)); + } else if (m_weighting_method == "dz") { + // TODO: for some reason the dz field keeps getting set to 0 + // TODO: as a workaround, just calculate dz here (sigh...) + // m_weighting.update(get_field_in("dz"), 1.0, 0.0); + using KT = KokkosTypes; + using MT = typename KT::MemberType; + using ESU = ekat::ExeSpaceUtils; + using PF = scream::PhysicsFunctions; + const int ncols = m_weighting.get_header().get_identifier().get_layout().dim(0); + const int nlevs = m_weighting.get_header().get_identifier().get_layout().dim(1); + const auto policy = ESU::get_default_team_policy(ncols, nlevs); + + auto dz_v = m_weighting.get_view(); + auto dp_v = get_field_in("pseudo_density").get_view(); + auto pm_v = get_field_in("p_mid").get_view(); + auto tm_v = get_field_in("T_mid").get_view(); + auto qv_v = get_field_in("qv").get_view(); + Kokkos::parallel_for( + "Compute dz for " + m_diagnostic_output.name(), policy, KOKKOS_LAMBDA(const MT &team) { + const int icol = team.league_rank(); + auto dz_icol = ekat::subview(dz_v, icol); + auto dp_icol = ekat::subview(dp_v, icol); + auto pm_icol = ekat::subview(pm_v, icol); + auto tm_icol = ekat::subview(tm_v, icol); + auto qv_icol = ekat::subview(qv_v, icol); + PF::calculate_dz(team, dp_icol, pm_icol, tm_icol, qv_icol, dz_icol); + }); + } + + // if dp|dz_weighted and avg, we need to scale the weighting by its 1/sum + if ((m_weighting_method == "dp" || m_weighting_method == "dz") && m_contract_method == "avg") { + vert_contraction(m_weighting_sum, m_weighting, m_weighting_one); + VertContractDiag::scale_wts(m_weighting, m_weighting_sum); + } + + // call the vert_contraction impl that will take care of everything + vert_contraction(d, f, m_weighting); +} + +} // namespace scream diff --git a/components/eamxx/src/diagnostics/vert_contract.hpp b/components/eamxx/src/diagnostics/vert_contract.hpp new file mode 100644 index 000000000000..cc5571c38b10 --- /dev/null +++ b/components/eamxx/src/diagnostics/vert_contract.hpp @@ -0,0 +1,53 @@ + +#ifndef EAMXX_VERT_CONTRACT_HPP +#define EAMXX_VERT_CONTRACT_HPP + +#include "share/atm_process/atmosphere_diagnostic.hpp" + +namespace scream { + +/* + * This diagnostic will calculate the dp- or dz-weighted average of a field + * across the LEV tag dimension, producing an N-1 dimensional field + * that is a weighted average of the input field. + */ + +class VertContractDiag : public AtmosphereDiagnostic { + public: + // Constructors + VertContractDiag(const ekat::Comm &comm, const ekat::ParameterList ¶ms); + + // The name of the diagnostic CLASS (not the computed field) + std::string name() const { return "VertContractDiag"; } + + // Set the grid + void set_grids(const std::shared_ptr grids_manager); + + protected: +#ifdef KOKKOS_ENABLE_CUDA + public: +#endif + void compute_diagnostic_impl(); + void initialize_impl(const RunType /*run_type*/); + // Additional function to scale the weights + void scale_wts(Field &wts, const Field &wts_sum); + + + // Name of each field (because the diagnostic impl is generic) + std::string m_diag_name; + // Name of contraction method (avg, sum) + std::string m_contract_method; + // Name of weighting method (dp, dz, none) + std::string m_weighting_method; + + // Need some weighting, if unweighted, we will make it 1 + Field m_weighting; + // Need a weighting field set to all ones + Field m_weighting_one; + // Need weighting summed vertically + Field m_weighting_sum; +}; + +} // namespace scream + +#endif // EAMXX_VERT_CONTRACT_HPP diff --git a/components/eamxx/src/diagnostics/zonal_avg.cpp b/components/eamxx/src/diagnostics/zonal_avg.cpp new file mode 100644 index 000000000000..ba5a3211f5d7 --- /dev/null +++ b/components/eamxx/src/diagnostics/zonal_avg.cpp @@ -0,0 +1,189 @@ +#include "diagnostics/zonal_avg.hpp" + +#include "share/field/field_utils.hpp" + +namespace scream { + +void ZonalAvgDiag::compute_zonal_sum(const Field &result, const Field &field, const Field &weight, + const Field &lat, const ekat::Comm *comm) { + auto result_layout = result.get_header().get_identifier().get_layout(); + const int num_zonal_bins = result_layout.dim(0); + const int ncols = field.get_header().get_identifier().get_layout().dim(0); + const Real lat_delta = sp(180.0) / num_zonal_bins; + + auto weight_view = weight.get_view(); + auto lat_view = lat.get_view(); + using KT = ekat::KokkosTypes; + using TeamPolicy = Kokkos::TeamPolicy; + using TeamMember = typename TeamPolicy::member_type; + using ESU = ekat::ExeSpaceUtils; + switch (result_layout.rank()) { + case 1: { + auto field_view = field.get_view(); + auto result_view = result.get_view(); + TeamPolicy team_policy = ESU::get_default_team_policy(num_zonal_bins, ncols); + Kokkos::parallel_for( + "compute_zonal_sum_" + field.name(), team_policy, KOKKOS_LAMBDA(const TeamMember &tm) { + const int lat_i = tm.league_rank(); + const Real lat_lower = sp(-90.0) + lat_i * lat_delta; + const Real lat_upper = lat_lower + lat_delta; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, ncols), + [&](int i, Real &val) { + // TODO: check if tenary is ok here (if not, multiply by flag) + int flag = (lat_lower <= lat_view(i)) && (lat_view(i) < lat_upper); + val += flag ? weight_view(i) * field_view(i) : sp(0.0); + }, + result_view(lat_i)); + }); + } break; + case 2: { + const int d1 = result_layout.dim(1); + auto field_view = field.get_view(); + auto result_view = result.get_view(); + TeamPolicy team_policy = ESU::get_default_team_policy(num_zonal_bins * d1, ncols); + Kokkos::parallel_for( + "compute_zonal_sum_" + field.name(), team_policy, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int d1_i = idx / num_zonal_bins; + const int lat_i = idx % num_zonal_bins; + const Real lat_lower = sp(-90.0) + lat_i * lat_delta; + const Real lat_upper = lat_lower + lat_delta; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, ncols), + [&](int i, Real &val) { + int flag = (lat_lower <= lat_view(i)) && (lat_view(i) < lat_upper); + // TODO: check if tenary is ok here (if not, multiply by flag) + val += flag ? weight_view(i) * field_view(i, d1_i) : sp(0.0); + }, + result_view(lat_i, d1_i)); + }); + } break; + case 3: { + const int d1 = result_layout.dim(1); + const int d2 = result_layout.dim(2); + auto field_view = field.get_view(); + auto result_view = result.get_view(); + TeamPolicy team_policy = ESU::get_default_team_policy(num_zonal_bins * d1 * d2, ncols); + Kokkos::parallel_for( + "compute_zonal_sum_" + field.name(), team_policy, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int d1_i = idx / (num_zonal_bins * d2); + const int idx2 = idx % (num_zonal_bins * d2); + const int d2_i = idx2 / num_zonal_bins; + const int lat_i = idx2 % num_zonal_bins; + const Real lat_lower = sp(-90.0) + lat_i * lat_delta; + const Real lat_upper = lat_lower + lat_delta; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, ncols), + [&](int i, Real &val) { + int flag = (lat_lower <= lat_view(i)) && (lat_view(i) < lat_upper); + // TODO: check if tenary is ok here (if not, multiply by flag) + val += flag ? weight_view(i) * field_view(i, d1_i, d2_i) : sp(0.0); + }, + result_view(lat_i, d1_i, d2_i)); + }); + } break; + default: + EKAT_ERROR_MSG("Error! Unsupported field rank for zonal averages.\n"); + } + + if (comm) { + // TODO: use device-side MPI calls + // TODO: the dev ptr causes problems; revisit this later + // TODO: doing cuda-aware MPI allreduce would be ~10% faster + Kokkos::fence(); + result.sync_to_host(); + comm->all_reduce(result.template get_internal_view_data(), result_layout.size(), + MPI_SUM); + result.sync_to_dev(); + } +} + +ZonalAvgDiag::ZonalAvgDiag(const ekat::Comm &comm, const ekat::ParameterList ¶ms) + : AtmosphereDiagnostic(comm, params) { + const auto &field_name = m_params.get("field_name"); + const auto &num_bins_value = params.get("number_of_zonal_bins"); + m_diag_name = field_name + "_zonal_avg_" + num_bins_value + "_bins"; + m_num_zonal_bins = std::stoi(num_bins_value); +} + +void ZonalAvgDiag::set_grids(const std::shared_ptr grids_manager) { + const auto &field_name = m_params.get("field_name"); + const auto &grid_name = m_params.get("grid_name"); + + add_field(field_name, grid_name); + const GridsManager::grid_ptr_type grid = grids_manager->get_grid(grid_name); + m_lat = grid->get_geometry_data("lat"); + // area will be scaled in initialize_impl + m_scaled_area = grid->get_geometry_data("area").clone(); +} + +void ZonalAvgDiag::initialize_impl(const RunType /*run_type*/) { + using FieldIdentifier = FieldHeader::identifier_type; + using FieldLayout = FieldIdentifier::layout_type; + using ShortFieldTagsNames::COL, ShortFieldTagsNames::CMP, ShortFieldTagsNames::LEV; + const Field &field = get_fields_in().front(); + const FieldIdentifier &field_id = field.get_header().get_identifier(); + const FieldLayout &field_layout = field_id.get_layout(); + + EKAT_REQUIRE_MSG(field_layout.rank() >= 1 && field_layout.rank() <= 3, + "Error! Field rank not supported by ZonalAvgDiag.\n" + " - field name: " + + field_id.name() + + "\n" + " - field layout: " + + field_layout.to_string() + "\n"); + EKAT_REQUIRE_MSG(field_layout.tags()[0] == COL, + "Error! ZonalAvgDiag diagnostic expects a layout starting " + "with the 'COL' tag.\n" + " - field name : " + + field_id.name() + + "\n" + " - field layout: " + + field_layout.to_string() + "\n"); + + FieldLayout diagnostic_layout = + field_layout.clone().strip_dim(COL).prepend_dim({CMP}, {m_num_zonal_bins}, {"bin"}); + FieldIdentifier diagnostic_id(m_diag_name, diagnostic_layout, field_id.get_units(), + field_id.get_grid_name()); + m_diagnostic_output = Field(diagnostic_id); + m_diagnostic_output.allocate_view(); + + // allocate zonal area + const FieldIdentifier &area_id = m_scaled_area.get_header().get_identifier(); + FieldLayout zonal_area_layout({CMP}, {m_num_zonal_bins}, {"bin"}); + FieldIdentifier zonal_area_id("zonal area", zonal_area_layout, area_id.get_units(), + area_id.get_grid_name()); + Field zonal_area(zonal_area_id); + zonal_area.allocate_view(); + + // compute zonal area + FieldLayout ones_layout = area_id.get_layout().clone(); + FieldIdentifier ones_id("ones", ones_layout, area_id.get_units(), area_id.get_grid_name()); + Field ones(ones_id); + ones.allocate_view(); + ones.deep_copy(1.0); + compute_zonal_sum(zonal_area, m_scaled_area, ones, m_lat, &m_comm); + + // scale area by 1 / zonal area + using RangePolicy = Kokkos::RangePolicy; + const Real lat_delta = sp(180.0) / m_num_zonal_bins; + const int ncols = field_layout.dim(0); + auto lat_view = m_lat.get_view(); + auto zonal_area_view = zonal_area.get_view(); + auto scaled_area_view = m_scaled_area.get_view(); + Kokkos::parallel_for( + "scale_area_by_zonal_area_" + field.name(), RangePolicy(0, ncols), + KOKKOS_LAMBDA(const int &i) { + const int lat_i = (lat_view(i) + sp(90.0)) / lat_delta; + scaled_area_view(i) /= zonal_area_view(lat_i); + }); +} + +void ZonalAvgDiag::compute_diagnostic_impl() { + const auto &field = get_fields_in().front(); + compute_zonal_sum(m_diagnostic_output, field, m_scaled_area, m_lat, &m_comm); +} + +} // namespace scream diff --git a/components/eamxx/src/diagnostics/zonal_avg.hpp b/components/eamxx/src/diagnostics/zonal_avg.hpp new file mode 100644 index 000000000000..19ca5f66b8e5 --- /dev/null +++ b/components/eamxx/src/diagnostics/zonal_avg.hpp @@ -0,0 +1,55 @@ +#ifndef EAMXX_ZONAL_AVERAGE_HPP +#define EAMXX_ZONAL_AVERAGE_HPP + +#include "share/atm_process/atmosphere_diagnostic.hpp" + +namespace scream { +/* + * This diagnostic will calculate area-weighted zonal averages of a field across + * the COL tag dimension producing an N dimensional field, where the COL tag + * dimension is replaced by a CMP tag dimension named "bin" that indicates which + * zonal band the average value corresponds to. + */ + +class ZonalAvgDiag : public AtmosphereDiagnostic { + +public: + // Constructors + ZonalAvgDiag(const ekat::Comm &comm, const ekat::ParameterList ¶ms); + + // The name of the diagnostic + std::string name() const { return m_diag_name; } + + // Set the grid + void set_grids(const std::shared_ptr grids_manager); + +protected: +#ifdef KOKKOS_ENABLE_CUDA +public: +#endif + void initialize_impl(const RunType /*run_type*/); + void compute_diagnostic_impl(); + + // TODO: make it a local function in the cpp file + // Utility to compute the contraction of a field along its column dimension. + // This is equivalent to f_out = einsum('i,i...k->...k', weight, f_in). + // The implementation is such that: + // - all Field objects must be allocated + // - the first dimension for field, weight, and lat is for the columns (COL) + // - the first dimension for result is for the zonal bins (CMP,"bin") + // - field and result must be the same dimension, up to 3 + // TODO: make it a local function in the cpp file + static void compute_zonal_sum(const Field &result, const Field &field, const Field &weight, + const Field &lat, const ekat::Comm *comm = nullptr); + +protected: + std::string m_diag_name; + int m_num_zonal_bins; + + Field m_lat; + Field m_scaled_area; +}; + +} // namespace scream + +#endif // EAMXX_ZONAL_AVERAGE_HPP diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_fv_phys.cpp b/components/eamxx/src/dynamics/homme/eamxx_homme_fv_phys.cpp index 3323ce0c3c1d..cd56f52af4ba 100644 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_fv_phys.cpp +++ b/components/eamxx/src/dynamics/homme/eamxx_homme_fv_phys.cpp @@ -278,7 +278,6 @@ void HommeDynamics::fv_phys_rrtmgp_active_gases_remap (const RunType run_type) { for (const auto& e : trace_gases_workaround.get_active_gases()) create_helper_field(e, {EL,GP,GP,LEV}, {nelem,NGP,NGP,nlev}, dgn); auto r = trace_gases_workaround.get_remapper(); - r->registration_begins(); for (const auto& e : trace_gases_workaround.get_active_gases()) r->register_field(get_field_in(e, rgn), m_helper_fields.at(e)); r->registration_ends(); diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp index 9aaa8663e4b7..dcf48aef7eee 100644 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp +++ b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp @@ -388,8 +388,6 @@ void HommeDynamics::initialize_impl (const RunType run_type) fv_phys_initialize_impl(); } else { // Setup the p2d and d2p remappers - m_p2d_remapper->registration_begins(); - m_d2p_remapper->registration_begins(); // ftype==FORCING_0: // 1) remap Q_pgn->FQ_dyn @@ -996,7 +994,6 @@ void HommeDynamics::restart_homme_state () { return; } - m_ic_remapper->registration_begins(); m_ic_remapper->register_field(m_helper_fields.at("FT_phys"),get_internal_field("vtheta_dp_dyn")); m_ic_remapper->register_field(m_helper_fields.at("FM_phys"),get_internal_field("v_dyn")); m_ic_remapper->register_field(get_field_out("pseudo_density",pgn),get_internal_field("dp3d_dyn")); @@ -1100,7 +1097,6 @@ void HommeDynamics::initialize_homme_state () { // NOTE: if/when PD remapper supports remapping directly to/from subfields, // you can use get_internal_field (which have a single time slice) rather than // the helper fields (which have NTL time slices). - m_ic_remapper->registration_begins(); m_ic_remapper->register_field(get_field_in("horiz_winds",rgn),get_internal_field("v_dyn")); m_ic_remapper->register_field(get_field_out("pseudo_density",rgn),get_internal_field("dp3d_dyn")); m_ic_remapper->register_field(get_field_in("ps",rgn),get_internal_field("ps_dyn")); diff --git a/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp b/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp index 077a7dfc71f5..742c11c2a1d8 100644 --- a/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp +++ b/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp @@ -187,7 +187,7 @@ void HommeGridsManager::build_dynamics_grid () { initialize_vertical_coordinates(dyn_grid); - dyn_grid->m_short_name = "dyn"; + dyn_grid->m_disambiguation_suffix = "_d"; add_nonconst_grid(dyn_grid); } @@ -306,7 +306,7 @@ build_physics_grid (const ci_string& type, const ci_string& rebalance) { dx_short_f.sync_to_dev(); } - phys_grid->m_short_name = type; + phys_grid->m_disambiguation_suffix = type; add_nonconst_grid(phys_grid); } diff --git a/components/eamxx/src/dynamics/homme/interface/dyn_grid_mod.F90 b/components/eamxx/src/dynamics/homme/interface/dyn_grid_mod.F90 index 3460feab2fe2..26224fd21e4e 100644 --- a/components/eamxx/src/dynamics/homme/interface/dyn_grid_mod.F90 +++ b/components/eamxx/src/dynamics/homme/interface/dyn_grid_mod.F90 @@ -4,13 +4,11 @@ module dyn_grid_mod use shr_kind_mod, only: r8 => shr_kind_r8 use dimensions_mod, only: nelem, nelemd, nelemdmax, np use edgetype_mod, only: EdgeBuffer_t + use mpi implicit none private -! We need MPI in here, so include it -#include - public :: dyn_grid_init, get_my_dyn_data, cleanup_grid_init_data type (EdgeBuffer_t) :: edge diff --git a/components/eamxx/src/dynamics/homme/interface/phys_grid_mod.F90 b/components/eamxx/src/dynamics/homme/interface/phys_grid_mod.F90 index 901cd18796ee..2f13cbc274d0 100644 --- a/components/eamxx/src/dynamics/homme/interface/phys_grid_mod.F90 +++ b/components/eamxx/src/dynamics/homme/interface/phys_grid_mod.F90 @@ -3,6 +3,7 @@ module phys_grid_mod use iso_c_binding, only: c_int, c_double use parallel_mod, only: abortmp, MPIinteger_t, MPIreal_t use kinds, only: iulog + use mpi implicit none private @@ -55,8 +56,6 @@ module phys_grid_mod type(pg_specs_t), target :: pg_specs (pgN_min:pgN_max) -! To get MPI_IN_PLACE and MPI_DATATYPE_NULL -#include ! Note: in this module, we often use MPI_IN_PLACE,0,MPI_DATATYPE_NULL ! for the src array specs in Allgatherv calls. These special values ! inform MPI that src array is aliasing the dst one, so MPI will diff --git a/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp b/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp index 8fc61aa2a535..a9eccb68a6a6 100644 --- a/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp +++ b/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp @@ -92,9 +92,6 @@ TEST_CASE("dyn_grid_io") // The FM we will manually remap onto auto fm_ctrl= std::make_shared (phys_grid); - fm->registration_begins(); - fm_ctrl->registration_begins(); - const int ps = HOMMEXX_PACK_SIZE; util::TimeStamp t0({2000,1,1},{0,0,0}); @@ -120,7 +117,6 @@ TEST_CASE("dyn_grid_io") std::uniform_real_distribution pdf(0.01,100.0); auto engine = setup_random_test(&comm); auto dyn2ctrl = gm->create_remapper(dyn_grid,phys_grid); - dyn2ctrl->registration_begins(); for (const auto& fn : fnames) { auto fd = fm->get_field(fn,dyn_grid->name()); auto fc = fm_ctrl->get_field(fn,phys_grid->name()); diff --git a/components/eamxx/src/dynamics/homme/tests/homme_pd_remap_tests.cpp b/components/eamxx/src/dynamics/homme/tests/homme_pd_remap_tests.cpp index 0d7ca66d72cf..aca44bad167b 100644 --- a/components/eamxx/src/dynamics/homme/tests/homme_pd_remap_tests.cpp +++ b/components/eamxx/src/dynamics/homme/tests/homme_pd_remap_tests.cpp @@ -198,7 +198,6 @@ TEST_CASE("remap", "") { // Build the remapper, and register the fields std::shared_ptr remapper(new Remapper(phys_grid,dyn_grid)); - remapper->registration_begins(); remapper->register_field(s_2d_field_phys, s_2d_field_dyn); remapper->register_field(v_2d_field_phys, v_2d_field_dyn); remapper->register_field(s_3d_field_phys, s_3d_field_dyn); @@ -739,7 +738,6 @@ TEST_CASE("combo_remap", "") { // Build the remapper, and register the fields std::shared_ptr remapper(new Remapper(phys_grid,dyn_grid)); - remapper->registration_begins(); remapper->register_field(s_2d_field_phys, s_2d_field_dyn); remapper->register_field(v_2d_field_phys, v_2d_field_dyn); remapper->register_field(s_3d_field_phys, s_3d_field_dyn); diff --git a/components/eamxx/src/physics/CMakeLists.txt b/components/eamxx/src/physics/CMakeLists.txt index f9beda35a20c..54f89c9484c9 100644 --- a/components/eamxx/src/physics/CMakeLists.txt +++ b/components/eamxx/src/physics/CMakeLists.txt @@ -23,4 +23,4 @@ add_subdirectory(nudging) if (SCREAM_ENABLE_MAM) add_subdirectory(mam) endif() - +add_subdirectory(gw) diff --git a/components/eamxx/src/physics/cosp/eamxx_cosp.cpp b/components/eamxx/src/physics/cosp/eamxx_cosp.cpp index 248d6c44fe90..5fa1e6ff205b 100644 --- a/components/eamxx/src/physics/cosp/eamxx_cosp.cpp +++ b/components/eamxx/src/physics/cosp/eamxx_cosp.cpp @@ -154,6 +154,7 @@ void Cosp::run_impl (const double dt) get_field_in("sunlit").sync_to_host(); get_field_in("surf_radiative_T").sync_to_host(); get_field_in("T_mid").sync_to_host(); + get_field_in("p_mid").sync_to_host(); get_field_in("p_int").sync_to_host(); get_field_in("cldfrac_rad").sync_to_host(); get_field_in("eff_radius_qc").sync_to_host(); diff --git a/components/eamxx/src/physics/cosp/eamxx_cosp.hpp b/components/eamxx/src/physics/cosp/eamxx_cosp.hpp index 6d601c79b483..70cf76da4a4a 100644 --- a/components/eamxx/src/physics/cosp/eamxx_cosp.hpp +++ b/components/eamxx/src/physics/cosp/eamxx_cosp.hpp @@ -32,15 +32,13 @@ class Cosp : public AtmosphereProcess // Set the grid void set_grids (const std::shared_ptr grids_manager); - inline bool cosp_do(const int icosp, const int nstep) { + inline bool cosp_do(const int cosp_freq, const int nstep) { // If icosp == 0, then never do cosp; - // Otherwise, we always call cosp at the first step, - // and afterwards we do cosp if the timestep is divisible - // by icosp - if (icosp == 0) { + // Otherwise, do cosp if the timestep is divisible by cosp_freq + if (cosp_freq == 0) { return false; } else { - return ( (nstep == 0) || (nstep % icosp == 0) ); + return nstep % cosp_freq == 0; } } diff --git a/components/eamxx/src/physics/gw/CMakeLists.txt b/components/eamxx/src/physics/gw/CMakeLists.txt new file mode 100644 index 000000000000..de6c7c453cd3 --- /dev/null +++ b/components/eamxx/src/physics/gw/CMakeLists.txt @@ -0,0 +1,49 @@ +set(PATH_TO_LEGACY_GW ${SCREAM_BASE_DIR}/../eam/src/physics/cam/gw) +set(GW_SRCS + ${PATH_TO_LEGACY_GW}/gw_utils.F90 + ${PATH_TO_LEGACY_GW}/gw_common.F90 + ${PATH_TO_LEGACY_GW}/gw_convect.F90 + ${PATH_TO_LEGACY_GW}/gw_diffusion.F90 + ${PATH_TO_LEGACY_GW}/gw_front.F90 + ${PATH_TO_LEGACY_GW}/gw_oro.F90 + ${PATH_TO_LEGACY_GW}/../vdiff_lu_solver.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/tests/infra/gw_iso_c.f90 +) + +# Add ETI source files if not on CUDA/HIP +if (NOT EAMXX_ENABLE_GPU OR Kokkos_ENABLE_CUDA_RELOCATABLE_DEVICE_CODE OR Kokkos_ENABLE_HIP_RELOCATABLE_DEVICE_CODE) + list(APPEND GW_SRCS + eti/gw_gwd_compute_tendencies_from_stress_divergence.cpp + eti/gw_gw_prof.cpp + eti/gw_momentum_energy_conservation.cpp + eti/gw_gwd_compute_stress_profiles_and_diffusivities.cpp + eti/gw_gwd_project_tau.cpp + eti/gw_gwd_precalc_rhoi.cpp + eti/gw_gw_drag_prof.cpp + eti/gw_gw_front_project_winds.cpp + eti/gw_gw_front_gw_sources.cpp + eti/gw_gw_cm_src.cpp + ) # GW ETI SRCS +endif() + +add_library(gw ${GW_SRCS}) +set_target_properties(gw PROPERTIES + Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/modules +) + +target_include_directories(gw PUBLIC + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR}/modules + ${CMAKE_CURRENT_SOURCE_DIR}/impl + ${PATH_TO_LEGACY_GW} +) +target_link_libraries(gw physics_share scream_share) + +if (NOT SCREAM_LIB_ONLY) + add_subdirectory(tests) +endif() + +if (TARGET eamxx_physics) + # Add this library to eamxx_physics + target_link_libraries(eamxx_physics INTERFACE gw) +endif() diff --git a/components/eamxx/src/physics/gw/eti/gw_gw_cm_src.cpp b/components/eamxx/src/physics/gw/eti/gw_gw_cm_src.cpp new file mode 100644 index 000000000000..d31255a1e437 --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gw_cm_src.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gw_cm_src_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gw_cm_src on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gw_drag_prof.cpp b/components/eamxx/src/physics/gw/eti/gw_gw_drag_prof.cpp new file mode 100644 index 000000000000..ecfddb4aaea4 --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gw_drag_prof.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gw_drag_prof_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gw_drag_prof on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gw_front_gw_sources.cpp b/components/eamxx/src/physics/gw/eti/gw_gw_front_gw_sources.cpp new file mode 100644 index 000000000000..efa49ce51c86 --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gw_front_gw_sources.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gw_front_gw_sources_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gw_front_gw_sources on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gw_front_project_winds.cpp b/components/eamxx/src/physics/gw/eti/gw_gw_front_project_winds.cpp new file mode 100644 index 000000000000..667c33fe94bf --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gw_front_project_winds.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gw_front_project_winds_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gw_front_project_winds on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gw_prof.cpp b/components/eamxx/src/physics/gw/eti/gw_gw_prof.cpp new file mode 100644 index 000000000000..d53190559967 --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gw_prof.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gw_prof_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gw_prof on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gwd_compute_stress_profiles_and_diffusivities.cpp b/components/eamxx/src/physics/gw/eti/gw_gwd_compute_stress_profiles_and_diffusivities.cpp new file mode 100644 index 000000000000..43cf11b7072e --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gwd_compute_stress_profiles_and_diffusivities.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gwd_compute_stress_profiles_and_diffusivities_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gwd_compute_stress_profiles_and_diffusivities on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gwd_compute_tendencies_from_stress_divergence.cpp b/components/eamxx/src/physics/gw/eti/gw_gwd_compute_tendencies_from_stress_divergence.cpp new file mode 100644 index 000000000000..bb54fd1bd717 --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gwd_compute_tendencies_from_stress_divergence.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gwd_compute_tendencies_from_stress_divergence_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gwd_compute_tendencies_from_stress_divergence on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gwd_precalc_rhoi.cpp b/components/eamxx/src/physics/gw/eti/gw_gwd_precalc_rhoi.cpp new file mode 100644 index 000000000000..ca1380f69b1f --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gwd_precalc_rhoi.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gwd_precalc_rhoi_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gwd_precalc_rhoi on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_gwd_project_tau.cpp b/components/eamxx/src/physics/gw/eti/gw_gwd_project_tau.cpp new file mode 100644 index 000000000000..3aa843caf928 --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_gwd_project_tau.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_gwd_project_tau_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing gwd_project_tau on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/eti/gw_momentum_energy_conservation.cpp b/components/eamxx/src/physics/gw/eti/gw_momentum_energy_conservation.cpp new file mode 100644 index 000000000000..2f743a18701b --- /dev/null +++ b/components/eamxx/src/physics/gw/eti/gw_momentum_energy_conservation.cpp @@ -0,0 +1,14 @@ +#include "impl/gw_momentum_energy_conservation_impl.hpp" + +namespace scream { +namespace gw { + +/* + * Explicit instantiation for doing momentum_energy_conservation on Reals using the + * default device. + */ + +template struct Functions; + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/gw_functions.hpp b/components/eamxx/src/physics/gw/gw_functions.hpp new file mode 100644 index 000000000000..b64e0b1aa1fd --- /dev/null +++ b/components/eamxx/src/physics/gw/gw_functions.hpp @@ -0,0 +1,305 @@ +#ifndef GW_FUNCTIONS_HPP +#define GW_FUNCTIONS_HPP + +#include "physics/share/physics_constants.hpp" + +#include "share/eamxx_types.hpp" + +#include "ekat/ekat_pack_kokkos.hpp" +#include "ekat/ekat_workspace.hpp" +#include "ekat/ekat_parameter_list.hpp" + +namespace scream { +namespace gw { + +/* + * Functions is a stateless struct used to encapsulate a + * number of functions for gravity wave drag. We use the ETI pattern for + * these functions. + */ + +template +struct Functions +{ + // + // ---------- GW constants --------- + // + struct GWC { + }; + + // + // ------- Types -------- + // + + using Scalar = ScalarT; + using Device = DeviceT; + + template + using BigPack = ekat::Pack; + template + using SmallPack = ekat::Pack; + + using IntSmallPack = SmallPack; + using Pack = BigPack; + using Spack = SmallPack; + + using Mask = ekat::Mask::n>; + using Smask = ekat::Mask::n>; + + using KT = KokkosTypes; + + using C = scream::physics::Constants; + + template + using view_1d = typename KT::template view_1d; + template + using view_2d = typename KT::template view_2d; + + template + using uview_1d = typename ekat::template Unmanaged >; + template + using uview_2d = typename ekat::template Unmanaged >; + + using MemberType = typename KT::MemberType; + + using WorkspaceManager = typename ekat::WorkspaceManager; + using Workspace = typename WorkspaceManager::Workspace; + + // + // --------- Functions --------- + // + + KOKKOS_FUNCTION + static void gwd_compute_tendencies_from_stress_divergence( + // Inputs + const Int& ncol, + const Int& pver, + const Int& pgwv, + const Int& ngwv, + const bool& do_taper, + const Spack& dt, + const Spack& effgw, + const uview_1d& tend_level, + const uview_1d& lat, + const uview_1d& dpm, + const uview_1d& rdpm, + const uview_1d& c, + const uview_1d& ubm, + const uview_1d& t, + const uview_1d& nm, + const uview_1d& xv, + const uview_1d& yv, + // Inputs/Outputs + const uview_1d& tau, + // Outputs + const uview_1d& gwut, + const uview_1d& utgw, + const uview_1d& vtgw); + + KOKKOS_FUNCTION + static void gw_prof( + // Inputs + const Int& pver, + const Int& ncol, + const Spack& cpair, + const uview_1d& t, + const uview_1d& pmid, + const uview_1d& pint, + // Outputs + const uview_1d& rhoi, + const uview_1d& ti, + const uview_1d& nm, + const uview_1d& ni); + + KOKKOS_FUNCTION + static void momentum_energy_conservation( + // Inputs + const Int& pver, + const Int& ncol, + const uview_1d& tend_level, + const Spack& dt, + const uview_1d& taucd, + const uview_1d& pint, + const uview_1d& pdel, + const uview_1d& u, + const uview_1d& v, + // Inputs/Outputs + const uview_1d& dudt, + const uview_1d& dvdt, + const uview_1d& dsdt, + const uview_1d& utgw, + const uview_1d& vtgw, + const uview_1d& ttgw); + + KOKKOS_FUNCTION + static void gwd_compute_stress_profiles_and_diffusivities( + // Inputs + const Int& pver, + const Int& pgwv, + const Int& ncol, + const Int& ngwv, + const uview_1d& src_level, + const uview_1d& ubi, + const uview_1d& c, + const uview_1d& rhoi, + const uview_1d& ni, + const uview_1d& kvtt, + const uview_1d& t, + const uview_1d& ti, + const uview_1d& piln, + // Inputs/Outputs + const uview_1d& tau); + + KOKKOS_FUNCTION + static void gwd_project_tau( + // Inputs + const Int& pver, + const Int& pgwv, + const Int& ncol, + const Int& ngwv, + const uview_1d& tend_level, + const uview_1d& tau, + const uview_1d& ubi, + const uview_1d& c, + const uview_1d& xv, + const uview_1d& yv, + // Outputs + const uview_1d& taucd); + + KOKKOS_FUNCTION + static void gwd_precalc_rhoi( + // Inputs + const Int& pver, + const Int& pgwv, + const Int& ncol, + const Int& ngwv, + const Spack& dt, + const uview_1d& tend_level, + const uview_1d& pmid, + const uview_1d& pint, + const uview_1d& t, + const uview_1d& gwut, + const uview_1d& ubm, + const uview_1d& nm, + const uview_1d& rdpm, + const uview_1d& c, + const uview_1d& q, + const uview_1d& dse, + // Outputs + const uview_1d& egwdffi, + const uview_1d& qtgw, + const uview_1d& dttdf, + const uview_1d& dttke, + const uview_1d& ttgw); + + KOKKOS_FUNCTION + static void gw_drag_prof( + // Inputs + const Int& pver, + const Int& pgwv, + const Int& ncol, + const Int& ngwv, + const uview_1d& src_level, + const uview_1d& tend_level, + const bool& do_taper, + const Spack& dt, + const uview_1d& lat, + const uview_1d& t, + const uview_1d& ti, + const uview_1d& pmid, + const uview_1d& pint, + const uview_1d& dpm, + const uview_1d& rdpm, + const uview_1d& piln, + const uview_1d& rhoi, + const uview_1d& nm, + const uview_1d& ni, + const uview_1d& ubm, + const uview_1d& ubi, + const uview_1d& xv, + const uview_1d& yv, + const Spack& effgw, + const uview_1d& c, + const uview_1d& kvtt, + const uview_1d& q, + const uview_1d& dse, + // Inputs/Outputs + const uview_1d& tau, + // Outputs + const uview_1d& utgw, + const uview_1d& vtgw, + const uview_1d& ttgw, + const uview_1d& qtgw, + const uview_1d& taucd, + const uview_1d& egwdffi, + const uview_1d& gwut, + const uview_1d& dttdf, + const uview_1d& dttke); + + KOKKOS_FUNCTION + static void gw_front_project_winds( + // Inputs + const Int& pver, + const Int& ncol, + const Int& kbot, + const uview_1d& u, + const uview_1d& v, + // Outputs + const uview_1d& xv, + const uview_1d& yv, + const uview_1d& ubm, + const uview_1d& ubi); + + KOKKOS_FUNCTION + static void gw_front_gw_sources( + // Inputs + const Int& pver, + const Int& pgwv, + const Int& ncol, + const Int& ngwv, + const Int& kbot, + const uview_1d& frontgf, + // Outputs + const uview_1d& tau); + + KOKKOS_FUNCTION + static void gw_cm_src( + // Inputs + const Int& pver, + const Int& pgwv, + const Int& ncol, + const Int& ngwv, + const Int& kbot, + const uview_1d& u, + const uview_1d& v, + const uview_1d& frontgf, + // Outputs + const uview_1d& src_level, + const uview_1d& tend_level, + const uview_1d& tau, + const uview_1d& ubm, + const uview_1d& ubi, + const uview_1d& xv, + const uview_1d& yv, + const uview_1d& c); +}; // struct Functions + +} // namespace gw +} // namespace scream + +// If a GPU build, without relocatable device code enabled, make all code available +// to the translation unit; otherwise, ETI is used. +#if defined(EAMXX_ENABLE_GPU) && !defined(KOKKOS_ENABLE_CUDA_RELOCATABLE_DEVICE_CODE) \ + && !defined(KOKKOS_ENABLE_HIP_RELOCATABLE_DEVICE_CODE) +# include "impl/gw_gwd_compute_tendencies_from_stress_divergence_impl.hpp" +# include "impl/gw_gw_prof_impl.hpp" +# include "impl/gw_momentum_energy_conservation_impl.hpp" +# include "impl/gw_gwd_compute_stress_profiles_and_diffusivities_impl.hpp" +# include "impl/gw_gwd_project_tau_impl.hpp" +# include "impl/gw_gwd_precalc_rhoi_impl.hpp" +# include "impl/gw_gw_drag_prof_impl.hpp" +# include "impl/gw_gw_front_project_winds_impl.hpp" +# include "impl/gw_gw_front_gw_sources_impl.hpp" +# include "impl/gw_gw_cm_src_impl.hpp" +#endif // GPU && !KOKKOS_ENABLE_*_RELOCATABLE_DEVICE_CODE +#endif // P3_FUNCTIONS_HPP diff --git a/components/eamxx/src/physics/gw/impl/gw_gw_cm_src_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gw_cm_src_impl.hpp new file mode 100644 index 000000000000..1c08004a34fb --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gw_cm_src_impl.hpp @@ -0,0 +1,43 @@ +#ifndef GW_GW_CM_SRC_IMPL_HPP +#define GW_GW_CM_SRC_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gw_cm_src. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gw_cm_src( +// Inputs +const Int& pver, +const Int& pgwv, +const Int& ncol, +const Int& ngwv, +const Int& kbot, +const uview_1d& u, +const uview_1d& v, +const uview_1d& frontgf, +// Outputs +const uview_1d& src_level, +const uview_1d& tend_level, +const uview_1d& tau, +const uview_1d& ubm, +const uview_1d& ubi, +const uview_1d& xv, +const uview_1d& yv, +const uview_1d& c) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gw_drag_prof_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gw_drag_prof_impl.hpp new file mode 100644 index 000000000000..827950de8fe1 --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gw_drag_prof_impl.hpp @@ -0,0 +1,66 @@ +#ifndef GW_GW_DRAG_PROF_IMPL_HPP +#define GW_GW_DRAG_PROF_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gw_drag_prof. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gw_drag_prof( +// Inputs +const Int& pver, +const Int& pgwv, +const Int& ncol, +const Int& ngwv, +const uview_1d& src_level, +const uview_1d& tend_level, +const bool& do_taper, +const Spack& dt, +const uview_1d& lat, +const uview_1d& t, +const uview_1d& ti, +const uview_1d& pmid, +const uview_1d& pint, +const uview_1d& dpm, +const uview_1d& rdpm, +const uview_1d& piln, +const uview_1d& rhoi, +const uview_1d& nm, +const uview_1d& ni, +const uview_1d& ubm, +const uview_1d& ubi, +const uview_1d& xv, +const uview_1d& yv, +const Spack& effgw, +const uview_1d& c, +const uview_1d& kvtt, +const uview_1d& q, +const uview_1d& dse, +// Inputs/Outputs +const uview_1d& tau, +// Outputs +const uview_1d& utgw, +const uview_1d& vtgw, +const uview_1d& ttgw, +const uview_1d& qtgw, +const uview_1d& taucd, +const uview_1d& egwdffi, +const uview_1d& gwut, +const uview_1d& dttdf, +const uview_1d& dttke) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gw_front_gw_sources_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gw_front_gw_sources_impl.hpp new file mode 100644 index 000000000000..707d73fa2139 --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gw_front_gw_sources_impl.hpp @@ -0,0 +1,34 @@ +#ifndef GW_GW_FRONT_GW_SOURCES_IMPL_HPP +#define GW_GW_FRONT_GW_SOURCES_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gw_front_gw_sources. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gw_front_gw_sources( +// Inputs +const Int& pver, +const Int& pgwv, +const Int& ncol, +const Int& ngwv, +const Int& kbot, +const uview_1d& frontgf, +// Outputs +const uview_1d& tau) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gw_front_project_winds_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gw_front_project_winds_impl.hpp new file mode 100644 index 000000000000..47075129012c --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gw_front_project_winds_impl.hpp @@ -0,0 +1,36 @@ +#ifndef GW_GW_FRONT_PROJECT_WINDS_IMPL_HPP +#define GW_GW_FRONT_PROJECT_WINDS_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gw_front_project_winds. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gw_front_project_winds( +// Inputs +const Int& pver, +const Int& ncol, +const Int& kbot, +const uview_1d& u, +const uview_1d& v, +// Outputs +const uview_1d& xv, +const uview_1d& yv, +const uview_1d& ubm, +const uview_1d& ubi) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gw_prof_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gw_prof_impl.hpp new file mode 100644 index 000000000000..27a9e8f9e472 --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gw_prof_impl.hpp @@ -0,0 +1,37 @@ +#ifndef GW_GW_PROF_IMPL_HPP +#define GW_GW_PROF_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gw_prof. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gw_prof( +// Inputs +const Int& pver, +const Int& ncol, +const Spack& cpair, +const uview_1d& t, +const uview_1d& pmid, +const uview_1d& pint, +// Outputs +const uview_1d& rhoi, +const uview_1d& ti, +const uview_1d& nm, +const uview_1d& ni) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gwd_compute_stress_profiles_and_diffusivities_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gwd_compute_stress_profiles_and_diffusivities_impl.hpp new file mode 100644 index 000000000000..8371750671f2 --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gwd_compute_stress_profiles_and_diffusivities_impl.hpp @@ -0,0 +1,41 @@ +#ifndef GW_GWD_COMPUTE_STRESS_PROFILES_AND_DIFFUSIVITIES_IMPL_HPP +#define GW_GWD_COMPUTE_STRESS_PROFILES_AND_DIFFUSIVITIES_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gwd_compute_stress_profiles_and_diffusivities. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gwd_compute_stress_profiles_and_diffusivities( +// Inputs +const Int& pver, +const Int& pgwv, +const Int& ncol, +const Int& ngwv, +const uview_1d& src_level, +const uview_1d& ubi, +const uview_1d& c, +const uview_1d& rhoi, +const uview_1d& ni, +const uview_1d& kvtt, +const uview_1d& t, +const uview_1d& ti, +const uview_1d& piln, +// Inputs/Outputs +const uview_1d& tau) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gwd_compute_tendencies_from_stress_divergence_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gwd_compute_tendencies_from_stress_divergence_impl.hpp new file mode 100644 index 000000000000..a84234522704 --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gwd_compute_tendencies_from_stress_divergence_impl.hpp @@ -0,0 +1,49 @@ +#ifndef GW_GWD_COMPUTE_TENDENCIES_FROM_STRESS_DIVERGENCE_IMPL_HPP +#define GW_GWD_COMPUTE_TENDENCIES_FROM_STRESS_DIVERGENCE_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gwd_compute_tendencies_from_stress_divergence. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gwd_compute_tendencies_from_stress_divergence( + // Inputs + const Int& ncol, + const Int& pver, + const Int& pgwv, + const Int& ngwv, + const bool& do_taper, + const Spack& dt, + const Spack& effgw, + const uview_1d& tend_level, + const uview_1d& lat, + const uview_1d& dpm, + const uview_1d& rdpm, + const uview_1d& c, + const uview_1d& ubm, + const uview_1d& t, + const uview_1d& nm, + const uview_1d& xv, + const uview_1d& yv, + // Inputs/Outputs + const uview_1d& tau, + // Outputs + const uview_1d& gwut, + const uview_1d& utgw, + const uview_1d& vtgw) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gwd_precalc_rhoi_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gwd_precalc_rhoi_impl.hpp new file mode 100644 index 000000000000..d8181ab5aa46 --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gwd_precalc_rhoi_impl.hpp @@ -0,0 +1,48 @@ +#ifndef GW_GWD_PRECALC_RHOI_IMPL_HPP +#define GW_GWD_PRECALC_RHOI_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gwd_precalc_rhoi. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gwd_precalc_rhoi( +// Inputs +const Int& pver, +const Int& pgwv, +const Int& ncol, +const Int& ngwv, +const Spack& dt, +const uview_1d& tend_level, +const uview_1d& pmid, +const uview_1d& pint, +const uview_1d& t, +const uview_1d& gwut, +const uview_1d& ubm, +const uview_1d& nm, +const uview_1d& rdpm, +const uview_1d& c, +const uview_1d& q, +const uview_1d& dse, +// Outputs +const uview_1d& egwdffi, +const uview_1d& qtgw, +const uview_1d& dttdf, +const uview_1d& dttke, +const uview_1d& ttgw) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_gwd_project_tau_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_gwd_project_tau_impl.hpp new file mode 100644 index 000000000000..43e351dcca6e --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_gwd_project_tau_impl.hpp @@ -0,0 +1,38 @@ +#ifndef GW_GWD_PROJECT_TAU_IMPL_HPP +#define GW_GWD_PROJECT_TAU_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw gwd_project_tau. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::gwd_project_tau( +// Inputs +const Int& pver, +const Int& pgwv, +const Int& ncol, +const Int& ngwv, +const uview_1d& tend_level, +const uview_1d& tau, +const uview_1d& ubi, +const uview_1d& c, +const uview_1d& xv, +const uview_1d& yv, +// Outputs +const uview_1d& taucd) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/impl/gw_momentum_energy_conservation_impl.hpp b/components/eamxx/src/physics/gw/impl/gw_momentum_energy_conservation_impl.hpp new file mode 100644 index 000000000000..bdaee21714ef --- /dev/null +++ b/components/eamxx/src/physics/gw/impl/gw_momentum_energy_conservation_impl.hpp @@ -0,0 +1,42 @@ +#ifndef GW_MOMENTUM_ENERGY_CONSERVATION_IMPL_HPP +#define GW_MOMENTUM_ENERGY_CONSERVATION_IMPL_HPP + +#include "gw_functions.hpp" // for ETI only but harmless for GPU + +namespace scream { +namespace gw { + +/* + * Implementation of gw momentum_energy_conservation. Clients should NOT + * #include this file, but include gw_functions.hpp instead. + */ + +template +KOKKOS_FUNCTION +void Functions::momentum_energy_conservation( +// Inputs +const Int& pver, +const Int& ncol, +const uview_1d& tend_level, +const Spack& dt, +const uview_1d& taucd, +const uview_1d& pint, +const uview_1d& pdel, +const uview_1d& u, +const uview_1d& v, +// Inputs/Outputs +const uview_1d& dudt, +const uview_1d& dvdt, +const uview_1d& dsdt, +const uview_1d& utgw, +const uview_1d& vtgw, +const uview_1d& ttgw) +{ + // TODO + // Note, argument types may need tweaking. Generator is not always able to tell what needs to be packed +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/tests/CMakeLists.txt b/components/eamxx/src/physics/gw/tests/CMakeLists.txt new file mode 100644 index 000000000000..7e6a523687a4 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/CMakeLists.txt @@ -0,0 +1,38 @@ +include(ScreamUtils) + +add_subdirectory(infra) + +set(GW_TESTS_SRCS + gw_gwd_compute_tendencies_from_stress_divergence_tests.cpp + gw_gw_prof_tests.cpp + gw_momentum_energy_conservation_tests.cpp + gw_gwd_compute_stress_profiles_and_diffusivities_tests.cpp + gw_gwd_project_tau_tests.cpp + gw_gwd_precalc_rhoi_tests.cpp + gw_gw_drag_prof_tests.cpp + gw_gw_front_project_winds_tests.cpp + gw_gw_front_gw_sources_tests.cpp + gw_gw_cm_src_tests.cpp +) # GW_TESTS_SRCS + +# All tests should understand the same baseline args +if (SCREAM_ENABLE_BASELINE_TESTS) + if (SCREAM_ONLY_GENERATE_BASELINES) + set(BASELINE_FILE_ARG "-g -b ${SCREAM_BASELINES_DIR}/data") + # We don't want to do thread spreads when generating. That + # could cause race conditions in the file system. + set(GW_THREADS "${SCREAM_TEST_MAX_THREADS}") + else() + set(BASELINE_FILE_ARG "-c -b ${SCREAM_BASELINES_DIR}/data") + set(GW_THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC}) + endif() +else() + set(BASELINE_FILE_ARG "-n") # no baselines + set(GW_THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC}) +endif() + +CreateUnitTest(gw_tests "${GW_TESTS_SRCS}" + LIBS gw gw_test_infra + EXE_ARGS "--args ${BASELINE_FILE_ARG}" + THREADS ${GW_THREADS} + LABELS "gw;physics;baseline_gen;baseline_cmp") diff --git a/components/eamxx/src/physics/gw/tests/gw_gw_cm_src_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gw_cm_src_tests.cpp new file mode 100644 index 000000000000..332fa633e18d --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gw_cm_src_tests.cpp @@ -0,0 +1,142 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwCmSrc : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up init data + GwFrontInitData front_init_data[] = { + // taubgnd, frontgfc_in, kfront_in, init + GwFrontInitData( .1, .4, 10, init_data[0]), + GwFrontInitData( .2, .5, 11, init_data[1]), + GwFrontInitData( .3, .6, 12, init_data[2]), + GwFrontInitData( .4, .7, 13, init_data[3]), + }; + + for (auto& d : front_init_data) { + d.randomize(engine); + } + + // Set up inputs + GwCmSrcData baseline_data[] = { + GwCmSrcData(2, 10, 3, front_init_data[0]), + GwCmSrcData(3, 11, 4, front_init_data[1]), + GwCmSrcData(4, 12, 5, front_init_data[2]), + GwCmSrcData(5, 13, 6, front_init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwCmSrcData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwCmSrcData test_data[] = { + GwCmSrcData(baseline_data[0]), + GwCmSrcData(baseline_data[1]), + GwCmSrcData(baseline_data[2]), + GwCmSrcData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gw_cm_src(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwCmSrcData& d_baseline = baseline_data[i]; + GwCmSrcData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.tau); ++k) { + REQUIRE(d_baseline.total(d_baseline.tau) == d_test.total(d_test.tau)); + REQUIRE(d_baseline.tau[k] == d_test.tau[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.ubm); ++k) { + REQUIRE(d_baseline.total(d_baseline.ubm) == d_test.total(d_test.ubm)); + REQUIRE(d_baseline.ubm[k] == d_test.ubm[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.ubi); ++k) { + REQUIRE(d_baseline.total(d_baseline.ubi) == d_test.total(d_test.ubi)); + REQUIRE(d_baseline.ubi[k] == d_test.ubi[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.xv); ++k) { + REQUIRE(d_baseline.total(d_baseline.xv) == d_test.total(d_test.xv)); + REQUIRE(d_baseline.xv[k] == d_test.xv[k]); + REQUIRE(d_baseline.total(d_baseline.xv) == d_test.total(d_test.yv)); + REQUIRE(d_baseline.yv[k] == d_test.yv[k]); + REQUIRE(d_baseline.total(d_baseline.xv) == d_test.total(d_test.src_level)); + REQUIRE(d_baseline.src_level[k] == d_test.src_level[k]); + REQUIRE(d_baseline.total(d_baseline.xv) == d_test.total(d_test.tend_level)); + REQUIRE(d_baseline.tend_level[k] == d_test.tend_level[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.c); ++k) { + REQUIRE(d_baseline.total(d_baseline.c) == d_test.total(d_test.c)); + REQUIRE(d_baseline.c[k] == d_test.c[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gw_cm_src_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwCmSrc; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gw_drag_prof_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gw_drag_prof_tests.cpp new file mode 100644 index 000000000000..fa32c606fe94 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gw_drag_prof_tests.cpp @@ -0,0 +1,135 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwDragProf : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + GwDragProfData baseline_data[] = { + GwDragProfData(5, 2, 10, true, .4, 1.8, init_data[0]), + GwDragProfData(6, 3, 11, false, .8, 2.4, init_data[1]), + GwDragProfData(7, 4, 12, true, 1.4, 3.4, init_data[2]), + GwDragProfData(8, 5, 13, false, 2.4, 4.4, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwDragProfData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwDragProfData test_data[] = { + GwDragProfData(baseline_data[0]), + GwDragProfData(baseline_data[1]), + GwDragProfData(baseline_data[2]), + GwDragProfData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gw_drag_prof(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwDragProfData& d_baseline = baseline_data[i]; + GwDragProfData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.tau); ++k) { + REQUIRE(d_baseline.total(d_baseline.tau) == d_test.total(d_test.tau)); + REQUIRE(d_baseline.tau[k] == d_test.tau[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.utgw); ++k) { + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.utgw)); + REQUIRE(d_baseline.utgw[k] == d_test.utgw[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.vtgw)); + REQUIRE(d_baseline.vtgw[k] == d_test.vtgw[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.ttgw)); + REQUIRE(d_baseline.ttgw[k] == d_test.ttgw[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.dttdf)); + REQUIRE(d_baseline.dttdf[k] == d_test.dttdf[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.dttke)); + REQUIRE(d_baseline.dttke[k] == d_test.dttke[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.qtgw); ++k) { + REQUIRE(d_baseline.total(d_baseline.qtgw) == d_test.total(d_test.qtgw)); + REQUIRE(d_baseline.qtgw[k] == d_test.qtgw[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.taucd); ++k) { + REQUIRE(d_baseline.total(d_baseline.taucd) == d_test.total(d_test.taucd)); + REQUIRE(d_baseline.taucd[k] == d_test.taucd[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.egwdffi); ++k) { + REQUIRE(d_baseline.total(d_baseline.egwdffi) == d_test.total(d_test.egwdffi)); + REQUIRE(d_baseline.egwdffi[k] == d_test.egwdffi[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.gwut); ++k) { + REQUIRE(d_baseline.total(d_baseline.gwut) == d_test.total(d_test.gwut)); + REQUIRE(d_baseline.gwut[k] == d_test.gwut[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gw_drag_prof_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwDragProf; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gw_front_gw_sources_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gw_front_gw_sources_tests.cpp new file mode 100644 index 000000000000..13ce6be47c8b --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gw_front_gw_sources_tests.cpp @@ -0,0 +1,120 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwFrontGwSources : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up init data + GwFrontInitData front_init_data[] = { + // taubgnd, frontgfc_in, kfront_in, init + GwFrontInitData( .1, .4, 10, init_data[0]), + GwFrontInitData( .2, .5, 11, init_data[1]), + GwFrontInitData( .3, .6, 12, init_data[2]), + GwFrontInitData( .4, .7, 13, init_data[3]), + }; + + for (auto& d : front_init_data) { + d.randomize(engine); + } + + // Set up inputs + GwFrontGwSourcesData baseline_data[] = { + GwFrontGwSourcesData(2, 10, 3, front_init_data[0]), + GwFrontGwSourcesData(3, 11, 4, front_init_data[1]), + GwFrontGwSourcesData(4, 12, 5, front_init_data[2]), + GwFrontGwSourcesData(5, 13, 6, front_init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwFrontGwSourcesData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwFrontGwSourcesData test_data[] = { + GwFrontGwSourcesData(baseline_data[0]), + GwFrontGwSourcesData(baseline_data[1]), + GwFrontGwSourcesData(baseline_data[2]), + GwFrontGwSourcesData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gw_front_gw_sources(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwFrontGwSourcesData& d_baseline = baseline_data[i]; + GwFrontGwSourcesData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.tau); ++k) { + REQUIRE(d_baseline.total(d_baseline.tau) == d_test.total(d_test.tau)); + REQUIRE(d_baseline.tau[k] == d_test.tau[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gw_front_gw_sources_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwFrontGwSources; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gw_front_project_winds_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gw_front_project_winds_tests.cpp new file mode 100644 index 000000000000..15f9e50ce9b7 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gw_front_project_winds_tests.cpp @@ -0,0 +1,130 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwFrontProjectWinds : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up init data + GwFrontInitData front_init_data[] = { + // taubgnd, frontgfc_in, kfront_in, init + GwFrontInitData( .1, .4, 10, init_data[0]), + GwFrontInitData( .2, .5, 11, init_data[1]), + GwFrontInitData( .3, .6, 12, init_data[2]), + GwFrontInitData( .4, .7, 13, init_data[3]), + }; + + for (auto& d : front_init_data) { + d.randomize(engine); + } + + // Set up inputs + GwFrontProjectWindsData baseline_data[] = { + GwFrontProjectWindsData(10, 60, front_init_data[0]), + GwFrontProjectWindsData(11, 61, front_init_data[1]), + GwFrontProjectWindsData(12, 62, front_init_data[2]), + GwFrontProjectWindsData(13, 63, front_init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwFrontProjectWindsData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwFrontProjectWindsData test_data[] = { + GwFrontProjectWindsData(baseline_data[0]), + GwFrontProjectWindsData(baseline_data[1]), + GwFrontProjectWindsData(baseline_data[2]), + GwFrontProjectWindsData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gw_front_project_winds(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwFrontProjectWindsData& d_baseline = baseline_data[i]; + GwFrontProjectWindsData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.xv); ++k) { + REQUIRE(d_baseline.total(d_baseline.xv) == d_test.total(d_test.xv)); + REQUIRE(d_baseline.xv[k] == d_test.xv[k]); + REQUIRE(d_baseline.total(d_baseline.xv) == d_test.total(d_test.yv)); + REQUIRE(d_baseline.yv[k] == d_test.yv[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.ubm); ++k) { + REQUIRE(d_baseline.total(d_baseline.ubm) == d_test.total(d_test.ubm)); + REQUIRE(d_baseline.ubm[k] == d_test.ubm[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.ubi); ++k) { + REQUIRE(d_baseline.total(d_baseline.ubi) == d_test.total(d_test.ubi)); + REQUIRE(d_baseline.ubi[k] == d_test.ubi[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gw_front_project_winds_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwFrontProjectWinds; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gw_prof_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gw_prof_tests.cpp new file mode 100644 index 000000000000..7ef9b2e57251 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gw_prof_tests.cpp @@ -0,0 +1,115 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwProf : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + GwProfData baseline_data[] = { + GwProfData(2, .4, init_data[0]), + GwProfData(3, .8, init_data[1]), + GwProfData(4, 1.4, init_data[2]), + GwProfData(5, 2.4, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwProfData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwProfData test_data[] = { + GwProfData(baseline_data[0]), + GwProfData(baseline_data[1]), + GwProfData(baseline_data[2]), + GwProfData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gw_prof(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwProfData& d_baseline = baseline_data[i]; + GwProfData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.rhoi); ++k) { + REQUIRE(d_baseline.total(d_baseline.rhoi) == d_test.total(d_test.rhoi)); + REQUIRE(d_baseline.rhoi[k] == d_test.rhoi[k]); + REQUIRE(d_baseline.total(d_baseline.rhoi) == d_test.total(d_test.ti)); + REQUIRE(d_baseline.ti[k] == d_test.ti[k]); + REQUIRE(d_baseline.total(d_baseline.rhoi) == d_test.total(d_test.ni)); + REQUIRE(d_baseline.ni[k] == d_test.ni[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.nm); ++k) { + REQUIRE(d_baseline.total(d_baseline.nm) == d_test.total(d_test.nm)); + REQUIRE(d_baseline.nm[k] == d_test.nm[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gw_prof_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwProf; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gwd_compute_stress_profiles_and_diffusivities_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gwd_compute_stress_profiles_and_diffusivities_tests.cpp new file mode 100644 index 000000000000..bf42d922b34b --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gwd_compute_stress_profiles_and_diffusivities_tests.cpp @@ -0,0 +1,107 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwdComputeStressProfilesAndDiffusivities : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + GwdComputeStressProfilesAndDiffusivitiesData baseline_data[] = { + GwdComputeStressProfilesAndDiffusivitiesData(2, 10, init_data[0]), + GwdComputeStressProfilesAndDiffusivitiesData(3, 11, init_data[1]), + GwdComputeStressProfilesAndDiffusivitiesData(4, 12, init_data[2]), + GwdComputeStressProfilesAndDiffusivitiesData(5, 13, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwdComputeStressProfilesAndDiffusivitiesData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwdComputeStressProfilesAndDiffusivitiesData test_data[] = { + GwdComputeStressProfilesAndDiffusivitiesData(baseline_data[0]), + GwdComputeStressProfilesAndDiffusivitiesData(baseline_data[1]), + GwdComputeStressProfilesAndDiffusivitiesData(baseline_data[2]), + GwdComputeStressProfilesAndDiffusivitiesData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gwd_compute_stress_profiles_and_diffusivities(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwdComputeStressProfilesAndDiffusivitiesData& d_baseline = baseline_data[i]; + GwdComputeStressProfilesAndDiffusivitiesData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.tau); ++k) { + REQUIRE(d_baseline.total(d_baseline.tau) == d_test.total(d_test.tau)); + REQUIRE(d_baseline.tau[k] == d_test.tau[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gwd_compute_stress_profiles_and_diffusivities_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwdComputeStressProfilesAndDiffusivities; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gwd_compute_tendencies_from_stress_divergence_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gwd_compute_tendencies_from_stress_divergence_tests.cpp new file mode 100644 index 000000000000..c5767d00bd05 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gwd_compute_tendencies_from_stress_divergence_tests.cpp @@ -0,0 +1,118 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwdComputeTendenciesFromStressDivergence : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + GwdComputeTendenciesFromStressDivergenceData baseline_data[] = { + // ncol, ngwv, do_taper, dt, effgw, init + GwdComputeTendenciesFromStressDivergenceData(2, 10, false, 0.4, 0.3, init_data[0]), + GwdComputeTendenciesFromStressDivergenceData(3, 10, false, 0.4, 0.3, init_data[1]), + GwdComputeTendenciesFromStressDivergenceData(4, 10, true , 0.4, 0.3, init_data[2]), + GwdComputeTendenciesFromStressDivergenceData(5, 10, true , 0.4, 0.3, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwdComputeTendenciesFromStressDivergenceData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwdComputeTendenciesFromStressDivergenceData test_data[] = { + GwdComputeTendenciesFromStressDivergenceData(baseline_data[0]), + GwdComputeTendenciesFromStressDivergenceData(baseline_data[1]), + GwdComputeTendenciesFromStressDivergenceData(baseline_data[2]), + GwdComputeTendenciesFromStressDivergenceData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gwd_compute_tendencies_from_stress_divergence(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwdComputeTendenciesFromStressDivergenceData& d_baseline = baseline_data[i]; + GwdComputeTendenciesFromStressDivergenceData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.tau); ++k) { + REQUIRE(d_baseline.total(d_baseline.tau) == d_test.total(d_test.tau)); + REQUIRE(d_baseline.tau[k] == d_test.tau[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.gwut); ++k) { + REQUIRE(d_baseline.total(d_baseline.gwut) == d_test.total(d_test.gwut)); + REQUIRE(d_baseline.gwut[k] == d_test.gwut[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.utgw); ++k) { + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.utgw)); + REQUIRE(d_baseline.utgw[k] == d_test.utgw[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.vtgw)); + REQUIRE(d_baseline.vtgw[k] == d_test.vtgw[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gwd_compute_tendencies_from_stress_divergence_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwdComputeTendenciesFromStressDivergence; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gwd_precalc_rhoi_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gwd_precalc_rhoi_tests.cpp new file mode 100644 index 000000000000..87c50ca68928 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gwd_precalc_rhoi_tests.cpp @@ -0,0 +1,119 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwdPrecalcRhoi : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + GwdPrecalcRhoiData baseline_data[] = { + GwdPrecalcRhoiData(5, 2, 10, .4, init_data[0]), + GwdPrecalcRhoiData(6, 3, 11, .8, init_data[1]), + GwdPrecalcRhoiData(7, 4, 12, 1.4, init_data[2]), + GwdPrecalcRhoiData(8, 5, 13, 2.4, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwdPrecalcRhoiData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwdPrecalcRhoiData test_data[] = { + GwdPrecalcRhoiData(baseline_data[0]), + GwdPrecalcRhoiData(baseline_data[1]), + GwdPrecalcRhoiData(baseline_data[2]), + GwdPrecalcRhoiData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gwd_precalc_rhoi(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwdPrecalcRhoiData& d_baseline = baseline_data[i]; + GwdPrecalcRhoiData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.egwdffi); ++k) { + REQUIRE(d_baseline.total(d_baseline.egwdffi) == d_test.total(d_test.egwdffi)); + REQUIRE(d_baseline.egwdffi[k] == d_test.egwdffi[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.qtgw); ++k) { + REQUIRE(d_baseline.total(d_baseline.qtgw) == d_test.total(d_test.qtgw)); + REQUIRE(d_baseline.qtgw[k] == d_test.qtgw[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.dttdf); ++k) { + REQUIRE(d_baseline.total(d_baseline.dttdf) == d_test.total(d_test.dttdf)); + REQUIRE(d_baseline.dttdf[k] == d_test.dttdf[k]); + REQUIRE(d_baseline.total(d_baseline.dttdf) == d_test.total(d_test.dttke)); + REQUIRE(d_baseline.dttke[k] == d_test.dttke[k]); + REQUIRE(d_baseline.total(d_baseline.dttdf) == d_test.total(d_test.ttgw)); + REQUIRE(d_baseline.ttgw[k] == d_test.ttgw[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gwd_precalc_rhoi_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwdPrecalcRhoi; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_gwd_project_tau_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_gwd_project_tau_tests.cpp new file mode 100644 index 000000000000..bacd1ed3cf80 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_gwd_project_tau_tests.cpp @@ -0,0 +1,107 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestGwdProjectTau : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + GwdProjectTauData baseline_data[] = { + GwdProjectTauData(2, 10, init_data[0]), + GwdProjectTauData(3, 11, init_data[1]), + GwdProjectTauData(4, 12, init_data[2]), + GwdProjectTauData(5, 13, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(GwdProjectTauData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + GwdProjectTauData test_data[] = { + GwdProjectTauData(baseline_data[0]), + GwdProjectTauData(baseline_data[1]), + GwdProjectTauData(baseline_data[2]), + GwdProjectTauData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + gwd_project_tau(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + GwdProjectTauData& d_baseline = baseline_data[i]; + GwdProjectTauData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.taucd); ++k) { + REQUIRE(d_baseline.total(d_baseline.taucd) == d_test.total(d_test.taucd)); + REQUIRE(d_baseline.taucd[k] == d_test.taucd[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("gwd_project_tau_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestGwdProjectTau; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/gw_momentum_energy_conservation_tests.cpp b/components/eamxx/src/physics/gw/tests/gw_momentum_energy_conservation_tests.cpp new file mode 100644 index 000000000000..ac8102513fe2 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/gw_momentum_energy_conservation_tests.cpp @@ -0,0 +1,119 @@ +#include "catch2/catch.hpp" + +#include "share/eamxx_types.hpp" +#include "ekat/ekat_pack.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/gw/gw_functions.hpp" +#include "physics/gw/tests/infra/gw_test_data.hpp" + +#include "gw_unit_tests_common.hpp" + +namespace scream { +namespace gw { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestMomentumEnergyConservation : public UnitWrap::UnitTest::Base { + + void run_bfb() + { + auto engine = Base::get_engine(); + + // Set up init data + GwInit init_data[] = { + // pver, pgwv, dc, orog_only, molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv + GwInit( 72, 20, 0.75, false, false, false, 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , false, true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, false, true , true , 16, 60, 16, .67, 6.28e-5), + GwInit( 72, 20, 0.75, true , true , false, 16, 60, 16, .67, 6.28e-5), + }; + + for (auto& d : init_data) { + d.randomize(engine); + } + + // Set up inputs + MomentumEnergyConservationData baseline_data[] = { + MomentumEnergyConservationData(2, .4, init_data[0]), + MomentumEnergyConservationData(3, .8, init_data[1]), + MomentumEnergyConservationData(4, 1.4, init_data[2]), + MomentumEnergyConservationData(5, 2.4, init_data[3]), + }; + + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(MomentumEnergyConservationData); + + // Generate random input data + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { + d.randomize(engine); + } + + // Create copies of data for use by test. Needs to happen before read calls so that + // inout data is in original state + MomentumEnergyConservationData test_data[] = { + MomentumEnergyConservationData(baseline_data[0]), + MomentumEnergyConservationData(baseline_data[1]), + MomentumEnergyConservationData(baseline_data[2]), + MomentumEnergyConservationData(baseline_data[3]), + }; + + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } + } + + // Get data from test + for (auto& d : test_data) { + momentum_energy_conservation(d); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + for (Int i = 0; i < num_runs; ++i) { + MomentumEnergyConservationData& d_baseline = baseline_data[i]; + MomentumEnergyConservationData& d_test = test_data[i]; + for (Int k = 0; k < d_baseline.total(d_baseline.dudt); ++k) { + REQUIRE(d_baseline.total(d_baseline.dudt) == d_test.total(d_test.dudt)); + REQUIRE(d_baseline.dudt[k] == d_test.dudt[k]); + REQUIRE(d_baseline.total(d_baseline.dudt) == d_test.total(d_test.dvdt)); + REQUIRE(d_baseline.dvdt[k] == d_test.dvdt[k]); + REQUIRE(d_baseline.total(d_baseline.dudt) == d_test.total(d_test.dsdt)); + REQUIRE(d_baseline.dsdt[k] == d_test.dsdt[k]); + } + for (Int k = 0; k < d_baseline.total(d_baseline.utgw); ++k) { + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.utgw)); + REQUIRE(d_baseline.utgw[k] == d_test.utgw[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.vtgw)); + REQUIRE(d_baseline.vtgw[k] == d_test.vtgw[k]); + REQUIRE(d_baseline.total(d_baseline.utgw) == d_test.total(d_test.ttgw)); + REQUIRE(d_baseline.ttgw[k] == d_test.ttgw[k]); + } + + } + } + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + test_data[i].write(Base::m_fid); + } + } + } // run_bfb + +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +namespace { + +TEST_CASE("momentum_energy_conservation_bfb", "[gw]") +{ + using TestStruct = scream::gw::unit_test::UnitWrap::UnitTest::TestMomentumEnergyConservation; + + TestStruct t; + t.run_bfb(); +} + +} // empty namespace diff --git a/components/eamxx/src/physics/gw/tests/infra/CMakeLists.txt b/components/eamxx/src/physics/gw/tests/infra/CMakeLists.txt new file mode 100644 index 000000000000..482df5fd0858 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/infra/CMakeLists.txt @@ -0,0 +1,8 @@ +set(INFRA_SRCS + gw_test_data.cpp + gw_iso_c.f90 +) + +add_library(gw_test_infra ${INFRA_SRCS}) +target_link_libraries(gw_test_infra gw) +target_include_directories(gw_test_infra PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/components/eamxx/src/physics/gw/tests/infra/gw_iso_c.f90 b/components/eamxx/src/physics/gw/tests/infra/gw_iso_c.f90 new file mode 100644 index 000000000000..7dc4ca33bd83 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/infra/gw_iso_c.f90 @@ -0,0 +1,195 @@ +module gw_iso_c + use iso_c_binding + implicit none + +#include "eamxx_config.f" +#ifdef SCREAM_DOUBLE_PRECISION +# define c_real c_double +#else +# define c_real c_float +#endif + +! +! This file contains bridges from scream c++ to gw fortran. +! + +contains + + subroutine gw_init_c(pver_in, pgwv_in, dc_in, cref_in, orographic_only, do_molec_diff_in, tau_0_ubc_in, nbot_molec_in, ktop_in, kbotbg_in, fcrit2_in, kwv_in, gravit_in, rair_in, alpha_in) bind(C) + use gw_common, only : gw_common_init + + integer(kind=c_int) , value, intent(in) :: pver_in, pgwv_in, nbot_molec_in, ktop_in, kbotbg_in + real(kind=c_real) , value, intent(in) :: dc_in, fcrit2_in, kwv_in, gravit_in, rair_in + real(kind=c_real) , intent(in), dimension(-pgwv_in:pgwv_in) :: cref_in + logical(kind=c_bool) , value, intent(in) :: orographic_only, do_molec_diff_in, tau_0_ubc_in + real(kind=c_real) , intent(in), dimension(0:pver_in) :: alpha_in + + character(len=128) :: errstring + + call gw_common_init(pver_in, pgwv_in, dc_in, cref_in, orographic_only, do_molec_diff_in, tau_0_ubc_in, nbot_molec_in, ktop_in, kbotbg_in, fcrit2_in, kwv_in, gravit_in, rair_in, alpha_in, errstring) + end subroutine gw_init_c + + subroutine gwd_compute_tendencies_from_stress_divergence_c(ncol, ngwv, do_taper, dt, effgw, tend_level, lat, dpm, rdpm, c, ubm, t, nm, xv, yv, tau, gwut, utgw, vtgw) bind(C) + use gw_common, only : gwd_compute_tendencies_from_stress_divergence, pver, pgwv + + integer(kind=c_int) , value, intent(in) :: ncol, ngwv + logical(kind=c_bool) , value, intent(in) :: do_taper + real(kind=c_real) , value, intent(in) :: dt, effgw + integer(kind=c_int) , intent(in), dimension(ncol) :: tend_level + real(kind=c_real) , intent(in), dimension(ncol) :: lat, xv, yv + real(kind=c_real) , intent(in), dimension(ncol, pver) :: dpm, rdpm, ubm, t, nm + real(kind=c_real) , intent(in), dimension(ncol, -pgwv:pgwv) :: c + real(kind=c_real) , intent(inout), dimension(ncol, -pgwv:pgwv, 0:pver) :: tau + real(kind=c_real) , intent(out), dimension(ncol, pver, -ngwv:ngwv) :: gwut + real(kind=c_real) , intent(out), dimension(ncol, pver) :: utgw, vtgw + + call gwd_compute_tendencies_from_stress_divergence(ncol, ngwv, do_taper, dt, effgw, tend_level, lat, dpm, rdpm, c, ubm, t, nm, xv, yv, tau, gwut, utgw, vtgw) + end subroutine gwd_compute_tendencies_from_stress_divergence_c + + subroutine gw_prof_c(ncol, cpair, t, pmid, pint, rhoi, ti, nm, ni) bind(C) + use gw_common, only : gw_prof, pver + + integer(kind=c_int) , value, intent(in) :: ncol + real(kind=c_real) , value, intent(in) :: cpair + real(kind=c_real) , intent(in), dimension(ncol, pver) :: t, pmid + real(kind=c_real) , intent(in), dimension(ncol, 0:pver) :: pint + real(kind=c_real) , intent(out), dimension(ncol, 0:pver) :: rhoi, ti, ni + real(kind=c_real) , intent(out), dimension(ncol, pver) :: nm + + call gw_prof(ncol, cpair, t, pmid, pint, rhoi, ti, nm, ni) + end subroutine gw_prof_c + + subroutine momentum_energy_conservation_c(ncol, tend_level, dt, taucd, pint, pdel, u, v, dudt, dvdt, dsdt, utgw, vtgw, ttgw) bind(C) + use gw_common, only : momentum_energy_conservation, pver + + integer(kind=c_int) , value, intent(in) :: ncol + integer(kind=c_int) , intent(in), dimension(ncol) :: tend_level + real(kind=c_real) , value, intent(in) :: dt + real(kind=c_real) , intent(in), dimension(ncol, 0:pver, 4) :: taucd + real(kind=c_real) , intent(in), dimension(ncol, pver+1) :: pint + real(kind=c_real) , intent(in), dimension(ncol, pver) :: pdel, u, v + real(kind=c_real) , intent(inout), dimension(ncol, pver) :: dudt, dvdt, dsdt + real(kind=c_real) , intent(inout), dimension(ncol, pver) :: utgw, vtgw, ttgw + + call momentum_energy_conservation(ncol, tend_level, dt, taucd, pint, pdel, u, v, dudt, dvdt, dsdt, utgw, vtgw, ttgw) + end subroutine momentum_energy_conservation_c + + subroutine gwd_compute_stress_profiles_and_diffusivities_c(ncol, ngwv, src_level, ubi, c, rhoi, ni, kvtt, t, ti, piln, tau) bind(C) + use gw_common, only : gwd_compute_stress_profiles_and_diffusivities, pver, pgwv + + integer(kind=c_int) , value, intent(in) :: ncol, ngwv + integer(kind=c_int) , intent(in), dimension(ncol) :: src_level + real(kind=c_real) , intent(in), dimension(ncol, 0:pver) :: ubi, rhoi, ni, kvtt, ti, piln + real(kind=c_real) , intent(in), dimension(ncol, -pgwv:pgwv) :: c + real(kind=c_real) , intent(in), dimension(ncol, pver) :: t + real(kind=c_real) , intent(inout), dimension(ncol, -pgwv:pgwv, 0:pver) :: tau + + call gwd_compute_stress_profiles_and_diffusivities(ncol, ngwv, src_level, ubi, c, rhoi, ni, kvtt, t, ti, piln, tau) + end subroutine gwd_compute_stress_profiles_and_diffusivities_c + + subroutine gwd_project_tau_c(ncol, ngwv, tend_level, tau, ubi, c, xv, yv, taucd) bind(C) + use gw_common, only : gwd_project_tau, pver, pgwv + + integer(kind=c_int) , value, intent(in) :: ncol, ngwv + integer(kind=c_int) , intent(in), dimension(ncol) :: tend_level + real(kind=c_real) , intent(in), dimension(ncol, -pgwv:pgwv, 0:pver) :: tau + real(kind=c_real) , intent(in), dimension(ncol, 0:pver) :: ubi + real(kind=c_real) , intent(in), dimension(ncol, -pgwv:pgwv) :: c + real(kind=c_real) , intent(in), dimension(ncol) :: xv, yv + real(kind=c_real) , intent(out), dimension(ncol, 0:pver, 4) :: taucd + + call gwd_project_tau(ncol, ngwv, tend_level, tau, ubi, c, xv, yv, taucd) + end subroutine gwd_project_tau_c + + subroutine gwd_precalc_rhoi_c(pcnst, ncol, ngwv, dt, tend_level, pmid, pint, t, gwut, ubm, nm, rdpm, c, q, dse, egwdffi, qtgw, dttdf, dttke, ttgw) bind(C) + use gw_common, only : gwd_precalc_rhoi, pver, pgwv + + integer(kind=c_int) , value, intent(in) :: pcnst, ncol, ngwv + real(kind=c_real) , value, intent(in) :: dt + integer(kind=c_int) , intent(in), dimension(ncol) :: tend_level + real(kind=c_real) , intent(in), dimension(ncol, pver) :: pmid, t, ubm, nm, rdpm, dse + real(kind=c_real) , intent(in), dimension(ncol, 0:pver) :: pint + real(kind=c_real) , intent(in), dimension(ncol, pver, -ngwv:ngwv) :: gwut + real(kind=c_real) , intent(in), dimension(ncol, -pgwv:pgwv) :: c + real(kind=c_real) , intent(in), dimension(ncol, pver, pcnst) :: q + real(kind=c_real) , intent(out), dimension(ncol, 0:pver) :: egwdffi + real(kind=c_real) , intent(out), dimension(ncol, pver, pcnst) :: qtgw + real(kind=c_real) , intent(out), dimension(ncol, pver) :: dttdf, dttke, ttgw + + call gwd_precalc_rhoi(ncol, ngwv, dt, tend_level, pmid, pint, t, gwut, ubm, nm, rdpm, c, q, dse, egwdffi, qtgw, dttdf, dttke, ttgw) + end subroutine gwd_precalc_rhoi_c + + subroutine gw_drag_prof_c(pcnst, ncol, ngwv, src_level, tend_level, do_taper, dt, lat, t, ti, pmid, pint, dpm, rdpm, piln, rhoi, nm, ni, ubm, ubi, xv, yv, effgw, c, kvtt, q, dse, tau, utgw, vtgw, ttgw, qtgw, taucd, egwdffi, gwut, dttdf, dttke) bind(C) + use gw_common, only : gw_drag_prof, pver, pgwv + + integer(kind=c_int) , value, intent(in) :: pcnst, ncol, ngwv + integer(kind=c_int) , intent(in), dimension(ncol) :: src_level, tend_level + logical(kind=c_bool) , value, intent(in) :: do_taper + real(kind=c_real) , value, intent(in) :: dt, effgw + real(kind=c_real) , intent(in), dimension(ncol) :: lat, xv, yv + real(kind=c_real) , intent(in), dimension(ncol, pver) :: t, pmid, dpm, rdpm, nm, ubm, dse + real(kind=c_real) , intent(in), dimension(ncol, 0:pver) :: ti, pint, piln, rhoi, ni, ubi, kvtt + real(kind=c_real) , intent(in), dimension(ncol, -pgwv:pgwv) :: c + real(kind=c_real) , intent(in), dimension(ncol, pver, pcnst) :: q + real(kind=c_real) , intent(inout), dimension(ncol, -pgwv:pgwv, 0:pver) :: tau + real(kind=c_real) , intent(out), dimension(ncol, pver) :: utgw, vtgw, ttgw, dttdf, dttke + real(kind=c_real) , intent(out), dimension(ncol, pver, pcnst) :: qtgw + real(kind=c_real) , intent(out), dimension(ncol, 0:pver, 4) :: taucd + real(kind=c_real) , intent(out), dimension(ncol, 0:pver) :: egwdffi + real(kind=c_real) , intent(out), dimension(ncol, pver, -ngwv:ngwv) :: gwut + + call gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, lat, t, ti, pmid, pint, dpm, rdpm, piln, rhoi, nm, ni, ubm, ubi, xv, yv, effgw, c, kvtt, q, dse, tau, utgw, vtgw, ttgw, qtgw, taucd, egwdffi, gwut, dttdf, dttke) + end subroutine gw_drag_prof_c + + subroutine gw_front_init_c(taubgnd, frontgfc_in, kfront_in) bind(C) + use gw_front, only : gw_front_init + + real(kind=c_real) , value, intent(in) :: taubgnd, frontgfc_in + integer(kind=c_int) , value, intent(in) :: kfront_in + + character(len=128) :: errstring + + call gw_front_init(taubgnd, frontgfc_in, kfront_in, errstring) + end subroutine gw_front_init_c + + subroutine gw_front_project_winds_c(ncol, kbot, u, v, xv, yv, ubm, ubi) bind(C) + use gw_common, only : pver + use gw_front, only : gw_front_project_winds + + integer(kind=c_int) , value, intent(in) :: ncol, kbot + real(kind=c_real) , intent(in), dimension(ncol, pver) :: u, v + real(kind=c_real) , intent(out), dimension(ncol) :: xv, yv + real(kind=c_real) , intent(out), dimension(ncol, pver) :: ubm + real(kind=c_real) , intent(out), dimension(ncol, 0:pver) :: ubi + + call gw_front_project_winds(ncol, kbot, u, v, xv, yv, ubm, ubi) + end subroutine gw_front_project_winds_c + + subroutine gw_front_gw_sources_c(ncol, ngwv, kbot, frontgf, tau) bind(C) + use gw_common, only : pver, pgwv + use gw_front, only : gw_front_gw_sources + + integer(kind=c_int) , value, intent(in) :: ncol, ngwv, kbot + real(kind=c_real) , intent(in), dimension(ncol, pver) :: frontgf + real(kind=c_real) , intent(out), dimension(ncol, -pgwv:pgwv, 0:pver) :: tau + + call gw_front_gw_sources(ncol, ngwv, kbot, frontgf, tau) + end subroutine gw_front_gw_sources_c + + subroutine gw_cm_src_c(ncol, ngwv, kbot, u, v, frontgf, src_level, tend_level, tau, ubm, ubi, xv, yv, c) bind(C) + use gw_common, only : pver, pgwv + use gw_front, only : gw_cm_src + + integer(kind=c_int) , value, intent(in) :: ncol, ngwv, kbot + real(kind=c_real) , intent(in), dimension(ncol, pver) :: u, v + real(kind=c_real) , intent(in), dimension(ncol, pver) :: frontgf + integer(kind=c_int) , intent(out), dimension(ncol) :: src_level, tend_level + real(kind=c_real) , intent(out), dimension(ncol, -pgwv:pgwv, 0:pver) :: tau + real(kind=c_real) , intent(out), dimension(ncol, pver) :: ubm + real(kind=c_real) , intent(out), dimension(ncol, 0:pver) :: ubi + real(kind=c_real) , intent(out), dimension(ncol) :: xv, yv + real(kind=c_real) , intent(out), dimension(ncol, -pgwv:pgwv) :: c + + call gw_cm_src(ncol, ngwv, kbot, u, v, frontgf, src_level, tend_level, tau, ubm, ubi, xv, yv, c) + end subroutine gw_cm_src_c +end module gw_iso_c diff --git a/components/eamxx/src/physics/gw/tests/infra/gw_test_data.cpp b/components/eamxx/src/physics/gw/tests/infra/gw_test_data.cpp new file mode 100644 index 000000000000..34696c292ce1 --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/infra/gw_test_data.cpp @@ -0,0 +1,146 @@ +#include "gw_test_data.hpp" +#include "ekat/kokkos/ekat_kokkos_types.hpp" + +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "ekat/ekat_pack_kokkos.hpp" +#include "ekat/ekat_assert.hpp" + +#include + +using scream::Real; +using scream::Int; + +// +// A C++ interface to gw fortran calls and vice versa +// + +namespace scream { +namespace gw { + +using GWF = Functions; +using GWC = typename GWF::C; + +extern "C" { + +void gwd_compute_tendencies_from_stress_divergence_c(Int ncol, Int ngwv, bool do_taper, Real dt, Real effgw, Int* tend_level, Real* lat, Real* dpm, Real* rdpm, Real* c, Real* ubm, Real* t, Real* nm, Real* xv, Real* yv, Real* tau, Real* gwut, Real* utgw, Real* vtgw); + +void gw_init_c(Int pver_in, Int pgwv_in, Real dc_in, Real* cref_in, bool orographic_only, bool do_molec_diff_in, bool tau_0_ubc_in, Int nbot_molec_in, Int ktop_in, Int kbotbg_in, Real fcrit2_in, Real kwv_in, Real gravit_in, Real rair_in, Real* alpha_in); + +void gw_prof_c(Int ncol, Real cpair, Real* t, Real* pmid, Real* pint, Real* rhoi, Real* ti, Real* nm, Real* ni); + +void momentum_energy_conservation_c(Int ncol, Int* tend_level, Real dt, Real* taucd, Real* pint, Real* pdel, Real* u, Real* v, Real* dudt, Real* dvdt, Real* dsdt, Real* utgw, Real* vtgw, Real* ttgw); + +void gwd_compute_stress_profiles_and_diffusivities_c(Int ncol, Int ngwv, Int* src_level, Real* ubi, Real* c, Real* rhoi, Real* ni, Real* kvtt, Real* t, Real* ti, Real* piln, Real* tau); + +void gwd_project_tau_c(Int ncol, Int ngwv, Int* tend_level, Real* tau, Real* ubi, Real* c, Real* xv, Real* yv, Real* taucd); + +void gwd_precalc_rhoi_c(Int pcnst, Int ncol, Int ngwv, Real dt, Int* tend_level, Real* pmid, Real* pint, Real* t, Real* gwut, Real* ubm, Real* nm, Real* rdpm, Real* c, Real* q, Real* dse, Real* egwdffi, Real* qtgw, Real* dttdf, Real* dttke, Real* ttgw); + +void gw_drag_prof_c(Int pcnst, Int ncol, Int ngwv, Int* src_level, Int* tend_level, bool do_taper, Real dt, Real* lat, Real* t, Real* ti, Real* pmid, Real* pint, Real* dpm, Real* rdpm, Real* piln, Real* rhoi, Real* nm, Real* ni, Real* ubm, Real* ubi, Real* xv, Real* yv, Real effgw, Real* c, Real* kvtt, Real* q, Real* dse, Real* tau, Real* utgw, Real* vtgw, Real* ttgw, Real* qtgw, Real* taucd, Real* egwdffi, Real* gwut, Real* dttdf, Real* dttke); + +void gw_front_init_c(Real taubgnd, Real frontgfc_in, Int kfront_in); + +void gw_front_project_winds_c(Int ncol, Int kbot, Real* u, Real* v, Real* xv, Real* yv, Real* ubm, Real* ubi); + +void gw_front_gw_sources_c(Int ncol, Int ngwv, Int kbot, Real* frontgf, Real* tau); + +void gw_cm_src_c(Int ncol, Int ngwv, Int kbot, Real* u, Real* v, Real* frontgf, Int* src_level, Int* tend_level, Real* tau, Real* ubm, Real* ubi, Real* xv, Real* yv, Real* c); + +} // extern "C" : end _c decls + +// Wrapper around gw_init +void gw_init(GwInit& init) +{ + gw_init_c(init.pver, init.pgwv, init.dc, init.cref, init.orographic_only, init.do_molec_diff, init.tau_0_ubc, init.nbot_molec, init.ktop, init.kbotbg, init.fcrit2, init.kwv, GWC::gravit, GWC::Rair, init.alpha); +} + +void gwd_compute_tendencies_from_stress_divergence(GwdComputeTendenciesFromStressDivergenceData& d) +{ + gw_init(d.init); + d.transpose(); + gwd_compute_tendencies_from_stress_divergence_c(d.ncol, d.ngwv, d.do_taper, d.dt, d.effgw, d.tend_level, d.lat, d.dpm, d.rdpm, d.c, d.ubm, d.t, d.nm, d.xv, d.yv, d.tau, d.gwut, d.utgw, d.vtgw); + d.transpose(); +} + +void gw_prof(GwProfData& d) +{ + gw_init(d.init); + d.transpose(); + gw_prof_c(d.ncol, d.cpair, d.t, d.pmid, d.pint, d.rhoi, d.ti, d.nm, d.ni); + d.transpose(); +} + +void momentum_energy_conservation(MomentumEnergyConservationData& d) +{ + gw_init(d.init); + d.transpose(); + momentum_energy_conservation_c(d.ncol, d.tend_level, d.dt, d.taucd, d.pint, d.pdel, d.u, d.v, d.dudt, d.dvdt, d.dsdt, d.utgw, d.vtgw, d.ttgw); + d.transpose(); +} + +void gwd_compute_stress_profiles_and_diffusivities(GwdComputeStressProfilesAndDiffusivitiesData& d) +{ + gw_init(d.init); + d.transpose(); + gwd_compute_stress_profiles_and_diffusivities_c(d.ncol, d.ngwv, d.src_level, d.ubi, d.c, d.rhoi, d.ni, d.kvtt, d.t, d.ti, d.piln, d.tau); + d.transpose(); +} + +void gwd_project_tau(GwdProjectTauData& d) +{ + gw_init(d.init); + d.transpose(); + gwd_project_tau_c(d.ncol, d.ngwv, d.tend_level, d.tau, d.ubi, d.c, d.xv, d.yv, d.taucd); + d.transpose(); +} + +void gwd_precalc_rhoi(GwdPrecalcRhoiData& d) +{ + gw_init(d.init); + d.transpose(); + gwd_precalc_rhoi_c(d.pcnst, d.ncol, d.ngwv, d.dt, d.tend_level, d.pmid, d.pint, d.t, d.gwut, d.ubm, d.nm, d.rdpm, d.c, d.q, d.dse, d.egwdffi, d.qtgw, d.dttdf, d.dttke, d.ttgw); + d.transpose(); +} + +void gw_drag_prof(GwDragProfData& d) +{ + gw_init(d.init); + d.transpose(); + gw_drag_prof_c(d.pcnst, d.ncol, d.ngwv, d.src_level, d.tend_level, d.do_taper, d.dt, d.lat, d.t, d.ti, d.pmid, d.pint, d.dpm, d.rdpm, d.piln, d.rhoi, d.nm, d.ni, d.ubm, d.ubi, d.xv, d.yv, d.effgw, d.c, d.kvtt, d.q, d.dse, d.tau, d.utgw, d.vtgw, d.ttgw, d.qtgw, d.taucd, d.egwdffi, d.gwut, d.dttdf, d.dttke); + d.transpose(); +} + +void gw_front_init(GwFrontInitData& d) +{ + gw_init(d.init); + gw_front_init_c(d.taubgnd, d.frontgfc_in, d.kfront_in); +} + +void gw_front_project_winds(GwFrontProjectWindsData& d) +{ + gw_front_init(d.init); + d.transpose(); + gw_front_project_winds_c(d.ncol, d.kbot, d.u, d.v, d.xv, d.yv, d.ubm, d.ubi); + d.transpose(); +} + +void gw_front_gw_sources(GwFrontGwSourcesData& d) +{ + gw_front_init(d.init); + d.transpose(); + gw_front_gw_sources_c(d.ncol, d.ngwv, d.kbot, d.frontgf, d.tau); + d.transpose(); +} + +void gw_cm_src(GwCmSrcData& d) +{ + gw_front_init(d.init); + d.transpose(); + gw_cm_src_c(d.ncol, d.ngwv, d.kbot, d.u, d.v, d.frontgf, d.src_level, d.tend_level, d.tau, d.ubm, d.ubi, d.xv, d.yv, d.c); + d.transpose(); +} + +// end _c impls + +} // namespace gw +} // namespace scream diff --git a/components/eamxx/src/physics/gw/tests/infra/gw_test_data.hpp b/components/eamxx/src/physics/gw/tests/infra/gw_test_data.hpp new file mode 100644 index 000000000000..e81b2b2cbf6b --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/infra/gw_test_data.hpp @@ -0,0 +1,420 @@ +#ifndef SCREAM_GW_FUNCTIONS_F90_HPP +#define SCREAM_GW_FUNCTIONS_F90_HPP + +#include "physics/gw/gw_functions.hpp" +#include "physics/share/physics_test_data.hpp" +#include "share/eamxx_types.hpp" + +#include +#include +#include // for shared_ptr + +// +// Bridge functions to call fortran version of gw functions from C++ +// + +namespace scream { +namespace gw { + +// The Data struct is special; it is used to do gw initialization, which +// must be called before any gw function. +struct GwInit : public PhysicsTestData { + // Inputs + Int pver, pgwv; + Real dc; + bool orographic_only, do_molec_diff, tau_0_ubc; + Int nbot_molec, ktop, kbotbg; + Real fcrit2, kwv; + Real *cref, *alpha; + + GwInit(Int pver_, Int pgwv_, Real dc_, bool orographic_only_, bool do_molec_diff_, bool tau_0_ubc_, Int nbot_molec_, Int ktop_, Int kbotbg_, Real fcrit2_, Real kwv_) : + PhysicsTestData({ + {pgwv_*2 + 1}, + {pver_ + 1} + }, + { + {&cref}, + {&alpha} + }), + pver(pver_), pgwv(pgwv_), dc(dc_), orographic_only(orographic_only_), do_molec_diff(do_molec_diff_), tau_0_ubc(tau_0_ubc_), nbot_molec(nbot_molec_), ktop(ktop_), kbotbg(kbotbg_), fcrit2(fcrit2_), kwv(kwv_) + { + // Assert valid init data? + assert(ktop <= pver); + assert(kbotbg >= 0); + assert(kbotbg <= ktop); + assert(pgwv > 0); + assert(nbot_molec >= 0); + assert(nbot_molec <= ktop); + } + + PTD_STD_DEF(GwInit, 11, pver, pgwv, dc, orographic_only, do_molec_diff, tau_0_ubc, nbot_molec, ktop, kbotbg, fcrit2, kwv); +}; + +struct GwdComputeTendenciesFromStressDivergenceData : public PhysicsTestData { + // Inputs + Int ncol, ngwv; + bool do_taper; + Real dt, effgw; + Int *tend_level; + Real *lat, *dpm, *rdpm, *c, *ubm, *t, *nm, *xv, *yv; + GwInit init; + + // Inputs/Outputs + Real *tau; + + // Outputs + Real *gwut, *utgw, *vtgw; + + GwdComputeTendenciesFromStressDivergenceData(Int ncol_, Int ngwv_, bool do_taper_, Real dt_, Real effgw_, GwInit init_) : + PhysicsTestData({ + {ncol_}, + {ncol_, init_.pver}, + {ncol_, 2*init_.pgwv + 1}, + {ncol_, 2*init_.pgwv + 1, init_.pver + 1}, + {ncol_, init_.pver, 2*ngwv_ + 1}, + {ncol_} + }, + { + {&lat, &xv, &yv}, + {&dpm, &rdpm, &ubm, &t, &nm, &utgw, &vtgw}, + {&c}, + {&tau}, + {&gwut} + }, + { + {&tend_level} + }), + ncol(ncol_), ngwv(ngwv_), do_taper(do_taper_), dt(dt_), effgw(effgw_), init(init_) + {} + + PTD_STD_DEF_INIT(GwdComputeTendenciesFromStressDivergenceData, 5, ncol, ngwv, do_taper, dt, effgw); +}; + +struct GwProfData : public PhysicsTestData { + // Inputs + Int ncol; + Real cpair; + Real *t, *pmid, *pint; + GwInit init; + + // Outputs + Real *rhoi, *ti, *nm, *ni; + + GwProfData(Int ncol_, Real cpair_, GwInit init_) : + PhysicsTestData({ + {ncol_, init_.pver}, + {ncol_, init_.pver + 1} + }, + { + {&t, &pmid, &nm}, + {&pint, &rhoi, &ti, &ni} + }), + ncol(ncol_), cpair(cpair_), init(init_) + {} + + PTD_STD_DEF_INIT(GwProfData, 2, ncol, cpair); +}; + +struct MomentumEnergyConservationData : public PhysicsTestData { + // Inputs + Int ncol; + Int *tend_level; + Real dt; + Real *taucd, *pint, *pdel, *u, *v; + GwInit init; + + // Inputs/Outputs + Real *dudt, *dvdt, *dsdt, *utgw, *vtgw, *ttgw; + + MomentumEnergyConservationData(Int ncol_, Real dt_, GwInit init_) : + PhysicsTestData({ + {ncol_, init_.pver + 1, 4}, + {ncol_, init_.pver + 1}, + {ncol_, init_.pver}, + {ncol_} + }, + { + {&taucd}, + {&pint}, + {&pdel, &u, &v, &utgw, &vtgw, &ttgw, &dudt, &dvdt, &dsdt} + }, + { + {&tend_level} + }), + ncol(ncol_), dt(dt_), init(init_) + {} + + PTD_STD_DEF_INIT(MomentumEnergyConservationData, 2, ncol, dt); +}; + +struct GwdComputeStressProfilesAndDiffusivitiesData : public PhysicsTestData { + // Inputs + Int ncol, ngwv; + Int *src_level; + Real *ubi, *c, *rhoi, *ni, *kvtt, *t, *ti, *piln; + GwInit init; + + // Inputs/Outputs + Real *tau; + + GwdComputeStressProfilesAndDiffusivitiesData(Int ncol_, Int ngwv_, GwInit init_) : + PhysicsTestData({ + {ncol_, init_.pver + 1}, + {ncol_, init_.pgwv*2 + 1}, + {ncol_, init_.pver}, + {ncol_, init_.pgwv*2 + 1, init_.pver + 1}, + {ncol_} + }, + { + {&ubi, &rhoi, &ni, &kvtt, &ti, &piln}, + {&c}, + {&t}, + {&tau} + }, + { + {&src_level} + }), + ncol(ncol_), ngwv(ngwv_), init(init_) + {} + + PTD_STD_DEF_INIT(GwdComputeStressProfilesAndDiffusivitiesData, 2, ncol, ngwv); +}; + +struct GwdProjectTauData : public PhysicsTestData { + // Inputs + Int ncol, ngwv; + Int *tend_level; + Real *tau, *ubi, *c, *xv, *yv; + GwInit init; + + // Outputs + Real *taucd; + + GwdProjectTauData(Int ncol_, Int ngwv_, GwInit init_) : + PhysicsTestData({ + {ncol_, init_.pgwv*2 + 1, init_.pver + 1}, + {ncol_, init_.pver + 1}, + {ncol_, init_.pgwv*2 + 1}, + {ncol_}, + {ncol_, init_.pver + 1, 4}, + {ncol_} + }, + { + {&tau}, + {&ubi}, + {&c}, + {&xv, &yv}, + {&taucd} + }, + { + {&tend_level} + }), + ncol(ncol_), ngwv(ngwv_), init(init_) + {} + + PTD_STD_DEF_INIT(GwdProjectTauData, 2, ncol, ngwv); +}; + +struct GwdPrecalcRhoiData : public PhysicsTestData { + // Inputs + Int pcnst, ncol, ngwv; + Real dt; + Int *tend_level; + Real *pmid, *pint, *t, *gwut, *ubm, *nm, *rdpm, *c, *q, *dse; + GwInit init; + + // Outputs + Real *egwdffi, *qtgw, *dttdf, *dttke, *ttgw; + + GwdPrecalcRhoiData(Int pcnst_, Int ncol_, Int ngwv_, Real dt_, GwInit init_) : + PhysicsTestData({ + {ncol_, init_.pver}, + {ncol_, init_.pver + 1}, + {ncol_, init_.pver, ngwv_*2 + 1}, + {ncol_, init_.pgwv*2 + 1}, + {ncol_, init_.pver, pcnst_}, + {ncol_} + }, + { + {&pmid, &t, &ubm, &nm, &rdpm, &dse, &dttdf, &dttke, &ttgw}, + {&pint, &egwdffi}, + {&gwut}, + {&c}, + {&q, &qtgw} + }, + { + {&tend_level} + }), + pcnst(pcnst_), ncol(ncol_), ngwv(ngwv_), dt(dt_), init(init_) + {} + + PTD_STD_DEF_INIT(GwdPrecalcRhoiData, 4, pcnst, ncol, ngwv, dt); +}; + +struct GwDragProfData : public PhysicsTestData { + // Inputs + Int pcnst, ncol, ngwv; + Int *src_level, *tend_level; + bool do_taper; + Real dt, effgw; + Real *lat, *t, *ti, *pmid, *pint, *dpm, *rdpm, *piln, *rhoi, *nm, *ni, *ubm, *ubi, *xv, *yv, *c, *kvtt, *q, *dse; + GwInit init; + + // Inputs/Outputs + Real *tau; + + // Outputs + Real *utgw, *vtgw, *ttgw, *qtgw, *taucd, *egwdffi, *gwut, *dttdf, *dttke; + + GwDragProfData(Int pcnst_, Int ncol_, Int ngwv_, bool do_taper_, Real dt_, Real effgw_, GwInit init_) : + PhysicsTestData({ + {ncol_}, + {ncol_, init_.pver}, + {ncol_, init_.pver + 1}, + {ncol_, init_.pgwv*2 + 1}, + {ncol_, init_.pver, pcnst_}, + {ncol_, init_.pgwv*2 + 1, init_.pver + 1}, + {ncol_, init_.pver + 1, 4}, + {ncol_, init_.pver, ngwv_*2 + 1}, + {ncol_} + }, + { + {&lat, &xv, &yv}, + {&t, &pmid, &dpm, &rdpm, &nm, &ubm, &dse, &utgw, &vtgw, &ttgw, &dttdf, &dttke}, + {&ti, &pint, &piln, &rhoi, &ni, &ubi, &kvtt, &egwdffi}, + {&c}, + {&q, &qtgw}, + {&tau}, + {&taucd}, + {&gwut} + }, + { + {&src_level, &tend_level} + }), + pcnst(pcnst_), ncol(ncol_), ngwv(ngwv_), do_taper(do_taper_), dt(dt_), effgw(effgw_), init(init_) + {} + + PTD_STD_DEF_INIT(GwDragProfData, 6, pcnst, ncol, ngwv, do_taper, dt, effgw); +}; + +struct GwFrontInitData : public PhysicsTestData{ + // Inputs + Real taubgnd, frontgfc_in; + Int kfront_in; + GwInit init; + + GwFrontInitData(Real taubgnd_, Real frontgfc_in_, Int kfront_in_, GwInit init_) : + PhysicsTestData({}, {}, {}), + taubgnd(taubgnd_), + frontgfc_in(frontgfc_in_), + kfront_in(kfront_in_), + init(init_) + {} + + PTD_STD_DEF_INIT(GwFrontInitData, 3, taubgnd, frontgfc_in, kfront_in); +}; + +struct GwFrontProjectWindsData : public PhysicsTestData { + // Inputs + Int ncol, kbot; + Real *u, *v; + GwFrontInitData init; + + // Outputs + Real *xv, *yv, *ubm, *ubi; + + GwFrontProjectWindsData(Int ncol_, Int kbot_, GwFrontInitData init_) : + PhysicsTestData({ + {ncol_, init_.init.pver}, + {ncol_}, + {ncol_, init_.init.pver + 1} + }, + { + {&u, &v, &ubm}, + {&xv, &yv}, + {&ubi} + }), + ncol(ncol_), kbot(kbot_), init(init_) + {} + + PTD_STD_DEF_INIT(GwFrontProjectWindsData, 2, ncol, kbot); +}; + +struct GwFrontGwSourcesData : public PhysicsTestData { + // Inputs + Int ncol, ngwv, kbot; + Real *frontgf; + GwFrontInitData init; + + // Outputs + Real *tau; + + GwFrontGwSourcesData(Int ncol_, Int ngwv_, Int kbot_, GwFrontInitData init_) : + PhysicsTestData({ + {ncol_, init_.init.pver}, + {ncol_, init_.init.pgwv*2 + 1, init_.init.pver + 1} + }, + { + {&frontgf}, + {&tau} + }), + ncol(ncol_), ngwv(ngwv_), kbot(kbot_), init(init_) + {} + + PTD_STD_DEF_INIT(GwFrontGwSourcesData, 3, ncol, ngwv, kbot); +}; + +struct GwCmSrcData : public PhysicsTestData { + // Inputs + Int ncol, ngwv, kbot; + Real *u, *v, *frontgf; + GwFrontInitData init; + + // Outputs + Int *src_level, *tend_level; + Real *tau, *ubm, *ubi, *xv, *yv, *c; + + GwCmSrcData(Int ncol_, Int ngwv_, Int kbot_, GwFrontInitData init_) : + PhysicsTestData({ + {ncol_, init_.init.pver}, + {ncol_, init_.init.pgwv*2 + 1, init_.init.pver + 1}, + {ncol_, init_.init.pver + 1}, + {ncol_}, + {ncol_, init_.init.pgwv*2 + 1}, + {ncol_} + }, + { + {&u, &v, &ubm, &frontgf}, + {&tau}, + {&ubi}, + {&xv, &yv}, + {&c} + }, + { + {&src_level, &tend_level} + }), + ncol(ncol_), ngwv(ngwv_), kbot(kbot_), init(init_) + {} + + PTD_STD_DEF_INIT(GwCmSrcData, 3, ncol, ngwv, kbot); +}; + +// Glue functions to call fortran from from C++ with the Data struct +void gwd_compute_tendencies_from_stress_divergence(GwdComputeTendenciesFromStressDivergenceData& d); +void gw_prof(GwProfData& d); +void momentum_energy_conservation(MomentumEnergyConservationData& d); +void gwd_compute_stress_profiles_and_diffusivities(GwdComputeStressProfilesAndDiffusivitiesData& d); +void gwd_project_tau(GwdProjectTauData& d); +void gwd_precalc_rhoi(GwdPrecalcRhoiData& d); +void gw_drag_prof(GwDragProfData& d); +void gw_front_project_winds(GwFrontProjectWindsData& d); +void gw_front_gw_sources(GwFrontGwSourcesData& d); +void gw_cm_src(GwCmSrcData& d); + +extern "C" { // _f function decls +} + +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/gw/tests/infra/gw_unit_tests_common.hpp b/components/eamxx/src/physics/gw/tests/infra/gw_unit_tests_common.hpp new file mode 100644 index 000000000000..164749ea1eaa --- /dev/null +++ b/components/eamxx/src/physics/gw/tests/infra/gw_unit_tests_common.hpp @@ -0,0 +1,96 @@ +#ifndef GW_UNIT_TESTS_COMMON_HPP +#define GW_UNIT_TESTS_COMMON_HPP + +#include "share/eamxx_types.hpp" +#include "share/util/eamxx_setup_random_test.hpp" +#include "gw_functions.hpp" +#include "ekat/util/ekat_test_utils.hpp" +#include "gw_test_data.hpp" + +#include +#include + +namespace scream { +namespace gw { +namespace unit_test { + +/* + * Unit test infrastructure for gw unit tests. + * + * gw entities can friend scream::gw::unit_test::UnitWrap to give unit tests + * access to private members. + * + * All unit test impls should be within an inner struct of UnitWrap::UnitTest for + * easy access to useful types. + */ + +struct UnitWrap { + + template + struct UnitTest : public KokkosTypes { + + using Device = D; + using MemberType = typename KokkosTypes::MemberType; + using TeamPolicy = typename KokkosTypes::TeamPolicy; + using RangePolicy = typename KokkosTypes::RangePolicy; + using ExeSpace = typename KokkosTypes::ExeSpace; + + template + using view_1d = typename KokkosTypes::template view_1d; + template + using view_2d = typename KokkosTypes::template view_2d; + template + using view_3d = typename KokkosTypes::template view_3d; + + template + using uview_1d = typename ekat::template Unmanaged >; + + using Functions = scream::gw::Functions; + // using view_ice_table = typename Functions::view_ice_table; + // using view_collect_table = typename Functions::view_collect_table; + // using view_1d_table = typename Functions::view_1d_table; + // using view_2d_table = typename Functions::view_2d_table; + // using view_dnu_table = typename Functions::view_dnu_table; + using Scalar = typename Functions::Scalar; + using Spack = typename Functions::Spack; + // using Pack = typename Functions::Pack; + // using IntSmallPack = typename Functions::IntSmallPack; + // using Smask = typename Functions::Smask; + // using TableIce = typename Functions::TableIce; + // using TableRain = typename Functions::TableRain; + // using Table3 = typename Functions::Table3; + // using C = typename Functions::C; + + static constexpr Int max_pack_size = 16; + static constexpr Int num_test_itrs = max_pack_size / Spack::n; + + struct Base : public UnitBase { + + Base() : + UnitBase() + { + // Functions::gw_init(); // just in case there is ever global gw data + } + + ~Base() = default; + }; + + // Put struct decls here + struct TestGwdComputeTendenciesFromStressDivergence; + struct TestGwProf; + struct TestMomentumEnergyConservation; + struct TestGwdComputeStressProfilesAndDiffusivities; + struct TestGwdProjectTau; + struct TestGwdPrecalcRhoi; + struct TestGwDragProf; + struct TestGwFrontProjectWinds; + struct TestGwFrontGwSources; + struct TestGwCmSrc; + }; // UnitWrap +}; + +} // namespace unit_test +} // namespace gw +} // namespace scream + +#endif diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp index aca7aa93b894..5698889c9018 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp @@ -61,7 +61,7 @@ class IOPForcing : public scream::AtmosphereProcess AtmosphereProcessType type () const { return AtmosphereProcessType::Physics; } // The name of the subcomponent - std::string name () const { return "iop"; } + std::string name () const { return "iop_forcing"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/physics/mam/eamxx_mam_aci_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_aci_process_interface.cpp index ec36887583c1..fbea6536ebd8 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_aci_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_aci_process_interface.cpp @@ -87,6 +87,11 @@ void MAMAci::set_grids( add_tracers_wet_atm(); add_fields_dry_atm(); + // cloud liquid number mixing ratio [1/kg] + // NOTE: Advected by dynamics only, ACI vertically mixes nc + // Updates to nc from ACI are applied in P3 microphysics + add_tracer("nc", grid_, n_unit, 1, TracerAdvection::DynamicsOnly); + constexpr auto m2 = pow(m, 2); constexpr auto s2 = pow(s, 2); diff --git a/components/eamxx/src/physics/mam/eamxx_mam_constituent_fluxes_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_constituent_fluxes_interface.cpp index a9207231ba08..70926eed5a49 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_constituent_fluxes_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_constituent_fluxes_interface.cpp @@ -36,6 +36,11 @@ void MAMConstituentFluxes::set_grids( add_tracers_wet_atm(); add_fields_dry_atm(); + + // cloud liquid number mixing ratio [1/kg] + auto n_unit = 1 / kg; // units of number mixing ratios of tracers + add_tracer("nc", grid_, n_unit); + static constexpr Units m2(m * m, "m2"); // Constituent fluxes at the surface (gasses and aerosols) //[units: kg/m2/s (mass) or #/m2/s (number)] diff --git a/components/eamxx/src/physics/mam/eamxx_mam_dry_deposition_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_dry_deposition_process_interface.cpp index 000359cb31e1..a767ca4f3753 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_dry_deposition_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_dry_deposition_process_interface.cpp @@ -52,7 +52,7 @@ void MAMDryDep::set_grids( // layout for 2D (ncol, pcnst) constexpr int pcnst = mam4::aero_model::pcnst; const FieldLayout vector2d_pcnst = - grid_->get_2d_vector_layout(pcnst, "num_phys_constants"); + grid_->get_2d_vector_layout(pcnst, "num_phys_constituents"); const FieldLayout vector2d_class = grid_->get_2d_vector_layout(n_land_type, "class"); @@ -73,6 +73,10 @@ void MAMDryDep::set_grids( add_tracers_wet_atm(); add_fields_dry_atm(); + + // cloud liquid number mixing ratio [1/kg] + auto n_unit = 1 / kg; // units of number mixing ratios of tracers + add_tracer("nc", grid_, n_unit); static constexpr auto m2 = m * m; static constexpr auto s2 = s * s; diff --git a/components/eamxx/src/physics/mam/eamxx_mam_generic_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_generic_process_interface.cpp index 93b84dab78a3..a372f5c21a81 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_generic_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_generic_process_interface.cpp @@ -366,9 +366,6 @@ void MAMGenericInterface::add_tracers_wet_atm() { // cloud ice mass mixing ratio [kg/kg] add_tracer("qi", grid_, q_unit); - // cloud liquid number mixing ratio [1/kg] - add_tracer("nc", grid_, n_unit); - // cloud ice number mixing ratio [1/kg] add_tracer("ni", grid_, n_unit); } diff --git a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp index c1f9633c3f4e..e9db03757352 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp @@ -89,6 +89,10 @@ void MAMMicrophysics::set_grids( add_tracers_wet_atm(); add_fields_dry_atm(); + // cloud liquid number mixing ratio [1/kg] + auto n_unit = 1 / kg; // units of number mixing ratios of tracers + add_tracer("nc", grid_, n_unit); + constexpr auto m2 = pow(m, 2); constexpr auto s2 = pow(s, 2); @@ -178,6 +182,15 @@ void MAMMicrophysics::set_grids( add_field("constituent_fluxes", scalar2d_pcnst, kg / m2 / s, grid_name); + // Number of externally forced chemical species + constexpr int extcnt = mam4::gas_chemistry::extcnt; + + FieldLayout scalar3d_extcnt = grid_->get_3d_vector_layout(true, extcnt, "ext_cnt"); + + // Register computed fields for external forcing + // - extfrc: 3D instantaneous forcing rate [kg/m³/s] + add_field("mam4_external_forcing", scalar3d_extcnt, kg / m3 / s, grid_name); + // Creating a Linoz reader and setting Linoz parameters involves reading data // from a file and configuring the necessary parameters for the Linoz model. { @@ -292,7 +305,6 @@ void MAMMicrophysics::set_grids( elevated_emis_data_.push_back(data_tracer); } // var_name elevated emissions int i = 0; - int offset_emis_ver = 0; for(const auto &var_name : extfrc_lst_) { const auto file_name = elevated_emis_file_name_[var_name]; const auto var_names = elevated_emis_var_names_[var_name]; @@ -312,19 +324,17 @@ void MAMMicrophysics::set_grids( elevated_emis_data_[i].init(num_cols_io_emis, num_levs_io_emis, nvars); elevated_emis_data_[i].allocate_temporary_views(); forcings_[i].file_alt_data = elevated_emis_data_[i].has_altitude_; + EKAT_REQUIRE_MSG( + nvars <= int(mam_coupling::MAX_SECTION_NUM_FORCING), + "Error! Number of sections is bigger than " + "MAX_SECTION_NUM_FORCING. Increase the " + "MAX_SECTION_NUM_FORCING in tracer_reader_utils.hpp \n"); for(int isp = 0; isp < nvars; ++isp) { - forcings_[i].offset = offset_emis_ver; - elevated_emis_output_[isp + offset_emis_ver] = + forcings_[i].fields[isp] = view_2d("elevated_emis_output_", ncol_, nlev_); } - offset_emis_ver += nvars; ++i; } // end i - EKAT_REQUIRE_MSG( - offset_emis_ver <= int(mam_coupling::MAX_NUM_ELEVATED_EMISSIONS_FIELDS), - "Error! Number of fields is bigger than " - "MAX_NUM_ELEVATED_EMISSIONS_FIELDS. Increase the " - "MAX_NUM_ELEVATED_EMISSIONS_FIELDS in tracer_reader_utils.hpp \n"); } // Tracer external forcing data @@ -383,9 +393,6 @@ int MAMMicrophysics::get_len_temporary_views() { work_len += ncol_ * nlev_ * mam4::gas_chemistry::nfs; // extfrc_ work_len += ncol_ * nlev_ * extcnt; - // dflx_, dvel_ - constexpr int gas_pcnst = mam_coupling::gas_pcnst(); - work_len += 2 * ncol_ * gas_pcnst; return work_len; } void MAMMicrophysics::init_temporary_views() { @@ -405,14 +412,8 @@ void MAMMicrophysics::init_temporary_views() { work_ptr += ncol_ * nlev_ * mam4::gas_chemistry::nfs; extfrc_ = view_3d(work_ptr, ncol_, nlev_, extcnt); work_ptr += ncol_ * nlev_ * extcnt; - // Work arrays for return values from - // perform_atmospheric_chemistry_and_microphysics - constexpr int gas_pcnst = mam_coupling::gas_pcnst(); - dflx_ = view_2d(work_ptr, ncol_, gas_pcnst); - work_ptr += ncol_ * gas_pcnst; - dvel_ = view_2d(work_ptr, ncol_, gas_pcnst); - work_ptr += ncol_ * gas_pcnst; - /// error check + + // Error check // NOTE: workspace_provided can be larger than workspace_used, but let's try // to use the minimum amount of memory const int workspace_used = work_ptr - buffer_.temporary_views.data(); @@ -459,6 +460,7 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) { // --------------------------------------------------------------- populate_wet_atm(wet_atm_); populate_dry_atm(dry_atm_, buffer_); + // FIXME: we are using cldfrac_tot in other mam4xx process. dry_atm_.cldfrac = get_field_in("cldfrac_liq").get_view(); // FIXME: phis is not populated by populate_wet_and_dry_atm. @@ -539,7 +541,9 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) { ElevatedEmissionsDataReader_[i], curr_month, *ElevatedEmissionsHorizInterp_[i], elevated_emis_data_[i]); } + // // + acos_cosine_zenith_host_ = view_1d_host("host_acos(cosine_zenith)", ncol_); acos_cosine_zenith_ = view_1d("device_acos(cosine_zenith)", ncol_); @@ -668,20 +672,16 @@ void MAMMicrophysics::run_impl(const double dt) { linoz_output); // out Kokkos::fence(); - elevated_emiss_time_state_.t_now = ts.frac_of_year_in_days(); + int i = 0; for(const auto &var_name : extfrc_lst_) { + elevated_emiss_time_state_[i].t_now = ts.frac_of_year_in_days(); const auto file_name = elevated_emis_file_name_[var_name]; const auto var_names = elevated_emis_var_names_[var_name]; - const int nsectors = int(var_names.size()); - view_2d elevated_emis_output[nsectors]; - for(int isp = 0; isp < nsectors; ++isp) { - elevated_emis_output[isp] = - elevated_emis_output_[isp + forcings_[i].offset]; - } + auto& elevated_emis_output= forcings_[i].fields; scream::mam_coupling::advance_tracer_data( ElevatedEmissionsDataReader_[i], *ElevatedEmissionsHorizInterp_[i], ts, - elevated_emiss_time_state_, elevated_emis_data_[i], dry_atm_.p_mid, + elevated_emiss_time_state_[i], elevated_emis_data_[i], dry_atm_.p_mid, dry_atm_.z_iface, elevated_emis_output); i++; Kokkos::fence(); @@ -756,7 +756,6 @@ void MAMMicrophysics::run_impl(const double dt) { const auto zenith_angle = acos_cosine_zenith_; constexpr int gas_pcnst = mam_coupling::gas_pcnst(); - const auto &elevated_emis_output = elevated_emis_output_; const auto &extfrc = extfrc_; const auto &forcings = forcings_; constexpr int extcnt = mam4::gas_chemistry::extcnt; @@ -782,9 +781,10 @@ void MAMMicrophysics::run_impl(const double dt) { const int month = start_of_step_ts().get_month(); // 1-based const int surface_lev = nlev - 1; // Surface level const auto &index_season_lai = index_season_lai_; - auto &dflx = dflx_; - auto &dvel = dvel_; + const int pcnst = mam4::pcnst; + //NOTE: we need to initialize photo_rates_ + Kokkos::deep_copy(photo_rates_,0.0); // loop over atmosphere columns and compute aerosol microphyscs Kokkos::parallel_for( "MAMMicrophysics::run_impl", policy, @@ -820,7 +820,7 @@ void MAMMicrophysics::run_impl(const double dt) { // We may need to move this line where we read files. forcings_in[i].file_alt_data = file_alt_data; for(int isec = 0; isec < forcings[i].nsectors; ++isec) { - const auto field = elevated_emis_output[isec + forcings[i].offset]; + const auto& field = forcings[i].fields[isec]; forcings_in[i].fields_data[isec] = ekat::subview(field, icol); } } // extcnt for loop @@ -897,13 +897,11 @@ void MAMMicrophysics::run_impl(const double dt) { } } // These output values need to be put somewhere: - view_1d dflx_col = - ekat::subview(dflx, icol); // deposition velocity [1/cm/s] - view_1d dvel_col = - ekat::subview(dvel, icol); // deposition flux [1/cm^2/s] - - // Output: values are dvel, dvlx + Real dflx_col[gas_pcnst] = {}; // deposition velocity [1/cm/s] + Real dvel_col[gas_pcnst] = {}; // deposition flux [1/cm^2/s] + // Output: values are dvel, dflx // Input/Output: progs::stateq, progs::qqcw + team.team_barrier(); mam4::microphysics::perform_atmospheric_chemistry_and_microphysics( team, dt, rlats, sfc_temperature(icol), sfc_pressure(icol), wind_speed, rain, solar_flux, cnst_offline_icol, forcings_in, atm, @@ -925,14 +923,39 @@ void MAMMicrophysics::run_impl(const double dt) { // FIXME: Possible units mismatch (dflx is in kg/cm2/s but // constituent_fluxes is kg/m2/s) (Following mimics Fortran code // behavior but we should look into it) - Kokkos::parallel_for( - Kokkos::TeamThreadRange(team, offset_aerosol, mam4::pcnst), - [&](const int ispc) { - constituent_fluxes(icol, ispc) -= dflx_col(ispc - offset_aerosol); - }); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, offset_aerosol, pcnst), [&](int ispc) { + constituent_fluxes(icol, ispc) -= dflx_col[ispc - offset_aerosol]; + }); + }); // parallel_for for the column loop Kokkos::fence(); + auto extfrc_fm = get_field_out("mam4_external_forcing").get_view(); + + // Avogadro's number [molecules/mol] + const Real Avogadro = haero::Constants::avogadro; + // Mapping from external forcing species index to physics constituent index + // NOTE: These indices should match the species in extfrc_lst + // TODO: getting rid of hard-coded indices + Kokkos::Array extfrc_pcnst_index = {3, 6, 14, 27, 28, 13, 18, 30, 5}; + Kokkos::Array molar_mass_g_per_mol_tmp; + for (int i = 0; i < gas_pcnst; ++i) { + molar_mass_g_per_mol_tmp[i] = mam4::gas_chemistry::adv_mass[i]; // host-only access + } + + // Transpose extfrc_ from internal layout [ncol][nlev][extcnt] + // to output layout [ncol][extcnt][nlev] + // This aligns with expected field storage in the EAMxx infrastructure. + Kokkos::parallel_for("transpose_extfrc", + Kokkos::MDRangePolicy>({0,0,0}, {ncol, extcnt, nlev}), + KOKKOS_LAMBDA(const int i, const int j, const int k) { + const int pcnst_idx = extfrc_pcnst_index[j]; + const Real molar_mass_g_per_mol = molar_mass_g_per_mol_tmp[pcnst_idx]; // g/mol + // Modify units to MKS units: [molec/cm3/s] to [kg/m3/s] + // Convert g → kg (× 1e-3), cm³ → m³ (× 1e6) → total factor: 1e-3 × 1e6 = 1e3 = 1000.0 + extfrc_fm(i,j,k) = extfrc(i,k,j) * (molar_mass_g_per_mol / Avogadro) * 1000.0; + }); + // postprocess output post_process(wet_aero_, dry_aero_, dry_atm_); Kokkos::fence(); diff --git a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp index 199f157a31a4..fd6e11568ce8 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp @@ -125,15 +125,13 @@ class MAMMicrophysics final : public MAMGenericInterface { // Vertical emission uses 9 files, here I am using std::vector to stote // instance of each file. - mam_coupling::TracerTimeState elevated_emiss_time_state_; + mam_coupling::TracerTimeState elevated_emiss_time_state_[mam4::gas_chemistry::extcnt]; std::vector> ElevatedEmissionsDataReader_; std::vector> ElevatedEmissionsHorizInterp_; std::vector extfrc_lst_; std::vector elevated_emis_data_; std::map elevated_emis_file_name_; std::map> elevated_emis_var_names_; - view_2d - elevated_emis_output_[mam_coupling::MAX_NUM_ELEVATED_EMISSIONS_FIELDS]; view_3d extfrc_; mam_coupling::ForcingHelper forcings_[mam4::gas_chemistry::extcnt]; diff --git a/components/eamxx/src/physics/mam/eamxx_mam_optics_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_optics_process_interface.cpp index b71abb8715e2..dc8f789e659d 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_optics_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_optics_process_interface.cpp @@ -52,6 +52,9 @@ void MAMOptics::set_grids( FieldLayout scalar3d_int = grid_->get_3d_scalar_layout(false); add_tracers_wet_atm(); add_fields_dry_atm(); + + // cloud liquid number mixing ratio [1/kg] + add_tracer("nc", grid_, n_unit); // layout for 2D (1d horiz X 1d vertical) variables FieldLayout scalar2d = grid_->get_2d_scalar_layout(); @@ -153,12 +156,12 @@ void MAMOptics::initialize_impl(const RunType run_type) { // because we automatically added these fields. const std::map> ranges_optics = { // optics - {"pseudo_density_dry", {-1e10, 1e10}}, // FIXME - {"aero_g_sw", {-1e10, 1e10}}, // FIXME - {"aero_ssa_sw", {-1e10, 1e10}}, // FIXME - {"aero_tau_lw", {-1e10, 1e10}}, // FIXME - {"aero_tau_sw", {-1e10, 1e10}}, // FIXME - {"aodvis", {-1e10, 1e10}} // FIXME + {"pseudo_density_dry", {0, 5e3}}, // FIXME + {"aero_g_sw", {-0.1, 1}}, // FIXME + {"aero_ssa_sw", {0, 1}}, // FIXME + {"aero_tau_lw", {-1e-4, 2}}, // FIXME + {"aero_tau_sw", {-1e-4, 10}}, // FIXME + {"aodvis", {0, 25}} // FIXME }; set_ranges_process(ranges_optics); add_interval_checks(); diff --git a/components/eamxx/src/physics/mam/eamxx_mam_srf_and_online_emissions_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_srf_and_online_emissions_process_interface.cpp index 5f96b9daeb3e..342c0295b015 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_srf_and_online_emissions_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_srf_and_online_emissions_process_interface.cpp @@ -62,7 +62,11 @@ void MAMSrfOnlineEmiss::set_grids( // Specific humidity [kg/kg] add_tracers_wet_atm(); add_fields_dry_atm(); - + + // cloud liquid number mixing ratio [1/kg] + auto n_unit = 1 / kg; // units of number mixing ratios of tracers + add_tracer("nc", grid_, n_unit); + //----------- Variables from microphysics scheme ------------- // Surface geopotential [m2/s2] diff --git a/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp index cc86abb3dac6..72677e640698 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp @@ -53,8 +53,8 @@ void MAMWetscav::set_grids( true, nmodes, mam_coupling::num_modes_tag_name()); // layout for 2D (ncol, pcnst) - FieldLayout scalar2d_pconst = - grid_->get_2d_vector_layout(pcnst, "num_phys_constants"); + FieldLayout scalar2d_pcnst = + grid_->get_2d_vector_layout(pcnst, "num_phys_constituents"); // -------------------------------------------------------------------------- // These variables are "required" or pure inputs for the process @@ -65,6 +65,10 @@ void MAMWetscav::set_grids( add_tracers_wet_atm(); add_fields_dry_atm(); + // cloud liquid number mixing ratio [1/kg] + auto n_unit = 1 / kg; // units of number mixing ratios of tracers + add_tracer("nc", grid_, n_unit); + static constexpr auto m2 = m * m; static constexpr auto s2 = s * s; @@ -156,10 +160,10 @@ void MAMWetscav::set_grids( add_field("fracis", scalar3d_mid, nondim, grid_name); // Aerosol wet deposition (interstitial) [kg/m2/s] - add_field("aerdepwetis", scalar2d_pconst, kg / m2 / s, grid_name); + add_field("aerdepwetis", scalar2d_pcnst, kg / m2 / s, grid_name); // Aerosol wet deposition (cloud water) [kg/m2/s] - add_field("aerdepwetcw", scalar2d_pconst, kg / m2 / s, grid_name); + add_field("aerdepwetcw", scalar2d_pcnst, kg / m2 / s, grid_name); } // ================================================================ @@ -309,6 +313,22 @@ void MAMWetscav::initialize_impl(const RunType run_type) { calsize_data_.initialize(); // wetscav uses update_mmr=true; calsize_data_.set_update_mmr(true); + + view_2d_host scavimptblvol_host("scavimptblvol_host", + mam4::aero_model::nimptblgrow_total, + mam4::AeroConfig::num_modes()); + view_2d_host scavimptblnum_host("scavimptblnum_host", + mam4::aero_model::nimptblgrow_total, + mam4::AeroConfig::num_modes()); + + mam4::wetdep::init_scavimptbl(scavimptblvol_host, scavimptblnum_host); + + scavimptblnum_ = view_2d("scavimptblnum", mam4::aero_model::nimptblgrow_total, + mam4::AeroConfig::num_modes()); + scavimptblvol_ = view_2d("scavimptblvol", mam4::aero_model::nimptblgrow_total, + mam4::AeroConfig::num_modes()); + Kokkos::deep_copy(scavimptblnum_, scavimptblnum_host); + Kokkos::deep_copy(scavimptblvol_, scavimptblvol_host); } // ================================================================ @@ -404,13 +424,9 @@ void MAMWetscav::run_impl(const double dt) { } } - Real scavimptblnum[mam4::aero_model::nimptblgrow_total] - [mam4::AeroConfig::num_modes()]; - Real scavimptblvol[mam4::aero_model::nimptblgrow_total] - [mam4::AeroConfig::num_modes()]; - - mam4::wetdep::init_scavimptbl(scavimptblvol, scavimptblnum); - const auto &calsize_data = calsize_data_; + const auto &calsize_data = calsize_data_; + const auto &scavimptblnum = scavimptblnum_; + const auto &scavimptblvol = scavimptblvol_; // Loop over atmosphere columns Kokkos::parallel_for( @@ -464,8 +480,7 @@ void MAMWetscav::run_impl(const double dt) { // inputs cldt_icol, rprdsh_icol, rprddp_icol, evapcdp_icol, evapcsh_icol, dp_frac_icol, sh_frac_icol, icwmrdp_col, icwmrsh_icol, nevapr_icol, - dlf_icol, prain_icol, scavimptblnum, scavimptblvol, - calsize_data, + dlf_icol, prain_icol, scavimptblnum, scavimptblvol, calsize_data, // outputs wet_diameter_icol, dry_diameter_icol, qaerwat_icol, wetdens_icol, aerdepwetis_icol, aerdepwetcw_icol, work_icol, isprx_icol); diff --git a/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.hpp b/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.hpp index 343331559da9..1c825f5e1d24 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.hpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.hpp @@ -21,9 +21,10 @@ namespace scream { */ class MAMWetscav : public MAMGenericInterface { - using KT = ekat::KokkosTypes; - using view_2d = typename KT::template view_2d; - using int_view_2d = typename KT::template view_2d; + using KT = ekat::KokkosTypes; + using view_2d = typename KT::template view_2d; + using view_2d_host = typename KT::template view_2d::HostMirror; + using int_view_2d = typename KT::template view_2d; // a thread team dispatched to a single vertical column using ThreadTeam = mam4::ThreadTeam; @@ -98,6 +99,10 @@ class MAMWetscav : public MAMGenericInterface { view_2d dlf_; int num_2d_scratch_ = 39; + // + view_2d scavimptblnum_; + + view_2d scavimptblvol_; // Aerosol states mam_coupling::AerosolState dry_aero_tends_; diff --git a/components/eamxx/src/physics/mam/readfiles/fractional_land_use_impl.hpp b/components/eamxx/src/physics/mam/readfiles/fractional_land_use_impl.hpp index 93cd40bcd8aa..5b934e92b496 100644 --- a/components/eamxx/src/physics/mam/readfiles/fractional_land_use_impl.hpp +++ b/components/eamxx/src/physics/mam/readfiles/fractional_land_use_impl.hpp @@ -52,8 +52,6 @@ fracLandUseFunctions::create_horiz_remapper( std::make_shared(horiz_interp_tgt_grid, map_file); } - remapper->registration_begins(); - const auto tgt_grid = remapper->get_tgt_grid(); const auto layout_2d = tgt_grid->get_2d_vector_layout(nclass_data, "class"); diff --git a/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp b/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp index e5625c911aa0..7ed8ea5574d2 100644 --- a/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp +++ b/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp @@ -49,8 +49,6 @@ marineOrganicsFunctions::create_horiz_remapper( std::make_shared(horiz_interp_tgt_grid, map_file); } - remapper->registration_begins(); - const auto tgt_grid = remapper->get_tgt_grid(); const auto layout_2d = tgt_grid->get_2d_scalar_layout(); diff --git a/components/eamxx/src/physics/mam/readfiles/soil_erodibility_impl.hpp b/components/eamxx/src/physics/mam/readfiles/soil_erodibility_impl.hpp index ac6bd164f4a5..e9435802c9b6 100644 --- a/components/eamxx/src/physics/mam/readfiles/soil_erodibility_impl.hpp +++ b/components/eamxx/src/physics/mam/readfiles/soil_erodibility_impl.hpp @@ -50,8 +50,6 @@ soilErodibilityFunctions::create_horiz_remapper( std::make_shared(horiz_interp_tgt_grid, map_file); } - remapper->registration_begins(); - const auto tgt_grid = remapper->get_tgt_grid(); const auto layout_2d = tgt_grid->get_2d_scalar_layout(); diff --git a/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp b/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp index e202d452f53c..caf0d3812ec3 100644 --- a/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp +++ b/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp @@ -10,6 +10,8 @@ #include "share/grid/remap/refining_remapper_p2p.hpp" #include "share/io/eamxx_scorpio_interface.hpp" #include "share/io/scorpio_input.hpp" +#include "share/util/eamxx_time_stamp.hpp" +#include "share/util/eamxx_time_interpolation.hpp" namespace scream::mam_coupling { @@ -54,6 +56,7 @@ inline void compute_p_src_zonal_files(const view_1d &levs, // inside the parallel_for. // This struct will be used in init while reading nc files. // The MAM4xx version will be used instead of parallel_for that loops over cols. +constexpr int MAX_SECTION_NUM_FORCING=4; struct ForcingHelper { // This index is in Fortran format. i.e. starts in 1 int frc_ndx; @@ -61,8 +64,8 @@ struct ForcingHelper { bool file_alt_data; // number of sectors per forcing int nsectors; - // offset in output vector from reader - int offset; + // data of views + view_2d fields[MAX_SECTION_NUM_FORCING]; }; enum TracerFileType { @@ -88,13 +91,13 @@ enum TracerDataIndex { BEG = 0, END = 1, OUT = 2 }; Therefore, if a file contains more than this number, it is acceptable to increase this limit. Currently, Linoz files have 8 fields. */ constexpr int MAX_NVARS_TRACER = 10; -constexpr int MAX_NUM_ELEVATED_EMISSIONS_FIELDS = 25; // Linoz structures to help manage all of the variables: struct TracerTimeState { // Whether the timestate has been initialized. // The current month int current_month = -1; + int current_interval_idx = -1; // Julian Date for the beginning of the month, as defined in // /src/share/util/eamxx_time_stamp.hpp // See this file for definition of Julian Date. @@ -103,10 +106,70 @@ struct TracerTimeState { Real t_now; // Number of days in the current month, cast as a Real Real days_this_month; -}; // TricerTimeState +}; // TracerTimeState + +inline scream::util::TimeStamp convert_date(const int date) { + constexpr int ten_thousand = 10000; + constexpr int one_hundred = 100; + + int year = date / ten_thousand; + int month = (date - year * ten_thousand) / one_hundred; + int day = date - year * ten_thousand - month * one_hundred; + + return scream::util::TimeStamp(year, month, day, 0, 0, 0); +} + +struct TracerTimeSlice { + scream::util::TimeStamp time; + int time_index; +}; + +// Converts raw YYYYMMDD date integers into sorted TimeStamp-index pairs. +// Assumes yearly periodicity for now. +// NOTE: Consider adding support for transient data. +struct TracerTimeDatabase { + std::vector slices; + scream::util::TimeLine timeline = scream::util::TimeLine::YearlyPeriodic; + + void build(const std::vector& raw_dates) { + slices.clear(); + for (int i = 0; i < raw_dates.size(); ++i) { + slices.push_back({ convert_date(raw_dates[i]), i }); + } + std::sort(slices.begin(), slices.end(), [](const auto& a, const auto& b) { + return a.time < b.time; + }); + } + + int size() const { + return slices.size(); + } + + int get_next_idx(int idx) const { + return (idx + 1) % slices.size(); + } + + // Finds the interval [t_i, t_{i+1}) that contains ts. Assumes cyclic behavior. + int find_interval(const util::TimeStamp& ts) const { + EKAT_REQUIRE_MSG(size() >= 2, "Time database has fewer than 2 time slices."); + + for (int i = 0; i < slices.size(); ++i) { + int j = get_next_idx(i); + util::TimeInterval interval(slices[i].time, slices[j].time, timeline); + if (interval.contains(ts)) { + return i; + } + } + + EKAT_ERROR_MSG("TracerTimeDatabase::find_interval - no interval contains timestamp " + + ts.to_string() + ". Check time coverage."); + return -1; + } +}; // TracerTimeDatabase struct TracerData { TracerData() = default; + TracerTimeDatabase time_db; TracerData(const int ncol, const int nlev, const int nvars) { init(ncol, nlev, nvars); } @@ -194,16 +257,6 @@ Real linear_interp(const Real &x0, const Real &x1, const Real &t) { return (1 - t) * x0 + t * x1; } // linear_interp -// time[3]={year,month, day} -inline util::TimeStamp convert_date(const int date) { - constexpr int ten_thousand = 10000; - constexpr int one_hundred = 100; - - int year = date / ten_thousand; - int month = (date - year * ten_thousand) / one_hundred; - int day = date - year * ten_thousand - month * one_hundred; - return util::TimeStamp(year, month, day, 0, 0, 0); -} // FIXME: This function is not implemented in eamxx. // FIXME: Assumes 365 days/year, 30 days/month; // NOTE: that this assumption is mainly used for plotting. @@ -291,51 +344,104 @@ inline Real chlorine_loading_advance(const util::TimeStamp &ts, // It reads variables that are not time-dependent and independent of columns (no // MPI involved here). We also obtain the offset_time_index using a date // (cyclical_ymd) as input. We initialize a few members of tracer_data. -inline void setup_tracer_data(TracerData &tracer_data, // out - const std::string &trace_data_file, // in - const int cyclical_ymd) // in +inline void init_monthly_time_offset(TracerData& tracer_data, + const std::string& file, + const int cyclical_ymd) { + const int nlevs_time = scorpio::get_dimlen(file, "time"); + int cyclical_ymd_index = -1; + + for (int itime = 0; itime < nlevs_time; ++itime) { + int date; + scorpio::read_var(file, "date", &date, itime); + if (date >= cyclical_ymd) { + cyclical_ymd_index = itime; + break; + } + } + + EKAT_REQUIRE_MSG(cyclical_ymd_index >= 0, + "Error! Model time (" + std::to_string(cyclical_ymd) + + ") is not within tracer time period."); + + tracer_data.offset_time_index_ = cyclical_ymd_index; +} + +// Builds internal timeline database and computes intervals. +inline void init_irregular_time_database(TracerData& tracer_data, + const std::string& file, + const int cyclical_ymd) { + const int nlevs_time = scorpio::get_dimlen(file, "time"); + std::vector dates; + + for (int itime = 0; itime < nlevs_time; ++itime) { + int date; + scorpio::read_var(file, "date", &date, itime); + dates.push_back(date); + } + + tracer_data.time_db.build(dates); + + auto ts_model = convert_date(cyclical_ymd); + const int interval = tracer_data.time_db.find_interval(ts_model); + + EKAT_REQUIRE_MSG(interval >= 0, + "Error! Model time (" + std::to_string(cyclical_ymd) + + ") is not within the tracer time range."); +} + +inline void setup_tracer_data(TracerData &tracer_data, + const std::string &trace_data_file, + const int cyclical_ymd) { + + using namespace scream::mam_coupling; scorpio::register_file(trace_data_file, scorpio::Read); - if(not scorpio::has_time_dim(trace_data_file)) { + + if (not scorpio::has_time_dim(trace_data_file)) { scorpio::mark_dim_as_time(trace_data_file, "time"); } - // by default, I am assuming a zonal file. - TracerFileType tracer_file_type = ZONAL; + // Default assumption + TracerFileType tracer_file_type = ZONAL; int nlevs_data = -1; - if(scorpio::has_var(trace_data_file, "lev")) { + + if (scorpio::has_var(trace_data_file, "lev")) { nlevs_data = scorpio::get_dimlen(trace_data_file, "lev"); } + const bool has_altitude = scorpio::has_var(trace_data_file, "altitude"); // This type of files use altitude (zi) for vertical interpolation - if(has_altitude) { - nlevs_data = scorpio::get_dimlen(trace_data_file, "altitude"); + if (has_altitude) { + nlevs_data = scorpio::get_dimlen(trace_data_file, "altitude"); tracer_file_type = ELEVATED_EMISSIONS; } - EKAT_REQUIRE_MSG( - nlevs_data != -1, - "Error: The file does not contain either lev or altitude. \n"); + + EKAT_REQUIRE_MSG(nlevs_data != -1, + "Error: The file does not contain either lev or altitude. \n"); const int ncols_data = scorpio::get_dimlen(trace_data_file, "ncol"); // This type of files use model pressure (pmid) for vertical interpolation - if(scorpio::has_var(trace_data_file, "PS")) { + if (scorpio::has_var(trace_data_file, "PS")) { tracer_file_type = FORMULA_PS; + view_1d_host hyam_h("hyam_h", nlevs_data); view_1d_host hybm_h("hybm_h", nlevs_data); scorpio::read_var(trace_data_file, "hyam", hyam_h.data()); scorpio::read_var(trace_data_file, "hybm", hybm_h.data()); + view_1d hyam("hyam", nlevs_data); view_1d hybm("hybm", nlevs_data); Kokkos::deep_copy(hyam, hyam_h); Kokkos::deep_copy(hybm, hybm_h); + tracer_data.hyam = hyam; tracer_data.hybm = hybm; } - if(tracer_file_type == ZONAL) { + if (tracer_file_type == ZONAL) { view_1d_host levs_h("levs_h", nlevs_data); view_1d levs("levs", nlevs_data); scorpio::read_var(trace_data_file, "lev", levs_h.data()); @@ -343,43 +449,31 @@ inline void setup_tracer_data(TracerData &tracer_data, // out tracer_data.zonal_levs_ = levs; } - if(tracer_file_type == ELEVATED_EMISSIONS) { - const int nilevs_data = - scorpio::get_dimlen(trace_data_file, "altitude_int"); + if (tracer_file_type == ELEVATED_EMISSIONS) { + const int nilevs_data = scorpio::get_dimlen(trace_data_file, "altitude_int"); view_1d_host altitude_int_host("altitude_int_host", nilevs_data); - view_1d altitude_int = view_1d("altitude_int", nilevs_data); - scorpio::read_var(trace_data_file, "altitude_int", - altitude_int_host.data()); + view_1d altitude_int("altitude_int", nilevs_data); + + scorpio::read_var(trace_data_file, "altitude_int", altitude_int_host.data()); Kokkos::deep_copy(altitude_int, altitude_int_host); + tracer_data.altitude_int_ = altitude_int; } - // time index - { - const int nlevs_time = scorpio::get_dimlen(trace_data_file, "time"); - int cyclical_ymd_index = -1; - for(int itime = 0; itime < nlevs_time; ++itime) { - int date; - scorpio::read_var(trace_data_file, "date", &date, itime); - if(date >= cyclical_ymd) { - cyclical_ymd_index = itime; - break; - } - } // end itime - - EKAT_REQUIRE_MSG(cyclical_ymd_index >= 0, "Error! Current model time (" + - std::to_string(cyclical_ymd) + - ") is not within " + - "Tracer time period.\n"); - tracer_data.offset_time_index_ = cyclical_ymd_index; + // Time initialization logic — delegated to helpers above + if (tracer_file_type == ELEVATED_EMISSIONS) { + init_irregular_time_database(tracer_data, trace_data_file, cyclical_ymd); + } else { + init_monthly_time_offset(tracer_data, trace_data_file, cyclical_ymd); } scorpio::release_file(trace_data_file); - tracer_data.file_type = tracer_file_type; - tracer_data.nlevs_data = nlevs_data; - tracer_data.ncols_data = ncols_data; + tracer_data.file_type = tracer_file_type; + tracer_data.nlevs_data = nlevs_data; + tracer_data.ncols_data = ncols_data; tracer_data.has_altitude_ = has_altitude; -} +} // setup_tracer_data + inline std::shared_ptr create_horiz_remapper( const std::shared_ptr &model_grid, const std::string &trace_data_file, const std::string &map_file, @@ -417,7 +511,6 @@ inline std::shared_ptr create_horiz_remapper( std::make_shared(horiz_interp_tgt_grid, map_file); } - remapper->registration_begins(); const auto tgt_grid = remapper->get_tgt_grid(); const auto layout_2d = tgt_grid->get_2d_scalar_layout(); @@ -495,52 +588,131 @@ inline void update_tracer_data_from_file( } } // update_tracer_data_from_file -inline void update_tracer_timestate( - const std::shared_ptr &scorpio_reader, - const util::TimeStamp &ts, AbstractRemapper &tracer_horiz_interp, - TracerTimeState &time_state, TracerData &data_tracer) { - // Now we check if we have to update the data that changes monthly - // NOTE: This means that tracer external forcing assumes monthly data to - // update. Not - // any other frequency. - const auto month = ts.get_month() - 1; // Make it 0-based - if(month != time_state.current_month) { - const auto tracer_data = data_tracer.data; - const int nvars = data_tracer.nvars_; - const auto ps = data_tracer.ps; - - // Update the tracer external forcing time state information + +inline void update_monthly_timestate( + const std::shared_ptr& scorpio_reader, + const util::TimeStamp& ts, + AbstractRemapper& tracer_horiz_interp, + TracerTimeState& time_state, + TracerData& data_tracer) +{ + const auto month = ts.get_month() - 1; // 0-based month + + if (month != time_state.current_month) { + const int nvars = data_tracer.nvars_; + const auto& ps = data_tracer.ps; + auto& data = data_tracer.data; + time_state.current_month = month; time_state.t_beg_month = ts.curr_month_beg().frac_of_year_in_days(); time_state.days_this_month = ts.days_in_curr_month(); + time_state.t_now = ts.frac_of_year_in_days(); - // Copy spa_end'data into spa_beg'data, and read in the new spa_end - for(int ivar = 0; ivar < nvars; ++ivar) { - Kokkos::deep_copy(tracer_data[TracerDataIndex::BEG][ivar], - tracer_data[TracerDataIndex::END][ivar]); + for (int ivar = 0; ivar < nvars; ++ivar) { + Kokkos::deep_copy(data[TracerDataIndex::BEG][ivar], + data[TracerDataIndex::END][ivar]); } - if(data_tracer.file_type == FORMULA_PS) { + if (data_tracer.file_type == FORMULA_PS) { Kokkos::deep_copy(ps[TracerDataIndex::BEG], ps[TracerDataIndex::END]); } - // Following SPA to time-interpolate data in MAM4xx - // Assume the data is saved monthly and cycles in one year - // Add offset_time_index to support cases where data is saved - // from other periods of time. - // Update the tracer external forcing data for this month and next month - // Start by copying next months data to this months data structure. - // NOTE: If the timestep is bigger than monthly this could cause the wrong - // values - // to be assigned. A timestep greater than a month is very unlikely - // so we will proceed. int next_month = - data_tracer.offset_time_index_ + (time_state.current_month + 1) % 12; + data_tracer.offset_time_index_ + (month + 1) % 12; update_tracer_data_from_file(scorpio_reader, next_month, tracer_horiz_interp, data_tracer); } +} + +// Loads time slice data before and after current timestamp (ts), +// and prepares interpolation state. First call initializes both BEG and END. +inline void update_irregular_timestate( + const std::shared_ptr& scorpio_reader, + const util::TimeStamp& ts, + AbstractRemapper& tracer_horiz_interp, + TracerTimeState& time_state, + TracerData& data_tracer) +{ + const auto& db = data_tracer.time_db; + int beg_idx = db.find_interval(ts); + int end_idx = db.get_next_idx(beg_idx); + + auto t_beg_ts = db.slices[beg_idx].time; + auto t_end_ts = db.slices[end_idx].time; + + Real t_beg = t_beg_ts.frac_of_year_in_days(); + Real t_end = t_end_ts.frac_of_year_in_days(); + Real t_now = ts.frac_of_year_in_days(); + + int days_in_year = t_beg_ts.days_in_curr_year(); + if (t_now < t_beg) t_now += days_in_year; + + Real delta_t = t_end - t_beg; + if (delta_t < 0) delta_t += days_in_year; + + bool first_time = (time_state.current_interval_idx < 0); + if (first_time || beg_idx != time_state.current_interval_idx) { + if (!first_time) { + for (int ivar = 0; ivar < data_tracer.nvars_; ++ivar) { + Kokkos::deep_copy( + data_tracer.data[TracerDataIndex::BEG][ivar], + data_tracer.data[TracerDataIndex::END][ivar]); + } + + if (data_tracer.file_type == FORMULA_PS) { + Kokkos::deep_copy(data_tracer.ps[TracerDataIndex::BEG], + data_tracer.ps[TracerDataIndex::END]); + } + } else { + // On first call, initialize BEG from file; otherwise, copy END to BEG. + update_tracer_data_from_file( + scorpio_reader, + db.slices[beg_idx].time_index, + tracer_horiz_interp, + data_tracer); + + for (int ivar = 0; ivar < data_tracer.nvars_; ++ivar) { + Kokkos::deep_copy( + data_tracer.data[TracerDataIndex::BEG][ivar], + data_tracer.data[TracerDataIndex::END][ivar]); + } + + if (data_tracer.file_type == FORMULA_PS) { + Kokkos::deep_copy(data_tracer.ps[TracerDataIndex::BEG], + data_tracer.ps[TracerDataIndex::END]); + } + } -} // END update_tracer_timestate + update_tracer_data_from_file( + scorpio_reader, + db.slices[end_idx].time_index, + tracer_horiz_interp, + data_tracer); + + time_state.current_interval_idx = beg_idx; + } + + time_state.t_beg_month = t_beg; + time_state.t_now = t_now; + time_state.days_this_month = delta_t; +} + +// Uses appropriate time update routine based on file type. +inline void update_tracer_timestate( + const std::shared_ptr& scorpio_reader, + const util::TimeStamp& ts, + AbstractRemapper& tracer_horiz_interp, + TracerTimeState& time_state, + TracerData& data_tracer) +{ + if (data_tracer.file_type == ELEVATED_EMISSIONS) { + update_irregular_timestate(scorpio_reader, ts, tracer_horiz_interp, + time_state, data_tracer); + } else { + update_monthly_timestate(scorpio_reader, ts, tracer_horiz_interp, + time_state, data_tracer); + } +} // This function is based on the SPA::perform_time_interpolation function. inline void perform_time_interpolation(const TracerTimeState &time_state, diff --git a/components/eamxx/src/physics/mam/srf_emission_impl.hpp b/components/eamxx/src/physics/mam/srf_emission_impl.hpp index 32973d2e82c5..7f60f0db6699 100644 --- a/components/eamxx/src/physics/mam/srf_emission_impl.hpp +++ b/components/eamxx/src/physics/mam/srf_emission_impl.hpp @@ -48,8 +48,6 @@ srfEmissFunctions::create_horiz_remapper( std::make_shared(horiz_interp_tgt_grid, map_file); } - remapper->registration_begins(); - const auto tgt_grid = remapper->get_tgt_grid(); const auto layout_2d = tgt_grid->get_2d_scalar_layout(); diff --git a/components/eamxx/src/physics/nudging/eamxx_nudging_process_interface.cpp b/components/eamxx/src/physics/nudging/eamxx_nudging_process_interface.cpp index e9188af8adfe..ec0eb5293339 100644 --- a/components/eamxx/src/physics/nudging/eamxx_nudging_process_interface.cpp +++ b/components/eamxx/src/physics/nudging/eamxx_nudging_process_interface.cpp @@ -236,7 +236,6 @@ void Nudging::initialize_impl (const RunType /* run_type */) const auto layout_ext = grid_ext->get_3d_scalar_layout(true); const auto layout_tmp = grid_tmp->get_3d_scalar_layout(true); const auto layout_atm = m_grid->get_3d_scalar_layout(true); - m_horiz_remapper->registration_begins(); for (auto name : m_fields_nudge) { std::string name_ext = name + "_ext"; std::string name_tmp = name + "_tmp"; diff --git a/components/eamxx/src/physics/nudging/tests/nudging_tests_helpers.hpp b/components/eamxx/src/physics/nudging/tests/nudging_tests_helpers.hpp index 82356c5ce345..a2aafb856abc 100644 --- a/components/eamxx/src/physics/nudging/tests/nudging_tests_helpers.hpp +++ b/components/eamxx/src/physics/nudging/tests/nudging_tests_helpers.hpp @@ -55,7 +55,6 @@ create_fm (const std::shared_ptr& grid) FieldIdentifier fid2("horiz_winds",vector3d,m/s,gn); // Register fields with fm - fm->registration_begins(); fm->register_field(FR(fid1)); fm->register_field(FR(fid2)); fm->registration_ends(); diff --git a/components/eamxx/src/physics/p3/disp/p3_main_impl_disp.cpp b/components/eamxx/src/physics/p3/disp/p3_main_impl_disp.cpp index ea9410891163..8d88935e1fb3 100644 --- a/components/eamxx/src/physics/p3/disp/p3_main_impl_disp.cpp +++ b/components/eamxx/src/physics/p3/disp/p3_main_impl_disp.cpp @@ -172,6 +172,21 @@ ::p3_main_internal_disp( auto liq_ice_exchange = history_only.liq_ice_exchange; auto vap_liq_exchange = history_only.vap_liq_exchange; auto vap_ice_exchange = history_only.vap_ice_exchange; + auto qr2qv_evap = history_only.qr2qv_evap; + auto qi2qv_sublim = history_only.qi2qv_sublim; + auto qc2qr_accret = history_only.qc2qr_accret; + auto qc2qr_autoconv = history_only.qc2qr_autoconv; + auto qv2qi_vapdep = history_only.qv2qi_vapdep; + auto qc2qi_berg = history_only.qc2qi_berg; + auto qc2qr_ice_shed = history_only.qc2qr_ice_shed; + auto qc2qi_collect = history_only.qc2qi_collect; + auto qr2qi_collect = history_only.qr2qi_collect; + auto qc2qi_hetero_freeze = history_only.qc2qi_hetero_freeze; + auto qr2qi_immers_freeze = history_only.qr2qi_immers_freeze; + auto qi2qr_melt = history_only.qi2qr_melt; + auto qr_sed = history_only.qr_sed; + auto qc_sed = history_only.qc_sed; + auto qi_sed = history_only.qi_sed; auto mu_r = temporaries.mu_r; auto T_atm = temporaries.T_atm; auto lamr = temporaries.lamr; @@ -266,6 +281,9 @@ ::p3_main_internal_disp( nr_incld, ni_incld, bm_incld, mu_c, nu, lamc, cdist, cdist1, cdistr, mu_r, lamr, logn0r, qv2qi_depos_tend, precip_total_tend, nevapr, qr_evap_tend, vap_liq_exchange, vap_ice_exchange, liq_ice_exchange, + qr2qv_evap, qi2qv_sublim, qc2qr_accret, qc2qr_autoconv, + qv2qi_vapdep, qc2qi_berg, qc2qr_ice_shed, qc2qi_collect, + qr2qi_collect, qc2qi_hetero_freeze, qr2qi_immers_freeze, qi2qr_melt, pratot, prctot, nucleationPossible, hydrometeorsPresent, runtime_options); //NOTE: At this point, it is possible to have negative (but small) nc, nr, ni. This is not @@ -283,7 +301,7 @@ ::p3_main_internal_disp( cloud_sedimentation_disp( qc_incld, rho, inv_rho, cld_frac_l, acn, inv_dz, lookup_tables.dnu_table_vals, workspace_mgr, nj, nk, ktop, kbot, kdir, infrastructure.dt, inv_dt, infrastructure.predictNc, - qc, nc, nc_incld, mu_c, lamc, qtend_ignore, ntend_ignore, + qc, nc, nc_incld, mu_c, lamc, qc_sed, ntend_ignore, diagnostic_outputs.precip_liq_surf, nucleationPossible, hydrometeorsPresent); @@ -291,14 +309,14 @@ ::p3_main_internal_disp( rain_sedimentation_disp( rho, inv_rho, rhofacr, cld_frac_r, inv_dz, qr_incld, workspace_mgr, lookup_tables.vn_table_vals, lookup_tables.vm_table_vals, nj, nk, ktop, kbot, kdir, infrastructure.dt, inv_dt, qr, - nr, nr_incld, mu_r, lamr, precip_liq_flux, qtend_ignore, ntend_ignore, + nr, nr_incld, mu_r, lamr, precip_liq_flux, qr_sed, ntend_ignore, diagnostic_outputs.precip_liq_surf, nucleationPossible, hydrometeorsPresent, runtime_options); // Ice sedimentation: (adaptive substepping) ice_sedimentation_disp( rho, inv_rho, rhofaci, cld_frac_i, inv_dz, workspace_mgr, nj, nk, ktop, kbot, kdir, infrastructure.dt, inv_dt, qi, qi_incld, ni, ni_incld, - qm, qm_incld, bm, bm_incld, qtend_ignore, ntend_ignore, + qm, qm_incld, bm, bm_incld, qi_sed, ntend_ignore, lookup_tables.ice_table_vals, diagnostic_outputs.precip_ice_surf, nucleationPossible, hydrometeorsPresent, runtime_options); // homogeneous freezing f cloud and rain diff --git a/components/eamxx/src/physics/p3/disp/p3_main_impl_part2_disp.cpp b/components/eamxx/src/physics/p3/disp/p3_main_impl_part2_disp.cpp index 699f8e46eb59..bceaaa98f46e 100644 --- a/components/eamxx/src/physics/p3/disp/p3_main_impl_part2_disp.cpp +++ b/components/eamxx/src/physics/p3/disp/p3_main_impl_part2_disp.cpp @@ -89,6 +89,18 @@ ::p3_main_part2_disp( const uview_2d& vap_liq_exchange, const uview_2d& vap_ice_exchange, const uview_2d& liq_ice_exchange, + const uview_2d& qr2qv_evap, + const uview_2d& qi2qv_sublim, + const uview_2d& qc2qr_accret, + const uview_2d& qc2qr_autoconv, + const uview_2d& qv2qi_vapdep, + const uview_2d& qc2qi_berg, + const uview_2d& qc2qr_ice_shed, + const uview_2d& qc2qi_collect, + const uview_2d& qr2qi_collect, + const uview_2d& qc2qi_hetero_freeze, + const uview_2d& qr2qi_immers_freeze, + const uview_2d& qi2qr_melt, const uview_2d& pratot, const uview_2d& prctot, const uview_1d& nucleationPossible, @@ -130,6 +142,10 @@ ::p3_main_part2_disp( ekat::subview(cdist1, i), ekat::subview(cdistr, i), ekat::subview(mu_r, i), ekat::subview(lamr, i), ekat::subview(logn0r, i), ekat::subview(qv2qi_depos_tend, i), ekat::subview(precip_total_tend, i), ekat::subview(nevapr, i), ekat::subview(qr_evap_tend, i), ekat::subview(vap_liq_exchange, i), ekat::subview(vap_ice_exchange, i), ekat::subview(liq_ice_exchange, i), + ekat::subview(qr2qv_evap, i), ekat::subview(qi2qv_sublim, i), ekat::subview(qc2qr_accret, i), ekat::subview(qc2qr_autoconv, i), + ekat::subview(qv2qi_vapdep, i), ekat::subview(qc2qi_berg, i), ekat::subview(qc2qr_ice_shed, i), ekat::subview(qc2qi_collect, i), + ekat::subview(qr2qi_collect, i), ekat::subview(qc2qi_hetero_freeze, i), ekat::subview(qr2qi_immers_freeze, i), + ekat::subview(qi2qr_melt, i), ekat::subview(pratot, i), ekat::subview(prctot, i), hydrometeorsPresent(i), nk, runtime_options); if (!hydrometeorsPresent(i)) return; diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp index 1fb05060c19a..bb9dbebcc074 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp @@ -126,6 +126,23 @@ void P3Microphysics::set_grids(const std::shared_ptr grids_m add_field("precip_total_tend", scalar3d_layout_mid, kg/(kg*s), grid_name, ps); add_field("nevapr", scalar3d_layout_mid, kg/(kg*s), grid_name, ps); add_field("diag_equiv_reflectivity", scalar3d_layout_mid, nondim, grid_name, ps); + if (runtime_options.extra_p3_diags) { + add_field("qr2qv_evap", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qi2qv_sublim", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc2qr_accret", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc2qr_autoconv", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qv2qi_vapdep", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc2qi_berg", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc2qr_ice_shed", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc2qi_collect", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qr2qi_collect", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc2qi_hetero_freeze", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qr2qi_immers_freeze", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qi2qr_melt", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qr_sed", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qc_sed", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + add_field("qi_sed", scalar3d_layout_mid, kg/kg/s, grid_name, ps); + } // History Only: (all fields are just outputs and are really only meant for I/O purposes) // TODO: These should be averaged over subcycle as well. But there is no simple mechanism @@ -381,6 +398,41 @@ void P3Microphysics::initialize_impl (const RunType /* run_type */) history_only.liq_ice_exchange = get_field_out("micro_liq_ice_exchange").get_view(); history_only.vap_liq_exchange = get_field_out("micro_vap_liq_exchange").get_view(); history_only.vap_ice_exchange = get_field_out("micro_vap_ice_exchange").get_view(); + if (runtime_options.extra_p3_diags) { + // if we are doing extra diagnostics, assign the fields to the history only struct + history_only.qr2qv_evap = get_field_out("qr2qv_evap").get_view(); + history_only.qi2qv_sublim = get_field_out("qi2qv_sublim").get_view(); + history_only.qc2qr_accret = get_field_out("qc2qr_accret").get_view(); + history_only.qc2qr_autoconv = get_field_out("qc2qr_autoconv").get_view(); + history_only.qv2qi_vapdep = get_field_out("qv2qi_vapdep").get_view(); + history_only.qc2qi_berg = get_field_out("qc2qi_berg").get_view(); + history_only.qc2qr_ice_shed = get_field_out("qc2qr_ice_shed").get_view(); + history_only.qc2qi_collect = get_field_out("qc2qi_collect").get_view(); + history_only.qr2qi_collect = get_field_out("qr2qi_collect").get_view(); + history_only.qc2qi_hetero_freeze = get_field_out("qc2qi_hetero_freeze").get_view(); + history_only.qr2qi_immers_freeze = get_field_out("qr2qi_immers_freeze").get_view(); + history_only.qi2qr_melt = get_field_out("qi2qr_melt").get_view(); + history_only.qr_sed = get_field_out("qr_sed").get_view(); + history_only.qc_sed = get_field_out("qc_sed").get_view(); + history_only.qi_sed = get_field_out("qi_sed").get_view(); + } else { + // if not, let's use the unused buffer + history_only.qr2qv_evap = m_buffer.unused; + history_only.qi2qv_sublim = m_buffer.unused; + history_only.qc2qr_accret = m_buffer.unused; + history_only.qc2qr_autoconv = m_buffer.unused; + history_only.qv2qi_vapdep = m_buffer.unused; + history_only.qc2qi_berg = m_buffer.unused; + history_only.qc2qr_ice_shed = m_buffer.unused; + history_only.qc2qi_collect = m_buffer.unused; + history_only.qr2qi_collect = m_buffer.unused; + history_only.qc2qi_hetero_freeze = m_buffer.unused; + history_only.qr2qi_immers_freeze = m_buffer.unused; + history_only.qi2qr_melt = m_buffer.unused; + history_only.qr_sed = m_buffer.unused; + history_only.qc_sed = m_buffer.unused; + history_only.qi_sed = m_buffer.unused; + } #ifdef SCREAM_P3_SMALL_KERNELS // Temporaries temporaries.mu_r = m_buffer.mu_r; diff --git a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp index f1b858483643..cf6c316b8cf8 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp @@ -32,6 +32,25 @@ void P3Microphysics::run_impl (const double dt) get_field_out("micro_vap_liq_exchange").deep_copy(0.0); get_field_out("micro_vap_ice_exchange").deep_copy(0.0); + // Optional extra p3 diags + if (runtime_options.extra_p3_diags) { + get_field_out("qr2qv_evap").deep_copy(0.0); + get_field_out("qi2qv_sublim").deep_copy(0.0); + get_field_out("qc2qr_accret").deep_copy(0.0); + get_field_out("qc2qr_autoconv").deep_copy(0.0); + get_field_out("qv2qi_vapdep").deep_copy(0.0); + get_field_out("qc2qi_berg").deep_copy(0.0); + get_field_out("qc2qr_ice_shed").deep_copy(0.0); + get_field_out("qc2qi_collect").deep_copy(0.0); + get_field_out("qr2qi_collect").deep_copy(0.0); + get_field_out("qc2qi_hetero_freeze").deep_copy(0.0); + get_field_out("qr2qi_immers_freeze").deep_copy(0.0); + get_field_out("qi2qr_melt").deep_copy(0.0); + get_field_out("qr_sed").deep_copy(0.0); + get_field_out("qc_sed").deep_copy(0.0); + get_field_out("qi_sed").deep_copy(0.0); + } + P3F::p3_main(runtime_options, prog_state, diag_inputs, diag_outputs, infrastructure, history_only, lookup_tables, #ifdef SCREAM_P3_SMALL_KERNELS diff --git a/components/eamxx/src/physics/p3/impl/p3_back_to_cell_average_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_back_to_cell_average_impl.hpp index a6ee8f30a02a..ee59fe52c500 100644 --- a/components/eamxx/src/physics/p3/impl/p3_back_to_cell_average_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_back_to_cell_average_impl.hpp @@ -30,10 +30,11 @@ ::back_to_cell_average( Spack& ncheti_cnt, Spack& qcheti_cnt, Spack& nicnt, Spack& qicnt, Spack& ninuc_cnt, Spack& qinuc_cnt, const Smask& context, const P3Runtime& runtime_options) { - Spack ir_cldm, il_cldm, lr_cldm; + Spack ir_cldm, il_cldm, lr_cldm, cld_frac_glaciated; ir_cldm = min(cld_frac_i,cld_frac_r); // Intersection of ICE and RAIN cloud il_cldm = min(cld_frac_i,cld_frac_l); // Intersection of ICE and LIQUID cloud lr_cldm = min(cld_frac_l,cld_frac_r); // Intersection of LIQUID and RAIN cloud + cld_frac_glaciated = max(0.0001,cld_frac_i - il_cldm); // Fraction (if any) of cell that is occupied by only ice and not liquid cloud // Some process rates take place within the intersection of liquid, rain and // ice cloud fractions. We calculate the intersection as the minimum between @@ -52,7 +53,11 @@ ::back_to_cell_average( ncautr.set(context, ncautr * lr_cldm); // Autoconversion of rain drops within rain/liq cloud // map ice-phase process rates to cell-avg - qi2qv_sublim_tend.set(context, qi2qv_sublim_tend * cld_frac_i); // Sublimation of ice in ice cloud + if (runtime_options.use_separate_ice_liq_frac) { + qi2qv_sublim_tend.set(context, qi2qv_sublim_tend * cld_frac_glaciated); + } else { + qi2qv_sublim_tend.set(context, qi2qv_sublim_tend * cld_frac_i); // Sublimation of ice in ice cloud + } nr_ice_shed_tend.set(context, nr_ice_shed_tend * il_cldm); // Rain # increase due to shedding from rain-ice collisions, occurs when ice and liquid interact qc2qi_hetero_freeze_tend.set(context, qc2qi_hetero_freeze_tend * il_cldm); // Immersion freezing of cloud drops qr2qi_collect_tend.set(context, qr2qi_collect_tend * ir_cldm); // Collection of rain mass by ice @@ -67,14 +72,17 @@ ::back_to_cell_average( nr_collect_tend.set(context, nr_collect_tend * ir_cldm); // Rain number change due to collection from ice ni_selfcollect_tend.set(context, ni_selfcollect_tend * cld_frac_i); // Ice self collection if (runtime_options.use_separate_ice_liq_frac) { - qv2qi_vapdep_tend.set(context, qv2qi_vapdep_tend * (cld_frac_i-il_cldm)); // Vapor deposition to ice phase + qv2qi_vapdep_tend.set(context, qv2qi_vapdep_tend * cld_frac_glaciated); // Vapor deposition to ice phase } else { qv2qi_vapdep_tend.set(context, qv2qi_vapdep_tend * cld_frac_i); // Vapor deposition to ice phase } nr2ni_immers_freeze_tend.set(context, nr2ni_immers_freeze_tend * cld_frac_r); // Change in number due to immersion freezing of rain - ni_sublim_tend.set(context, ni_sublim_tend * cld_frac_i); // Number change due to sublimation of ice + if (runtime_options.use_separate_ice_liq_frac) { + ni_sublim_tend.set(context, ni_sublim_tend * cld_frac_glaciated); + } else { + ni_sublim_tend.set(context, ni_sublim_tend * cld_frac_i); // Number change due to sublimation of ice + } qc2qi_berg_tend.set(context, qc2qi_berg_tend * il_cldm); // Bergeron process - ncheti_cnt.set(context,ncheti_cnt*cld_frac_l); qcheti_cnt.set(context, qcheti_cnt*cld_frac_l); nicnt.set(context, nicnt*cld_frac_l); diff --git a/components/eamxx/src/physics/p3/impl/p3_conservation_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_conservation_impl.hpp index dc9278fe43f3..2a7289265be7 100644 --- a/components/eamxx/src/physics/p3/impl/p3_conservation_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_conservation_impl.hpp @@ -29,6 +29,9 @@ ::cloud_water_conservation(const Spack& qc, const Scalar dt, const auto il_cldm = (runtime_options.use_separate_ice_liq_frac) ? min(cld_frac_i, cld_frac_l) : Spack(1); + const auto cld_frac_glaciated = (runtime_options.use_separate_ice_liq_frac) + ? max(cld_frac_i-il_cldm, 0.0001) + : Spack(1); Spack ratio; constexpr Scalar qtendsmall = C::QTENDSMALL; @@ -68,11 +71,12 @@ ::cloud_water_conservation(const Spack& qc, const Scalar dt, enforce_conservation = sources > qtendsmall && context; if (enforce_conservation.any()){ if (runtime_options.use_separate_ice_liq_frac) { - qv2qi_vapdep_tend.set(enforce_conservation, qv2qi_vapdep_tend + qv2qi_vapdep_tend*(1-ratio)*(il_cldm/(cld_frac_i-il_cldm))); + qv2qi_vapdep_tend.set(enforce_conservation, qv2qi_vapdep_tend + qv2qi_vapdep_tend*(1-ratio)*(il_cldm/cld_frac_glaciated)); + qi2qv_sublim_tend.set(enforce_conservation, qi2qv_sublim_tend + qi2qv_sublim_tend*(1-ratio)*(il_cldm/cld_frac_glaciated)); } else { qv2qi_vapdep_tend.set(enforce_conservation, qv2qi_vapdep_tend*(1-ratio)); + qi2qv_sublim_tend.set(enforce_conservation, qi2qv_sublim_tend*(1-ratio)); } - qi2qv_sublim_tend.set(enforce_conservation, qi2qv_sublim_tend*(1-ratio)); } } diff --git a/components/eamxx/src/physics/p3/impl/p3_main_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_main_impl.hpp index 52731fc15e9f..ce08ae5b31cd 100644 --- a/components/eamxx/src/physics/p3/impl/p3_main_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_main_impl.hpp @@ -199,6 +199,21 @@ ::p3_main_internal( const auto oliq_ice_exchange = ekat::subview(history_only.liq_ice_exchange, i); const auto ovap_liq_exchange = ekat::subview(history_only.vap_liq_exchange, i); const auto ovap_ice_exchange = ekat::subview(history_only.vap_ice_exchange, i); + const auto oqr2qv_evap = ekat::subview(history_only.qr2qv_evap, i); + const auto oqi2qv_sublim = ekat::subview(history_only.qi2qv_sublim, i); + const auto oqc2qr_accret = ekat::subview(history_only.qc2qr_accret,i); + const auto oqc2qr_autoconv = ekat::subview(history_only.qc2qr_autoconv,i); + const auto oqv2qi_vapdep = ekat::subview(history_only.qv2qi_vapdep,i); + const auto oqc2qi_berg = ekat::subview(history_only.qc2qi_berg,i); + const auto oqc2qr_ice_shed = ekat::subview(history_only.qc2qr_ice_shed,i); + const auto oqc2qi_collect = ekat::subview(history_only.qc2qi_collect,i); + const auto oqr2qi_collect = ekat::subview(history_only.qr2qi_collect,i); + const auto oqc2qi_hetero_freeze = ekat::subview(history_only.qc2qi_hetero_freeze,i); + const auto oqr2qi_immers_freeze = ekat::subview(history_only.qr2qi_immers_freeze,i); + const auto oqi2qr_melt = ekat::subview(history_only.qi2qr_melt,i); + const auto oqr_sed = ekat::subview(history_only.qr_sed, i); + const auto oqc_sed = ekat::subview(history_only.qc_sed, i); + const auto oqi_sed = ekat::subview(history_only.qi_sed, i); const auto oqv_prev = ekat::subview(diagnostic_inputs.qv_prev, i); const auto ot_prev = ekat::subview(diagnostic_inputs.t_prev, i); @@ -258,6 +273,8 @@ ::p3_main_internal( nr_incld, ni_incld, bm_incld, mu_c, nu, lamc, cdist, cdist1, cdistr, mu_r, lamr, logn0r, oqv2qi_depos_tend, oprecip_total_tend, onevapr, qr_evap_tend, ovap_liq_exchange, ovap_ice_exchange, oliq_ice_exchange, + oqr2qv_evap, oqi2qv_sublim, oqc2qr_accret, oqc2qr_autoconv, oqv2qi_vapdep, + oqc2qi_berg, oqc2qr_ice_shed, oqc2qi_collect, oqr2qi_collect, oqc2qi_hetero_freeze, oqr2qi_immers_freeze, oqi2qr_melt, pratot, prctot, hydrometeorsPresent, nk, runtime_options); //NOTE: At this point, it is possible to have negative (but small) nc, nr, ni. This is not @@ -278,21 +295,21 @@ ::p3_main_internal( cloud_sedimentation( qc_incld, rho, inv_rho, ocld_frac_l, acn, inv_dz, lookup_tables.dnu_table_vals, team, workspace, nk, ktop, kbot, kdir, infrastructure.dt, inv_dt, infrastructure.predictNc, - oqc, onc, nc_incld, mu_c, lamc, qtend_ignore, ntend_ignore, + oqc, onc, nc_incld, mu_c, lamc, oqc_sed, ntend_ignore, diagnostic_outputs.precip_liq_surf(i)); // Rain sedimentation: (adaptive substepping) rain_sedimentation( rho, inv_rho, rhofacr, ocld_frac_r, inv_dz, qr_incld, team, workspace, lookup_tables.vn_table_vals, lookup_tables.vm_table_vals, nk, ktop, kbot, kdir, infrastructure.dt, inv_dt, oqr, - onr, nr_incld, mu_r, lamr, oprecip_liq_flux, qtend_ignore, ntend_ignore, + onr, nr_incld, mu_r, lamr, oprecip_liq_flux, oqr_sed, ntend_ignore, diagnostic_outputs.precip_liq_surf(i), runtime_options); // Ice sedimentation: (adaptive substepping) ice_sedimentation( rho, inv_rho, rhofaci, ocld_frac_i, inv_dz, team, workspace, nk, ktop, kbot, kdir, infrastructure.dt, inv_dt, oqi, qi_incld, oni, ni_incld, - oqm, qm_incld, obm, bm_incld, qtend_ignore, ntend_ignore, + oqm, qm_incld, obm, bm_incld, oqi_sed, ntend_ignore, lookup_tables.ice_table_vals, diagnostic_outputs.precip_ice_surf(i), runtime_options); // homogeneous freezing of cloud and rain diff --git a/components/eamxx/src/physics/p3/impl/p3_main_impl_part2.hpp b/components/eamxx/src/physics/p3/impl/p3_main_impl_part2.hpp index 9f2399a3c0a3..0dd90df6e9aa 100644 --- a/components/eamxx/src/physics/p3/impl/p3_main_impl_part2.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_main_impl_part2.hpp @@ -92,6 +92,18 @@ ::p3_main_part2( const uview_1d& vap_liq_exchange, const uview_1d& vap_ice_exchange, const uview_1d& liq_ice_exchange, + const uview_1d& qr2qv_evap, + const uview_1d& qi2qv_sublim, + const uview_1d& qc2qr_accret, + const uview_1d& qc2qr_autoconv, + const uview_1d& qv2qi_vapdep, + const uview_1d& qc2qi_berg, + const uview_1d& qc2qr_ice_shed, + const uview_1d& qc2qi_collect, + const uview_1d& qr2qi_collect, + const uview_1d& qc2qi_hetero_freeze, + const uview_1d& qr2qi_immers_freeze, + const uview_1d& qi2qr_melt, const uview_1d& pratot, const uview_1d& prctot, bool& hydrometeorsPresent, const Int& nk, @@ -110,6 +122,7 @@ ::p3_main_part2( const bool do_ice_production = runtime_options.do_ice_production; const bool use_hetfrz_classnuc = runtime_options.use_hetfrz_classnuc; const bool use_separate_ice_liq_frac = runtime_options.use_separate_ice_liq_frac; + const bool extra_p3_diags = runtime_options.extra_p3_diags; team.team_barrier(); hydrometeorsPresent = false; @@ -502,6 +515,22 @@ ::p3_main_part2( vap_liq_exchange(k).set(not_skip_all, -qr2qv_evap_tend); liq_ice_exchange(k).set(not_skip_all, qc2qi_hetero_freeze_tend + qr2qi_immers_freeze_tend - qi2qr_melt_tend + qc2qi_berg_tend + qc2qi_collect_tend + qr2qi_collect_tend); + // set tendencies if extra_p3_diags is true + if (extra_p3_diags) { + qr2qv_evap(k).set(not_skip_all, qr2qv_evap_tend); + qi2qv_sublim(k).set(not_skip_all, qi2qv_sublim_tend); + qc2qr_accret(k).set(not_skip_all, qc2qr_accret_tend); + qc2qr_autoconv(k).set(not_skip_all, qc2qr_autoconv_tend); + qv2qi_vapdep(k).set(not_skip_all, qv2qi_vapdep_tend); + qc2qi_berg(k).set(not_skip_all, qc2qi_berg_tend); + qc2qr_ice_shed(k).set(not_skip_all, qc2qr_ice_shed_tend); + qc2qi_collect(k).set(not_skip_all, qc2qi_collect_tend); + qr2qi_collect(k).set(not_skip_all, qr2qi_collect_tend); + qc2qi_hetero_freeze(k).set(not_skip_all, qc2qi_hetero_freeze_tend); + qr2qi_immers_freeze(k).set(not_skip_all, qr2qi_immers_freeze_tend); + qi2qr_melt(k).set(not_skip_all, qi2qr_melt_tend); + } + // clipping for small hydrometeor values const auto qc_small = qc(k) < qsmall && not_skip_all; const auto qr_small = qr(k) < qsmall && not_skip_all; diff --git a/components/eamxx/src/physics/p3/p3_functions.hpp b/components/eamxx/src/physics/p3/p3_functions.hpp index 772f0a441826..54be2c572ab8 100644 --- a/components/eamxx/src/physics/p3/p3_functions.hpp +++ b/components/eamxx/src/physics/p3/p3_functions.hpp @@ -135,8 +135,9 @@ struct Functions bool set_cld_frac_l_to_one = false; bool set_cld_frac_i_to_one = false; bool set_cld_frac_r_to_one = false; - bool use_hetfrz_classnuc = false; + bool use_hetfrz_classnuc = false; bool use_separate_ice_liq_frac = false; + bool extra_p3_diags = false; void load_runtime_options_from_file(ekat::ParameterList& params) { max_total_ni = params.get("max_total_ni", max_total_ni); @@ -163,8 +164,9 @@ struct Functions set_cld_frac_l_to_one = params.get("set_cld_frac_l_to_one", set_cld_frac_l_to_one); set_cld_frac_i_to_one = params.get("set_cld_frac_i_to_one", set_cld_frac_i_to_one); set_cld_frac_r_to_one = params.get("set_cld_frac_r_to_one", set_cld_frac_r_to_one); - use_hetfrz_classnuc = params.get("use_hetfrz_classnuc", use_hetfrz_classnuc); + use_hetfrz_classnuc = params.get("use_hetfrz_classnuc", use_hetfrz_classnuc); use_separate_ice_liq_frac = params.get("use_separate_ice_liq_frac", use_separate_ice_liq_frac); + extra_p3_diags = params.get("extra_p3_diags", extra_p3_diags); } }; @@ -293,6 +295,22 @@ struct Functions view_2d vap_liq_exchange; // Sum of vap-ice phase change tendencies view_2d vap_ice_exchange; + // extra_p3_diags + view_2d qr2qv_evap; + view_2d qi2qv_sublim; + view_2d qc2qr_accret; + view_2d qc2qr_autoconv; + view_2d qv2qi_vapdep; + view_2d qc2qi_berg; + view_2d qc2qr_ice_shed; + view_2d qc2qi_collect; + view_2d qr2qi_collect; + view_2d qc2qi_hetero_freeze; + view_2d qr2qi_immers_freeze; + view_2d qi2qr_melt; + view_2d qr_sed; + view_2d qc_sed; + view_2d qi_sed; }; // This struct stores kokkos views for the lookup tables needed in p3_main() @@ -1223,6 +1241,18 @@ struct Functions const uview_1d& vap_liq_exchange, const uview_1d& vap_ice_exchange, const uview_1d& liq_ice_exchange, + const uview_1d& qr2qv_evap, + const uview_1d& qi2qv_sublim, + const uview_1d& qc2qr_accret, + const uview_1d& qc2qr_autoconv, + const uview_1d& qv2qi_vapdep, + const uview_1d& qc2qi_berg, + const uview_1d& qc2qr_ice_shed, + const uview_1d& qc2qi_collect, + const uview_1d& qr2qi_collect, + const uview_1d& qc2qi_hetero_freeze, + const uview_1d& qr2qi_immers_freeze, + const uview_1d& qi2qr_melt, const uview_1d& pratot, const uview_1d& prctot, bool& is_hydromet_present, @@ -1304,6 +1334,18 @@ struct Functions const uview_2d& vap_liq_exchange, const uview_2d& vap_ice_exchange, const uview_2d& liq_ice_exchange, + const uview_2d& qr2qv_evap, + const uview_2d& qi2qv_sublim, + const uview_2d& qc2qr_accret, + const uview_2d& qc2qr_autoconv, + const uview_2d& qv2qi_vapdep, + const uview_2d& qc2qi_berg, + const uview_2d& qc2qr_ice_shed, + const uview_2d& qc2qi_collect, + const uview_2d& qr2qi_collect, + const uview_2d& qc2qi_hetero_freeze, + const uview_2d& qr2qi_immers_freeze, + const uview_2d& qi2qr_melt, const uview_2d& pratot, const uview_2d& prctot, const uview_1d& is_nucleat_possible, diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp index 3f567d5c37a8..a3646e739152 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp @@ -955,8 +955,11 @@ void p3_main_part2_host( Real* acn, Real* qv, Real* th_atm, Real* qc, Real* nc, Real* qr, Real* nr, Real* qi, Real* ni, Real* qm, Real* bm, Real* qc_incld, Real* qr_incld, Real* qi_incld, Real* qm_incld, Real* nc_incld, Real* nr_incld, Real* ni_incld, Real* bm_incld, Real* mu_c, Real* nu, Real* lamc, Real* cdist, Real* cdist1, Real* cdistr, Real* mu_r, Real* lamr, Real* logn0r, Real* qv2qi_depos_tend, Real* precip_total_tend, - Real* nevapr, Real* qr_evap_tend, Real* vap_liq_exchange, Real* vap_ice_exchange, Real* liq_ice_exchange, Real* pratot, - Real* prctot, bool* is_hydromet_present) + Real* nevapr, Real* qr_evap_tend, Real* vap_liq_exchange, Real* vap_ice_exchange, Real* liq_ice_exchange, + Real* qr2qv_evap, Real* qi2qv_sublim, Real* qc2qr_accret, Real* qc2qr_autoconv, + Real* qv2qi_vapdep, Real* qc2qi_berg, Real* qc2qr_ice_shed, Real* qc2qi_collect, Real* qr2qi_collect, + Real* qc2qi_hetero_freeze, Real* qr2qi_immers_freeze, Real* qi2qr_melt, + Real* pratot, Real* prctot, bool* is_hydromet_present) { using P3F = Functions; @@ -985,6 +988,21 @@ void p3_main_part2_host( hetfrz_immersion_nucleation_tend = hetfrz_0.data(); hetfrz_contact_nucleation_tend = hetfrz_1.data(); hetfrz_deposition_nucleation_tend = hetfrz_2.data(); + std::vector qr2qv_evap_v(nk,0), qi2qv_sublim_v(nk,0), qc2qr_accret_v(nk,0), qc2qr_autoconv_v(nk,0), qv2qi_vapdep_v(nk,0), + qc2qi_berg_v(nk,0), qc2qr_ice_shed_v(nk,0), qc2qi_collect_v(nk,0), qr2qi_collect_v(nk,0), qc2qi_hetero_freeze_v(nk,0), + qr2qi_immers_freeze_v(nk,0), qi2qr_melt_v(nk,0); + qr2qv_evap = qr2qv_evap_v.data(); + qi2qv_sublim = qi2qv_sublim_v.data(); + qc2qr_accret = qc2qr_accret_v.data(); + qc2qr_autoconv = qc2qr_autoconv_v.data(); + qv2qi_vapdep = qv2qi_vapdep_v.data(); + qc2qi_berg = qc2qi_berg_v.data(); + qc2qr_ice_shed = qc2qr_ice_shed_v.data(); + qc2qi_collect = qc2qi_collect_v.data(); + qr2qi_collect = qr2qi_collect_v.data(); + qc2qi_hetero_freeze = qc2qi_hetero_freeze_v.data(); + qr2qi_immers_freeze = qr2qi_immers_freeze_v.data(); + qi2qr_melt = qi2qr_melt_v.data(); ekat::host_to_device({hetfrz_immersion_nucleation_tend, hetfrz_contact_nucleation_tend, hetfrz_deposition_nucleation_tend, pres, dpres, dz, nc_nuceat_tend, inv_exner, exner, inv_cld_frac_l, inv_cld_frac_i, inv_cld_frac_r, ni_activated, inv_qc_relvar, cld_frac_i, cld_frac_l, cld_frac_r, @@ -992,7 +1010,10 @@ void p3_main_part2_host( qv, th_atm, qc, nc, qr, nr, qi, ni, qm, bm, qc_incld, qr_incld, qi_incld, qm_incld, nc_incld, nr_incld, ni_incld, bm_incld, mu_c, nu, lamc, cdist, cdist1, cdistr, mu_r, lamr, logn0r, qv2qi_depos_tend, precip_total_tend, nevapr, qr_evap_tend, vap_liq_exchange, - vap_ice_exchange, liq_ice_exchange, pratot, prctot, qv_prev, t_prev + vap_ice_exchange, liq_ice_exchange, pratot, prctot, qv_prev, t_prev, + qr2qv_evap, qi2qv_sublim, qc2qr_accret, qc2qr_autoconv, + qv2qi_vapdep, qc2qi_berg, qc2qr_ice_shed, qc2qi_collect, qr2qi_collect, + qc2qi_hetero_freeze, qr2qi_immers_freeze, qi2qr_melt }, nk, temp_d); @@ -1061,7 +1082,19 @@ void p3_main_part2_host( pratot_d (temp_d[current_index++]), prctot_d (temp_d[current_index++]), qv_prev_d (temp_d[current_index++]), - t_prev_d (temp_d[current_index++]); + t_prev_d (temp_d[current_index++]), + qr2qv_evap_d (temp_d[current_index++]), + qi2qv_sublim_d (temp_d[current_index++]), + qc2qr_accret_d (temp_d[current_index++]), + qc2qr_autoconv_d (temp_d[current_index++]), + qv2qi_vapdep_d (temp_d[current_index++]), + qc2qi_berg_d (temp_d[current_index++]), + qc2qr_ice_shed_d (temp_d[current_index++]), + qc2qi_collect_d (temp_d[current_index++]), + qr2qi_collect_d (temp_d[current_index++]), + qc2qi_hetero_freeze_d (temp_d[current_index++]), + qr2qi_immers_freeze_d (temp_d[current_index++]), + qi2qr_melt_d (temp_d[current_index++]); // Call core function from kernel auto tables = P3F::p3_init(); @@ -1085,7 +1118,11 @@ void p3_main_part2_host( qm_incld_d, nc_incld_d, nr_incld_d, ni_incld_d, bm_incld_d, mu_c_d, nu_d, lamc_d, cdist_d, cdist1_d, cdistr_d, mu_r_d, lamr_d, logn0r_d, qv2qi_depos_tend_d, precip_total_tend_d, nevapr_d, qr_evap_tend_d, vap_liq_exchange_d, - vap_ice_exchange_d, liq_ice_exchange_d, pratot_d, prctot_d, bools_d(0),nk, P3F::P3Runtime()); + vap_ice_exchange_d, liq_ice_exchange_d, qr2qv_evap_d, qi2qv_sublim_d, + qc2qr_accret_d, qc2qr_autoconv_d, qv2qi_vapdep_d, qc2qi_berg_d, + qc2qr_ice_shed_d, qc2qi_collect_d, qr2qi_collect_d, + qc2qi_hetero_freeze_d, qr2qi_immers_freeze_d, qi2qr_melt_d, + pratot_d, prctot_d, bools_d(0),nk, P3F::P3Runtime()); }); // Sync back to host. Skip intent in variables. @@ -1096,7 +1133,11 @@ void p3_main_part2_host( nc_incld_d, nr_incld_d, ni_incld_d, bm_incld_d, mu_c_d, nu_d, lamc_d, cdist_d, cdist1_d, cdistr_d, mu_r_d, lamr_d, logn0r_d, qv2qi_depos_tend_d, precip_total_tend_d, nevapr_d, qr_evap_tend_d, vap_liq_exchange_d, vap_ice_exchange_d, - liq_ice_exchange_d, pratot_d, prctot_d + liq_ice_exchange_d, pratot_d, prctot_d, + qr2qv_evap_d, qi2qv_sublim_d, qc2qr_accret_d, qc2qr_autoconv_d, + qv2qi_vapdep_d, qc2qi_berg_d, qc2qr_ice_shed_d, qc2qi_collect_d, + qr2qi_collect_d, qc2qi_hetero_freeze_d, qr2qi_immers_freeze_d, + qi2qr_melt_d }; ekat::device_to_host({ @@ -1105,7 +1146,11 @@ void p3_main_part2_host( qi_incld, qm_incld, nc_incld, nr_incld, ni_incld, bm_incld, mu_c, nu, lamc, cdist, cdist1, cdistr, mu_r, lamr, logn0r, qv2qi_depos_tend, precip_total_tend, nevapr, qr_evap_tend, vap_liq_exchange, vap_ice_exchange, liq_ice_exchange, - pratot, prctot}, + pratot, prctot, + qr2qv_evap, qi2qv_sublim, qc2qr_accret, qc2qr_autoconv, + qv2qi_vapdep, qc2qi_berg, qc2qr_ice_shed, qc2qi_collect, qr2qi_collect, + qc2qi_hetero_freeze, qr2qi_immers_freeze, qi2qr_melt + }, nk, inout_views); const auto bools_h = Kokkos::create_mirror_view(bools_d); @@ -1321,17 +1366,54 @@ Int p3_main_host( std::vector hetfrz_immersion_nucleation_tend(nj*nk, 0.0); std::vector hetfrz_contact_nucleation_tend(nj*nk, 0.0); std::vector hetfrz_deposition_nucleation_tend(nj*nk, 0.0); + std::vector qr2qv_evap(nj*nk, 0.0); + std::vector qi2qv_sublim(nj*nk, 0.0); + std::vector qc2qr_accret(nj*nk, 0.0); + std::vector qc2qr_autoconv(nj*nk, 0.0); + std::vector qv2qi_vapdep(nj*nk, 0.0); + std::vector qc2qi_berg(nj*nk, 0.0); + std::vector qc2qr_ice_shed(nj*nk, 0.0); + std::vector qc2qi_collect(nj*nk, 0.0); + std::vector qr2qi_collect(nj*nk, 0.0); + std::vector qc2qi_hetero_freeze(nj*nk, 0.0); + std::vector qr2qi_immers_freeze(nj*nk, 0.0); + std::vector qi2qr_melt(nj*nk, 0.0); + std::vector qc_sedim(nj*nk, 0.0); + std::vector qr_sedim(nj*nk, 0.0); + std::vector qi_sedim(nj*nk, 0.0); std::vector pointers = { hetfrz_immersion_nucleation_tend.data(), hetfrz_contact_nucleation_tend.data(), - hetfrz_deposition_nucleation_tend.data()}; - std::vector dim1(3, nj); - std::vector dim2(3, nk); - std::vector view(3); + hetfrz_deposition_nucleation_tend.data(), + qr2qv_evap.data(), qi2qv_sublim.data(), + qc2qr_accret.data(), qc2qr_autoconv.data(), + qv2qi_vapdep.data(), qc2qi_berg.data(), + qc2qr_ice_shed.data(), qc2qi_collect.data(), + qr2qi_collect.data(), qc2qi_hetero_freeze.data(), + qr2qi_immers_freeze.data(), qi2qr_melt.data(), + qc_sedim.data(), qr_sedim.data(), qi_sedim.data()}; + std::vector dim1(pointers.size(), nj); + std::vector dim2(pointers.size(), nk); + std::vector view(pointers.size()); ekat::host_to_device(pointers, dim1, dim2, view); view_2d hetfrz_immersion_nucleation_tend_d(view[0]); view_2d hetfrz_contact_nucleation_tend_d(view[1]); view_2d hetfrz_deposition_nucleation_tend_d(view[2]); + view_2d qr2qv_evap_d(view[3]); + view_2d qi2qv_sublim_d(view[4]); + view_2d qc2qr_accret_d(view[5]); + view_2d qc2qr_autoconv_d(view[6]); + view_2d qv2qi_vapdep_d(view[7]); + view_2d qc2qi_berg_d(view[8]); + view_2d qc2qr_ice_shed_d(view[9]); + view_2d qc2qi_collect_d(view[10]); + view_2d qr2qi_collect_d(view[11]); + view_2d qc2qi_hetero_freeze_d(view[12]); + view_2d qr2qi_immers_freeze_d(view[13]); + view_2d qi2qr_melt_d(view[14]); + view_2d qc_sedim_d(view[15]); + view_2d qr_sedim_d(view[16]); + view_2d qi_sedim_d(view[17]); // Special cases: precip_liq_surf=1d(ni), precip_ice_surf=1d(ni), col_location=2d(nj, 3) sview_1d precip_liq_surf_d("precip_liq_surf_d", nj), precip_ice_surf_d("precip_ice_surf_d", nj); @@ -1364,8 +1446,13 @@ Int p3_main_host( rho_qi_d,precip_liq_flux_d, precip_ice_flux_d, precip_total_tend_d, nevapr_d, diag_equiv_reflectivity_d}; P3F::P3Infrastructure infrastructure{dt, it, its, ite, kts, kte, do_predict_nc, do_prescribed_CCN, col_location_d}; - P3F::P3HistoryOnly history_only{liq_ice_exchange_d, vap_liq_exchange_d, - vap_ice_exchange_d}; + P3F::P3HistoryOnly history_only{liq_ice_exchange_d, vap_liq_exchange_d, vap_ice_exchange_d, + qr2qv_evap_d, qi2qv_sublim_d, + qc2qr_accret_d, qc2qr_autoconv_d, qv2qi_vapdep_d, qc2qi_berg_d, + qc2qr_ice_shed_d, qc2qi_collect_d, qr2qi_collect_d, + qc2qi_hetero_freeze_d, qr2qi_immers_freeze_d, qi2qr_melt_d, + qc_sedim_d, qr_sedim_d, qi_sedim_d, + }; const Int nk_pack = ekat::npack(nk); #ifdef SCREAM_P3_SMALL_KERNELS diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp index c30f36e092b2..68f0c20a9e0d 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp @@ -688,7 +688,7 @@ struct P3MainPart1Data : public PhysicsTestData struct P3MainPart2Data : public PhysicsTestData { - static constexpr size_t NUM_ARRAYS = 64; + static constexpr size_t NUM_ARRAYS = 76; // Inputs Int kts, kte, kbot, ktop, kdir; @@ -894,8 +894,11 @@ void p3_main_part2_host( Real* T_atm, Real* rho, Real* inv_rho, Real* qv_sat_l, Real* qv_sat_i, Real* qv_supersat_i, Real* rhofacr, Real* rhofaci, Real* acn, Real* qv, Real* th_atm, Real* qc, Real* nc, Real* qr, Real* nr, Real* qi, Real* ni, Real* qm, Real* bm, Real* qc_incld, Real* qr_incld, Real* qi_incld, Real* qm_incld, Real* nc_incld, Real* nr_incld, Real* ni_incld, Real* bm_incld, Real* mu_c, Real* nu, Real* lamc, Real* cdist, Real* cdist1, Real* cdistr, Real* mu_r, Real* lamr, Real* logn0r, Real* qv2qi_depos_tend, Real* precip_total_tend, - Real* nevapr, Real* qr_evap_tend, Real* vap_liq_exchange, Real* vap_ice_exchange, Real* liq_ice_exchange, Real* pratot, - Real* prctot, bool* is_hydromet_present); + Real* nevapr, Real* qr_evap_tend, Real* vap_liq_exchange, Real* vap_ice_exchange, Real* liq_ice_exchange, + Real* qr2qv_evap, Real* qi2qv_sublim, Real* qc2qr_accret, Real* qc2qr_autoconv, + Real* qv2qi_vapdep, Real* qc2qi_berg, Real* qc2qr_ice_shed, Real* qc2qi_collect, Real* qr2qi_collect, + Real* qc2qi_hetero_freeze, Real* qr2qi_immers_freeze, Real* qi2qr_melt, + Real* pratot, Real* prctot, bool* is_hydromet_present); void p3_main_part3_host( Int kts, Int kte, Int kbot, Int ktop, Int kdir, diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp b/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp index 3fcaa030f813..890a301b9014 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp @@ -2,10 +2,8 @@ #define P3_UNIT_TESTS_COMMON_HPP #include "share/eamxx_types.hpp" -#include "share/util/eamxx_setup_random_test.hpp" #include "p3_functions.hpp" #include "p3_data.hpp" -#include "ekat/util/ekat_test_utils.hpp" #include "p3_test_data.hpp" #include @@ -27,12 +25,6 @@ namespace unit_test { struct UnitWrap { - enum BASELINE_ACTION { - NONE, - COMPARE, - GENERATE - }; - template struct UnitTest : public KokkosTypes { @@ -71,64 +63,15 @@ struct UnitWrap { static constexpr Int max_pack_size = 16; static constexpr Int num_test_itrs = max_pack_size / Spack::n; - struct Base { - std::string m_baseline_path; - std::string m_test_name; - BASELINE_ACTION m_baseline_action; - ekat::FILEPtr m_fid; + struct Base : public UnitBase { Base() : - m_baseline_path(""), - m_test_name(Catch::getResultCapture().getCurrentTestName()), - m_baseline_action(NONE), - m_fid() + UnitBase() { Functions::p3_init(); // many tests will need table data - auto& ts = ekat::TestSession::get(); - if (ts.flags["c"]) { - m_baseline_action = COMPARE; - } - else if (ts.flags["g"]) { - m_baseline_action = GENERATE; - } - else if (ts.flags["n"]) { - m_baseline_action = NONE; - } - m_baseline_path = ts.params["b"]; - - EKAT_REQUIRE_MSG( !(m_baseline_action != NONE && m_baseline_path == ""), - "P3 unit test flags problem: baseline actions were requested but no baseline path was provided"); - - std::string baseline_name = m_baseline_path + "/" + m_test_name; - if (m_baseline_action == COMPARE) { - m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "r")); - } - else if (m_baseline_action == GENERATE) { - m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "w")); - } } - ~Base() {} - - std::mt19937_64 get_engine() - { - if (m_baseline_action != COMPARE) { - // We can use any seed - int seed; - auto engine = setup_random_test(nullptr, &seed); - if (m_baseline_action == GENERATE) { - // Write the seed - ekat::write(&seed, 1, m_fid); - } - return engine; - } - else { - // Read the seed - int seed; - ekat::read(&seed, 1, m_fid); - return setup_random_test(seed); - } - } + ~Base() = default; }; // Put struct decls here diff --git a/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp index 46d10faaa1c9..e324e5a51b08 100644 --- a/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp @@ -178,6 +178,9 @@ void run_bfb_p3_main_part2() std::vector hetfrz_immersion_nucleation_tend(72,0.0); std::vector hetfrz_contact_nucleation_tend(72,0.0); std::vector hetfrz_deposition_nucleation_tend(72,0.0); + std::vector qr2qv_evap(72,0.0), qi2qv_sublim(72,0.0), qc2qr_accret(72,0.0), qc2qr_autoconv(72,0.0), qv2qi_vapdep(72,0.0), + qc2qi_berg(72,0.0), qc2qr_ice_shed(72,0.0), qc2qi_collect(72,0.0), qr2qi_collect(72,0.0), qc2qi_hetero_freeze(72,0.0), + qr2qi_immers_freeze(72,0.0), qi2qr_melt(72,0.0); static constexpr Int num_runs = sizeof(isds_baseline) / sizeof(P3MainPart2Data); for (auto& d : isds_baseline) { @@ -223,8 +226,11 @@ void run_bfb_p3_main_part2() d.T_atm, d.rho, d.inv_rho, d.qv_sat_l, d.qv_sat_i, d.qv_supersat_i, d.rhofacr, d.rhofaci, d.acn, d.qv, d.th_atm, d.qc, d.nc, d.qr, d.nr, d.qi, d.ni, d.qm, d.bm, d.qc_incld, d.qr_incld, d.qi_incld, d.qm_incld, d.nc_incld, d.nr_incld, d.ni_incld, d.bm_incld, d.mu_c, d.nu, d.lamc, d.cdist, d.cdist1, d.cdistr, d.mu_r, d.lamr, d.logn0r, d.qv2qi_depos_tend, d.precip_total_tend, - d.nevapr, d.qr_evap_tend, d.vap_liq_exchange, d.vap_ice_exchange, d.liq_ice_exchange, d.pratot, - d.prctot, &d.is_hydromet_present); + d.nevapr, d.qr_evap_tend, d.vap_liq_exchange, d.vap_ice_exchange, d.liq_ice_exchange, + qr2qv_evap.data(), qi2qv_sublim.data(), qc2qr_accret.data(), qc2qr_autoconv.data(), + qv2qi_vapdep.data(), qc2qi_berg.data(), qc2qr_ice_shed.data(), qc2qi_collect.data(), qr2qi_collect.data(), + qc2qi_hetero_freeze.data(), qr2qi_immers_freeze.data(), qi2qr_melt.data(), + d.pratot, d.prctot, &d.is_hydromet_present); } if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { diff --git a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt index 2387b3af8e5b..e844940c4b4d 100644 --- a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt @@ -2,110 +2,6 @@ include(EkatUtils) include(EkatSetCompilerFlags) include(ScreamUtils) -# Copied from EKAT, YAKL is an interface target so requires special -# handling. Get rid of this once RRTMGP is using kokkos. -macro (SetCudaFlagsYakl targetName) - if (Kokkos_ENABLE_CUDA) - # We must find CUDA - find_package(CUDA REQUIRED) - - # Still check if CUDA_FOUND is true, since we don't know if the particular - # FindCUDA.cmake module being used is checking _FIND_REQUIRED - if (NOT CUDA_FOUND) - message (FATAL_ERROR "Error! Unable to find CUDA.") - endif() - - set(options CUDA_LANG) - set(args1v) - set(argsMv FLAGS) - cmake_parse_arguments(SCF "${options}" "${args1v}" "${argsMv}" ${ARGN}) - - if (SCF_FLAGS) - set (FLAGS ${SCF_FLAGS}) - else () - # We need host-device lambdas - set (FLAGS --expt-extended-lambda) - - IsDebugBuild (SCF_DEBUG) - if (SCF_DEBUG) - # Turn off fused multiply add for debug so we can stay BFB with host - list (APPEND FLAGS --fmad=false) - endif() - endif() - - # Set the flags on the target - if (SCF_CUDA_LANG) - # User is setting the src files language to CUDA - target_compile_options (${targetName} INTERFACE - "$<$:${FLAGS}>") - else() - # We assume the user is setting the src files lang to CXX - target_compile_options (${targetName} INTERFACE - "$<$:${FLAGS}>") - endif() - endif() -endmacro() - -################################## -# YAKL # -################################## - -# RRTMGP++ requires YAKL -if (SCREAM_RRTMGP_ENABLE_YAKL) - string(TOLOWER "${CMAKE_BUILD_TYPE}" CMAKE_BUILD_TYPE_ci) - if (TARGET yakl) - # Other E3SM components are building YAKL... - message ("It appears some other part of E3SM is building YAKL.\n" - "We will reuse that, but if this is a debug build we will\n" - "add the --fmad=false flag to the cuda flags used by YAKL\n") - else () - # Prepare CUDA/HIP flags for YAKL - if (CUDA_BUILD) - string(REPLACE ";" " " KOKKOS_CUDA_OPTIONS_STR "${KOKKOS_CUDA_OPTIONS}") - set(YAKL_ARCH "CUDA") - set(YAKL_CUDA_FLAGS "-DYAKL_ARCH_CUDA ${KOKKOS_CUDA_OPTIONS_STR} --expt-relaxed-constexpr -ccbin ${CMAKE_CXX_COMPILER}") - string (REPLACE " " ";" YAKL_CUDA_FLAGS_LIST ${YAKL_CUDA_FLAGS}) - endif() - if (HIP_BUILD) - set(YAKL_ARCH "HIP") - set(YAKL_HIP_FLAGS "-DYAKL_ARCH_HIP -O3 -D__HIP_ROCclr__ -D__HIP_ARCH_GFX90A__=1 --rocm-path=${ROCM_PATH} --offload-arch=gfx90a -x hip") - string (REPLACE " " ";" YAKL_HIP_FLAGS_LIST ${YAKL_HIP_FLAGS}) - endif() - if (SYCL_BUILD) - set(YAKL_ARCH "SYCL") - set(YAKL_SYCL_FLAGS " -fp-model precise -DYAKL_ARCH_SYCL -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64") - string (REPLACE " " ";" YAKL_SYCL_FLAGS_LIST ${YAKL_SYCL_FLAGS}) - endif() - - set (YAKL_SOURCE_DIR ${SCREAM_BASE_DIR}/../../externals/YAKL) - add_subdirectory(${YAKL_SOURCE_DIR} ${CMAKE_BINARY_DIR}/externals/YAKL) - - # Set some additional flag/cpp option on the yakl target - - cmake_policy (SET CMP0079 NEW) # Allow to link to a tgt from a different directory - - # EAMxx *requires* MPI, so simply look for it, then link against it - find_package(MPI REQUIRED COMPONENTS C) - target_link_libraries (yakl INTERFACE MPI::MPI_C) - - # For debug builds, set -DYAKL_DEBUG - if (CMAKE_BUILD_TYPE_ci STREQUAL "debug") - target_compile_definitions(yakl INTERFACE YAKL_DEBUG) - endif() - endif() - - # See eamxx/src/dynamics/homme/CMakeLists.txt for an explanation of this - # workaround. - if ((SCREAM_MACHINE STREQUAL "ascent" OR SCREAM_MACHINE STREQUAL "pm-gpu") AND CMAKE_BUILD_TYPE_ci STREQUAL "debug") - SetCudaFlagsYakl(yakl CUDA_LANG FLAGS -UNDEBUG) - else() - SetCudaFlagsYakl(yakl CUDA_LANG) - endif() - - list(APPEND CMAKE_MODULE_PATH ${YAKL_SOURCE_DIR}) - include (yakl_utils) -endif() - ################################## # RRTMGP # ################################## @@ -113,42 +9,17 @@ endif() set(EAM_RRTMGP_DIR ${SCREAM_BASE_DIR}/../eam/src/physics/rrtmgp) # Build RRTMGP library; this builds the core RRTMGP external source as a library named "rrtmgp" # NOTE: The external RRTMGP build needs some fixes to work with CUDA in a library build, so for now we will build these ourselves -set(EXTERNAL_SRC - ${EAM_RRTMGP_DIR}/external/cpp/rrtmgp/kernels/mo_gas_optics_kernels.cpp - ${EAM_RRTMGP_DIR}/external/cpp/rrtmgp/mo_rrtmgp_util_reorder.cpp - ${EAM_RRTMGP_DIR}/external/cpp/rte/expand_and_transpose.cpp - ${EAM_RRTMGP_DIR}/external/cpp/rte/kernels/mo_fluxes_broadband_kernels.cpp - ${EAM_RRTMGP_DIR}/external/cpp/rte/kernels/mo_optical_props_kernels.cpp - ${EAM_RRTMGP_DIR}/external/cpp/rte/kernels/mo_rte_solver_kernels.cpp - ${EAM_RRTMGP_DIR}/external/cpp/extensions/fluxes_byband/mo_fluxes_byband_kernels.cpp - ${EAM_RRTMGP_DIR}/external/cpp/examples/all-sky/mo_garand_atmos_io.cpp - ${EAM_RRTMGP_DIR}/external/cpp/examples/all-sky/mo_load_cloud_coefficients.cpp - ${EAM_RRTMGP_DIR}/external/cpp/examples/mo_load_coefficients.cpp -) -add_library(rrtmgp ${EXTERNAL_SRC}) -target_compile_definitions(rrtmgp PUBLIC EAMXX_HAS_RRTMGP) -EkatDisableAllWarning(rrtmgp) -if (SCREAM_RRTMGP_ENABLE_YAKL) - yakl_process_target(rrtmgp) -else() - if (CUDA_BUILD) - target_compile_options(rrtmgp PUBLIC $<$:--expt-relaxed-constexpr>) - endif() +add_library(rrtmgp INTERFACE) +target_compile_definitions(rrtmgp INTERFACE EAMXX_HAS_RRTMGP) +if (Kokkos_ENABLE_CUDA) + target_compile_options(rrtmgp INTERFACE $<$:--expt-relaxed-constexpr>) endif() -# NOTE: cannot use 'PUBLIC' in target_link_libraries, -# since yakl_process_target already used it -# with the "plain" signature if (NOT TARGET Kokkos::kokkos) find_package(Kokkos REQUIRED) endif () -if (SCREAM_RRTMGP_ENABLE_YAKL) - target_link_libraries(rrtmgp yakl Kokkos::kokkos) -else() - target_link_libraries(rrtmgp Kokkos::kokkos) -endif() -target_include_directories(rrtmgp PUBLIC - ${SCREAM_BASE_DIR}/../../externals/YAKL +target_link_libraries(rrtmgp INTERFACE Kokkos::kokkos) +target_include_directories(rrtmgp INTERFACE ${EAM_RRTMGP_DIR}/external/cpp ${EAM_RRTMGP_DIR}/external/cpp/extensions/cloud_optics ${EAM_RRTMGP_DIR}/external/cpp/examples @@ -166,29 +37,14 @@ target_include_directories(rrtmgp PUBLIC # separates out the code that comprises the core RRTMGP library from the extensions # and examples that we have modified for use in SCREAM specifically. -# However, due to the mix of YAKL and Kokkos, we split the target in two: -# - scream_rrtmgp: kokkos-based interface to EAMxx -# - scream_rrtmgp_yakl: source codes to be built with YAKL flags/options - -################################## -# SCREAM_RRTMGP_YAKL # -################################## - set(SCREAM_RRTMGP_SOURCES_INTERFACE eamxx_rrtmgp_interface.cpp ) add_library(eamxx_rrtmgp_interface ${SCREAM_RRTMGP_SOURCES_INTERFACE}) -if (SCREAM_RRTMGP_ENABLE_YAKL) - yakl_process_target(eamxx_rrtmgp_interface) -endif() - -# NOTE: cannot use 'PUBLIC' in target_link_libraries, -# since yakl_process_target already used it -# with the "plain" signature find_library(NETCDF_C netcdf HINTS ${NetCDF_C_PATH} PATH_SUFFIXES lib lib64) -target_link_libraries(eamxx_rrtmgp_interface ${NETCDF_C} rrtmgp scream_share Kokkos::kokkos) +target_link_libraries(eamxx_rrtmgp_interface PUBLIC ${NETCDF_C} rrtmgp scream_share Kokkos::kokkos) target_include_directories(eamxx_rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) target_include_directories(eamxx_rrtmgp_interface SYSTEM PUBLIC @@ -213,19 +69,6 @@ target_include_directories(scream_rrtmgp PUBLIC ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR}/modules) -# If yakl builds with LANG!=CXX, then the yakl CPP defines don't transfer to scream -# targets, b/c of the lang difference. So, if YAKL_ARCH is set, we add -# ${YAKL_${YAKL_ARCH}_FLAGS} flags to the CXX flags of scream_rrtmgp. -# In particular, this will ensure that all the yakl macros -# are correctly defined in YAKL headers, depending on the backend -if (SCREAM_RRTMGP_ENABLE_YAKL) - if (YAKL_ARCH) - target_compile_options(scream_rrtmgp PUBLIC - "$<$:${YAKL_${YAKL_ARCH}_FLAGS_LIST}>") - endif() -endif() - - # Ensure RRTMGP lookup tables are present in the data dir set (RRTMGP_TABLES scream/init/rrtmgp-data-sw-g112-210809.nc diff --git a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.cpp b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.cpp index e59d11dc2f83..ddd9093a5d60 100644 --- a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.cpp +++ b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.cpp @@ -5,1120 +5,13 @@ namespace scream { void init_kls () { -#ifdef RRTMGP_ENABLE_YAKL - // Initialize yakl - if(!yakl::isInitialized()) { yakl::init(); } -#endif -#ifdef RRTMGP_ENABLE_KOKKOS // Initialize kokkos if(!Kokkos::is_initialized()) { Kokkos::initialize(); } -#endif } void finalize_kls() { -#ifdef RRTMGP_ENABLE_YAKL - // Finalize YAKL - yakl::finalize(); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS //Kokkos::finalize(); We do the kokkos finalization elsewhere -#endif } -#ifdef RRTMGP_ENABLE_YAKL -namespace rrtmgp { - -using yakl::fortran::parallel_for; -using yakl::fortran::SimpleBounds; -using yakl::intrinsics::merge; -/* - * Objects containing k-distribution information need to be initialized - * once and then persist throughout the life of the program, so we - * declare them here within the rrtmgp namespace. - */ -GasOpticsRRTMGP k_dist_sw; -GasOpticsRRTMGP k_dist_lw; - -/* - * Objects containing cloud optical property look-up table information. - * We want to initialize these once and use throughout the life of the - * program, so declare here and read data in during rrtmgp_initialize(). - */ -CloudOptics cloud_optics_sw; -CloudOptics cloud_optics_lw; - -bool initialized = false; -bool initialized_k = false; - -// local functions -namespace { - -OpticalProps2str get_cloud_optics_sw( - const int ncol, const int nlay, - CloudOptics &cloud_optics, GasOpticsRRTMGP &kdist, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei) { - - // Initialize optics - OpticalProps2str clouds; - clouds.init(kdist.get_band_lims_wavenumber()); - clouds.alloc_2str(ncol, nlay); - - // Needed for consistency with all-sky example problem? - cloud_optics.set_ice_roughness(2); - - // Limit effective radii to be within bounds of lookup table - auto rel_limited = real2d("rel_limited", ncol, nlay); - auto rei_limited = real2d("rei_limited", ncol, nlay); - limit_to_bounds(rel, cloud_optics.radliq_lwr, cloud_optics.radliq_upr, rel_limited); - limit_to_bounds(rei, cloud_optics.radice_lwr, cloud_optics.radice_upr, rei_limited); - - // Calculate cloud optics - cloud_optics.cloud_optics(ncol, nlay, lwp, iwp, rel_limited, rei_limited, clouds); - - // Return optics - return clouds; -} - -OpticalProps1scl get_cloud_optics_lw( - const int ncol, const int nlay, - CloudOptics &cloud_optics, GasOpticsRRTMGP &kdist, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei) { - - // Initialize optics - OpticalProps1scl clouds; - clouds.init(kdist.get_band_lims_wavenumber()); - clouds.alloc_1scl(ncol, nlay); // this is dumb, why do we need to init and alloc separately?! - - // Needed for consistency with all-sky example problem? - cloud_optics.set_ice_roughness(2); - - // Limit effective radii to be within bounds of lookup table - auto rel_limited = real2d("rel_limited", ncol, nlay); - auto rei_limited = real2d("rei_limited", ncol, nlay); - limit_to_bounds(rel, cloud_optics.radliq_lwr, cloud_optics.radliq_upr, rel_limited); - limit_to_bounds(rei, cloud_optics.radice_lwr, cloud_optics.radice_upr, rei_limited); - - // Calculate cloud optics - cloud_optics.cloud_optics(ncol, nlay, lwp, iwp, rel_limited, rei_limited, clouds); - - // Return optics - return clouds; -} - -OpticalProps2str get_subsampled_clouds( - const int ncol, const int nlay, const int nbnd, const int ngpt, - OpticalProps2str &cloud_optics, GasOpticsRRTMGP &kdist, real2d &cld, real2d &p_lay) { - // Initialized subsampled optics - OpticalProps2str subsampled_optics; - subsampled_optics.init(kdist.get_band_lims_wavenumber(), kdist.get_band_lims_gpoint(), "subsampled_optics"); - subsampled_optics.alloc_2str(ncol, nlay); - // Check that we do not have clouds with no optical properties; this would get corrected - // when we assign optical props, but we want to use a "radiative cloud fraction" - // for the subcolumn sampling too because otherwise we can get vertically-contiguous cloud - // mask profiles with no actual cloud properties in between, which would just further overestimate - // the vertical correlation of cloudy layers. I.e., cloudy layers might look maximally overlapped - // even when separated by layers with no cloud properties, when in fact those layers should be - // randomly overlapped. - auto cldfrac_rad = real2d("cldfrac_rad", ncol, nlay); - memset(cldfrac_rad, 0.0); // Start with all zeros - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nbnd,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { - if (cloud_optics.tau(icol,ilay,ibnd) > 0) { - cldfrac_rad(icol,ilay) = cld(icol,ilay); - } - })); - // Get subcolumn cloud mask; note that get_subcolumn_mask exposes overlap assumption as an option, - // but the only currently supported options are 0 (trivial all-or-nothing cloud) or 1 (max-rand), - // so overlap has not been exposed as an option beyond this subcolumn. In the future, we should - // support generalized overlap as well, with parameters derived from DPSCREAM simulations with very - // high resolution. - int overlap = 1; - // Get unique seeds for each column that are reproducible across different MPI rank layouts; - // use decimal part of pressure for this, consistent with the implementation in EAM - auto seeds = int1d("seeds", ncol); - TIMED_KERNEL(parallel_for(SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - seeds(icol) = 1e9 * (p_lay(icol,nlay) - int(p_lay(icol,nlay))); - })); - auto cldmask = get_subcolumn_mask(ncol, nlay, ngpt, cldfrac_rad, overlap, seeds); - - // Assign optical properties to subcolumns (note this implements MCICA) - auto gpoint_bands = kdist.get_gpoint_bands(); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(ngpt,nlay,ncol), YAKL_LAMBDA(int igpt, int ilay, int icol) { - auto ibnd = gpoint_bands(igpt); - if (cldmask(icol,ilay,igpt) == 1) { - subsampled_optics.tau(icol,ilay,igpt) = cloud_optics.tau(icol,ilay,ibnd); - subsampled_optics.ssa(icol,ilay,igpt) = cloud_optics.ssa(icol,ilay,ibnd); - subsampled_optics.g (icol,ilay,igpt) = cloud_optics.g (icol,ilay,ibnd); - } else { - subsampled_optics.tau(icol,ilay,igpt) = 0; - subsampled_optics.ssa(icol,ilay,igpt) = 0; - subsampled_optics.g (icol,ilay,igpt) = 0; - } - })); - return subsampled_optics; -} - -OpticalProps1scl get_subsampled_clouds( - const int ncol, const int nlay, const int nbnd, const int ngpt, - OpticalProps1scl &cloud_optics, GasOpticsRRTMGP &kdist, real2d &cld, real2d &p_lay) { - // Initialized subsampled optics - OpticalProps1scl subsampled_optics; - subsampled_optics.init(kdist.get_band_lims_wavenumber(), kdist.get_band_lims_gpoint(), "subsampled_optics"); - subsampled_optics.alloc_1scl(ncol, nlay); - // Check that we do not have clouds with no optical properties; this would get corrected - // when we assign optical props, but we want to use a "radiative cloud fraction" - // for the subcolumn sampling too because otherwise we can get vertically-contiguous cloud - // mask profiles with no actual cloud properties in between, which would just further overestimate - // the vertical correlation of cloudy layers. I.e., cloudy layers might look maximally overlapped - // even when separated by layers with no cloud properties, when in fact those layers should be - // randomly overlapped. - auto cldfrac_rad = real2d("cldfrac_rad", ncol, nlay); - memset(cldfrac_rad, 0.0); // Start with all zeros - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nbnd,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { - if (cloud_optics.tau(icol,ilay,ibnd) > 0) { - cldfrac_rad(icol,ilay) = cld(icol,ilay); - } - })); - // Get subcolumn cloud mask - int overlap = 1; - // Get unique seeds for each column that are reproducible across different MPI rank layouts; - // use decimal part of pressure for this, consistent with the implementation in EAM; use different - // seed values for longwave and shortwave - auto seeds = int1d("seeds", ncol); - TIMED_KERNEL(parallel_for(SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - seeds(icol) = 1e9 * (p_lay(icol,nlay-1) - int(p_lay(icol,nlay-1))); - })); - auto cldmask = get_subcolumn_mask(ncol, nlay, ngpt, cldfrac_rad, overlap, seeds); - // Assign optical properties to subcolumns (note this implements MCICA) - auto gpoint_bands = kdist.get_gpoint_bands(); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(ngpt,nlay,ncol), YAKL_LAMBDA(int igpt, int ilay, int icol) { - auto ibnd = gpoint_bands(igpt); - if (cldmask(icol,ilay,igpt) == 1) { - subsampled_optics.tau(icol,ilay,igpt) = cloud_optics.tau(icol,ilay,ibnd); - } else { - subsampled_optics.tau(icol,ilay,igpt) = 0; - } - })); - return subsampled_optics; -} - -} - -/* - * The following routines provide a simple interface to RRTMGP. These - * can be used as-is, but are intended to be wrapped by the SCREAM AD - * interface to radiation. - */ -void rrtmgp_initialize(GasConcs &gas_concs, - const std::string& coefficients_file_sw, const std::string& coefficients_file_lw, - const std::string& cloud_optics_file_sw, const std::string& cloud_optics_file_lw, - const std::shared_ptr& logger) { - - // If we've already initialized, just exit - if (initialized) { - if (logger) - logger->info("RRTMGP is already initialized; skipping\n"); - return; - } - - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - - // Load and initialize absorption coefficient data - load_and_init(k_dist_sw, coefficients_file_sw, gas_concs); - load_and_init(k_dist_lw, coefficients_file_lw, gas_concs); - - // Load and initialize cloud optical property look-up table information - load_cld_lutcoeff(cloud_optics_sw, cloud_optics_file_sw); - load_cld_lutcoeff(cloud_optics_lw, cloud_optics_file_lw); - - // We are now initialized! - initialized = true; -} - -void rrtmgp_finalize() { - initialized = false; - k_dist_sw.finalize(); - k_dist_lw.finalize(); - cloud_optics_sw.finalize(); //~CloudOptics(); - cloud_optics_lw.finalize(); //~CloudOptics(); -} - -void compute_band_by_band_surface_albedos( - const int ncol, const int nswbands, - real1d &sfc_alb_dir_vis, real1d &sfc_alb_dir_nir, - real1d &sfc_alb_dif_vis, real1d &sfc_alb_dif_nir, - real2d &sfc_alb_dir, real2d &sfc_alb_dif) { - - EKAT_ASSERT_MSG(initialized, "Error! rrtmgp_initialize must be called before GasOpticsRRTMGP object can be used."); - auto wavenumber_limits = k_dist_sw.get_band_lims_wavenumber(); - - EKAT_ASSERT_MSG(yakl::intrinsics::size(wavenumber_limits, 1) == 2, - "Error! 1st dimension for wavenumber_limits should be 2."); - EKAT_ASSERT_MSG(yakl::intrinsics::size(wavenumber_limits, 2) == nswbands, - "Error! 2nd dimension for wavenumber_limits should be " + std::to_string(nswbands) + " (nswbands)."); - - // Loop over bands, and determine for each band whether it is broadly in the - // visible or infrared part of the spectrum (visible or "not visible") - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nswbands, ncol), YAKL_LAMBDA(const int ibnd, const int icol) { - - // Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1. - const real visible_wavenumber_threshold = 14286; - - // Wavenumber is in the visible if it is above the visible wavenumber - // threshold, and in the infrared if it is below the threshold - const bool is_visible_wave1 = (wavenumber_limits(1, ibnd) > visible_wavenumber_threshold ? true : false); - const bool is_visible_wave2 = (wavenumber_limits(2, ibnd) > visible_wavenumber_threshold ? true : false); - - if (is_visible_wave1 && is_visible_wave2) { - - // Entire band is in the visible - sfc_alb_dir(icol,ibnd) = sfc_alb_dir_vis(icol); - sfc_alb_dif(icol,ibnd) = sfc_alb_dif_vis(icol); - - } else if (!is_visible_wave1 && !is_visible_wave2) { - - // Entire band is in the longwave (near-infrared) - sfc_alb_dir(icol,ibnd) = sfc_alb_dir_nir(icol); - sfc_alb_dif(icol,ibnd) = sfc_alb_dif_nir(icol); - - } else { - - // Band straddles the visible to near-infrared transition, so we take - // the albedo to be the average of the visible and near-infrared - // broadband albedos - sfc_alb_dir(icol,ibnd) = 0.5*(sfc_alb_dir_vis(icol) + sfc_alb_dir_nir(icol)); - sfc_alb_dif(icol,ibnd) = 0.5*(sfc_alb_dif_vis(icol) + sfc_alb_dif_nir(icol)); - - } - })); -} - -void compute_broadband_surface_fluxes( - const int ncol, const int ktop, const int nswbands, - real3d &sw_bnd_flux_dir , real3d &sw_bnd_flux_dif , - real1d &sfc_flux_dir_vis, real1d &sfc_flux_dir_nir, - real1d &sfc_flux_dif_vis, real1d &sfc_flux_dif_nir) { - // Band 10 straddles the near-IR and visible, so divide contributions from band 10 between both broadband sums - // TODO: Hard-coding these band indices is really bad practice. If the bands ever were to change (like when - // the RRTMG bands were re-ordered for RRTMGP), we would be using the wrong bands for the IR and UV/VIS. This - // should be refactored to grab the correct bands by specifying appropriate wavenumber rather than index. - //sfc_flux_dir_nir(i) = sum(sw_bnd_flux_dir(i+1,kbot,1:9)) + 0.5 * sw_bnd_flux_dir(i+1,kbot,10); - //sfc_flux_dir_vis(i) = sum(sw_bnd_flux_dir(i+1,kbot,11:14)) + 0.5 * sw_bnd_flux_dir(i+1,kbot,10); - //sfc_flux_dif_nir(i) = sum(sw_bnd_flux_dif(i+1,kbot,1:9)) + 0.5 * sw_bnd_flux_dif(i+1,kbot,10); - //sfc_flux_dif_vis(i) = sum(sw_bnd_flux_dif(i+1,kbot,11:14)) + 0.5 * sw_bnd_flux_dif(i+1,kbot,10); - - // Initialize sums over bands - memset(sfc_flux_dir_nir, 0); - memset(sfc_flux_dir_vis, 0); - memset(sfc_flux_dif_nir, 0); - memset(sfc_flux_dif_vis, 0); - - // Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1. - const real visible_wavenumber_threshold = 14286; - auto wavenumber_limits = k_dist_sw.get_band_lims_wavenumber(); - TIMED_KERNEL(parallel_for(SimpleBounds<1>(ncol), YAKL_LAMBDA(const int icol) { - for (int ibnd = 1; ibnd <= nswbands; ++ibnd) { - // Wavenumber is in the visible if it is above the visible wavenumber - // threshold, and in the infrared if it is below the threshold - const bool is_visible_wave1 = (wavenumber_limits(1, ibnd) > visible_wavenumber_threshold ? true : false); - const bool is_visible_wave2 = (wavenumber_limits(2, ibnd) > visible_wavenumber_threshold ? true : false); - - if (is_visible_wave1 && is_visible_wave2) { - - // Entire band is in the visible - sfc_flux_dir_vis(icol) += sw_bnd_flux_dir(icol,ktop,ibnd); - sfc_flux_dif_vis(icol) += sw_bnd_flux_dif(icol,ktop,ibnd); - - } else if (!is_visible_wave1 && !is_visible_wave2) { - - // Entire band is in the longwave (near-infrared) - sfc_flux_dir_nir(icol) += sw_bnd_flux_dir(icol,ktop,ibnd); - sfc_flux_dif_nir(icol) += sw_bnd_flux_dif(icol,ktop,ibnd); - - } else { - - // Band straddles the visible to near-infrared transition, so put half - // the flux in visible and half in near-infrared fluxes - sfc_flux_dir_vis(icol) += 0.5 * sw_bnd_flux_dir(icol,ktop,ibnd); - sfc_flux_dif_vis(icol) += 0.5 * sw_bnd_flux_dif(icol,ktop,ibnd); - sfc_flux_dir_nir(icol) += 0.5 * sw_bnd_flux_dir(icol,ktop,ibnd); - sfc_flux_dif_nir(icol) += 0.5 * sw_bnd_flux_dif(icol,ktop,ibnd); - } - } - })); -} - -void rrtmgp_main( - const int ncol, const int nlay, - real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, - real2d &sfc_alb_dir, real2d &sfc_alb_dif, real1d &mu0, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei, real2d &cldfrac, - real3d &aer_tau_sw, real3d &aer_ssa_sw, real3d &aer_asm_sw, real3d &aer_tau_lw, - real3d &cld_tau_sw_bnd, real3d &cld_tau_lw_bnd, - real3d &cld_tau_sw_gpt, - real3d &cld_tau_lw_gpt, - real2d &sw_flux_up, real2d &sw_flux_dn, real2d &sw_flux_dn_dir, - real2d &lw_flux_up, real2d &lw_flux_dn, - real2d &sw_clnclrsky_flux_up, real2d &sw_clnclrsky_flux_dn, real2d &sw_clnclrsky_flux_dn_dir, - real2d &sw_clrsky_flux_up, real2d &sw_clrsky_flux_dn, real2d &sw_clrsky_flux_dn_dir, - real2d &sw_clnsky_flux_up, real2d &sw_clnsky_flux_dn, real2d &sw_clnsky_flux_dn_dir, - real2d &lw_clnclrsky_flux_up, real2d &lw_clnclrsky_flux_dn, - real2d &lw_clrsky_flux_up, real2d &lw_clrsky_flux_dn, - real2d &lw_clnsky_flux_up, real2d &lw_clnsky_flux_dn, - real3d &sw_bnd_flux_up, real3d &sw_bnd_flux_dn, real3d &sw_bnd_flux_dn_dir, - real3d &lw_bnd_flux_up, real3d &lw_bnd_flux_dn, - const Real tsi_scaling, - const std::shared_ptr& logger, - const bool extra_clnclrsky_diag, const bool extra_clnsky_diag) { - -#ifdef SCREAM_RRTMGP_DEBUG - // Sanity check inputs, and possibly repair - check_range(t_lay , k_dist_sw.get_temp_min(), k_dist_sw.get_temp_max(), "rrtmgp_main::t_lay"); - check_range(t_lev , k_dist_sw.get_temp_min(), k_dist_sw.get_temp_max(), "rrtmgp_main::t_lev"); - check_range(p_lay , k_dist_sw.get_press_min(), k_dist_sw.get_press_max(), "rrtmgp_main::p_lay"); - check_range(p_lev , k_dist_sw.get_press_min(), k_dist_sw.get_press_max(), "rrtmgp_main::p_lev"); - check_range(sfc_alb_dir, 0, 1, "rrtmgp_main::sfc_alb_dir"); - check_range(sfc_alb_dif, 0, 1, "rrtmgp_main::sfc_alb_dif"); - check_range(mu0 , 0, 1, "rrtmgp_main::mu0"); - check_range(lwp , 0, std::numeric_limits::max(), "rrtmgp_main::lwp"); - check_range(iwp , 0, std::numeric_limits::max(), "rrtmgp_main::iwp"); - check_range(rel , 0, std::numeric_limits::max(), "rrtmgp_main::rel"); - check_range(rei , 0, std::numeric_limits::max(), "rrtmgp_main::rei"); -#endif - - // Setup pointers to RRTMGP SW fluxes - FluxesByband fluxes_sw; - fluxes_sw.flux_up = sw_flux_up; - fluxes_sw.flux_dn = sw_flux_dn; - fluxes_sw.flux_dn_dir = sw_flux_dn_dir; - fluxes_sw.bnd_flux_up = sw_bnd_flux_up; - fluxes_sw.bnd_flux_dn = sw_bnd_flux_dn; - fluxes_sw.bnd_flux_dn_dir = sw_bnd_flux_dn_dir; - // Clean-clear-sky - FluxesBroadband clnclrsky_fluxes_sw; - clnclrsky_fluxes_sw.flux_up = sw_clnclrsky_flux_up; - clnclrsky_fluxes_sw.flux_dn = sw_clnclrsky_flux_dn; - clnclrsky_fluxes_sw.flux_dn_dir = sw_clnclrsky_flux_dn_dir; - // Clear-sky - FluxesBroadband clrsky_fluxes_sw; - clrsky_fluxes_sw.flux_up = sw_clrsky_flux_up; - clrsky_fluxes_sw.flux_dn = sw_clrsky_flux_dn; - clrsky_fluxes_sw.flux_dn_dir = sw_clrsky_flux_dn_dir; - // Clean-sky - FluxesBroadband clnsky_fluxes_sw; - clnsky_fluxes_sw.flux_up = sw_clnsky_flux_up; - clnsky_fluxes_sw.flux_dn = sw_clnsky_flux_dn; - clnsky_fluxes_sw.flux_dn_dir = sw_clnsky_flux_dn_dir; - - // Setup pointers to RRTMGP LW fluxes - FluxesByband fluxes_lw; - fluxes_lw.flux_up = lw_flux_up; - fluxes_lw.flux_dn = lw_flux_dn; - fluxes_lw.bnd_flux_up = lw_bnd_flux_up; - fluxes_lw.bnd_flux_dn = lw_bnd_flux_dn; - // Clean-clear-sky - FluxesBroadband clnclrsky_fluxes_lw; - clnclrsky_fluxes_lw.flux_up = lw_clnclrsky_flux_up; - clnclrsky_fluxes_lw.flux_dn = lw_clnclrsky_flux_dn; - // Clear-sky - FluxesBroadband clrsky_fluxes_lw; - clrsky_fluxes_lw.flux_up = lw_clrsky_flux_up; - clrsky_fluxes_lw.flux_dn = lw_clrsky_flux_dn; - // Clean-sky - FluxesBroadband clnsky_fluxes_lw; - clnsky_fluxes_lw.flux_up = lw_clnsky_flux_up; - clnsky_fluxes_lw.flux_dn = lw_clnsky_flux_dn; - - auto nswbands = k_dist_sw.get_nband(); - auto nlwbands = k_dist_lw.get_nband(); - - // Setup aerosol optical properties - OpticalProps2str aerosol_sw; - OpticalProps1scl aerosol_lw; - aerosol_sw.init(k_dist_sw.get_band_lims_wavenumber()); - aerosol_sw.alloc_2str(ncol, nlay); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nswbands,nlay,ncol) , YAKL_LAMBDA (int ibnd, int ilay, int icol) { - aerosol_sw.tau(icol,ilay,ibnd) = aer_tau_sw(icol,ilay,ibnd); - aerosol_sw.ssa(icol,ilay,ibnd) = aer_ssa_sw(icol,ilay,ibnd); - aerosol_sw.g (icol,ilay,ibnd) = aer_asm_sw(icol,ilay,ibnd); - })); - aerosol_lw.init(k_dist_lw.get_band_lims_wavenumber()); - aerosol_lw.alloc_1scl(ncol, nlay); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nlwbands,nlay,ncol) , YAKL_LAMBDA (int ibnd, int ilay, int icol) { - aerosol_lw.tau(icol,ilay,ibnd) = aer_tau_lw(icol,ilay,ibnd); - })); - -#ifdef SCREAM_RRTMGP_DEBUG - // Check aerosol optical properties - // NOTE: these should already have been checked by precondition checks, but someday we might have - // non-trivial aerosol optics, so this is still good to do here. - check_range(aerosol_sw.tau, 0, 1e3, "rrtmgp_main:aerosol_sw.tau"); - check_range(aerosol_sw.ssa, 0, 1, "rrtmgp_main:aerosol_sw.ssa"); //, "aerosol_optics_sw.ssa"); - check_range(aerosol_sw.g , -1, 1, "rrtmgp_main:aerosol_sw.g "); //, "aerosol_optics_sw.g" ); - check_range(aerosol_lw.tau, 0, 1e3, "rrtmgp_main:aerosol_lw.tau"); -#endif - - // Convert cloud physical properties to optical properties for input to RRTMGP - OpticalProps2str clouds_sw = get_cloud_optics_sw(ncol, nlay, cloud_optics_sw, k_dist_sw, lwp, iwp, rel, rei); - OpticalProps1scl clouds_lw = get_cloud_optics_lw(ncol, nlay, cloud_optics_lw, k_dist_lw, lwp, iwp, rel, rei); - clouds_sw.tau.deep_copy_to(cld_tau_sw_bnd); - clouds_lw.tau.deep_copy_to(cld_tau_lw_bnd); - - // Do subcolumn sampling to map bands -> gpoints based on cloud fraction and overlap assumption; - // This implements the Monte Carlo Independing Column Approximation by mapping only a single - // subcolumn (cloud state) to each gpoint. - auto nswgpts = k_dist_sw.get_ngpt(); - auto clouds_sw_gpt = get_subsampled_clouds(ncol, nlay, nswbands, nswgpts, clouds_sw, k_dist_sw, cldfrac, p_lay); - // Longwave - auto nlwgpts = k_dist_lw.get_ngpt(); - auto clouds_lw_gpt = get_subsampled_clouds(ncol, nlay, nlwbands, nlwgpts, clouds_lw, k_dist_lw, cldfrac, p_lay); - - // Copy cloud properties to outputs (is this needed, or can we just use pointers?) - // Alternatively, just compute and output a subcolumn cloud mask - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nswgpts, nlay, ncol), YAKL_LAMBDA (int igpt, int ilay, int icol) { - cld_tau_sw_gpt(icol,ilay,igpt) = clouds_sw_gpt.tau(icol,ilay,igpt); - })); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nlwgpts, nlay, ncol), YAKL_LAMBDA (int igpt, int ilay, int icol) { - cld_tau_lw_gpt(icol,ilay,igpt) = clouds_lw_gpt.tau(icol,ilay,igpt); - })); - -#ifdef SCREAM_RRTMGP_DEBUG - // Perform checks on optics; these would be caught by RRTMGP_EXPENSIVE_CHECKS in the RRTMGP code, - // but we might want to provide additional debug info here. NOTE: we may actually want to move this - // up higher in the code, I think optical props should go up higher since optical props are kind of - // a parameterization of their own, and we might want to swap different choices. These checks go here - // only because we need to run them on computed optical props, so if the optical props themselves get - // computed up higher, then perform these checks higher as well - check_range(clouds_sw.tau, 0, std::numeric_limits::max(), "rrtmgp_main:clouds_sw.tau"); - check_range(clouds_sw.ssa, 0, 1, "rrtmgp_main:clouds_sw.ssa"); - check_range(clouds_sw.g , -1, 1, "rrtmgp_main:clouds_sw.g "); - check_range(clouds_sw.tau, 0, std::numeric_limits::max(), "rrtmgp_main:clouds_sw.tau"); -#endif - - // Do shortwave - rrtmgp_sw( - ncol, nlay, - k_dist_sw, p_lay, t_lay, p_lev, t_lev, gas_concs, - sfc_alb_dir, sfc_alb_dif, mu0, aerosol_sw, clouds_sw_gpt, - fluxes_sw, clnclrsky_fluxes_sw, clrsky_fluxes_sw, clnsky_fluxes_sw, - tsi_scaling, logger, - extra_clnclrsky_diag, extra_clnsky_diag - ); - - // Do longwave - rrtmgp_lw( - ncol, nlay, - k_dist_lw, p_lay, t_lay, p_lev, t_lev, gas_concs, - aerosol_lw, clouds_lw_gpt, - fluxes_lw, clnclrsky_fluxes_lw, clrsky_fluxes_lw, clnsky_fluxes_lw, - extra_clnclrsky_diag, extra_clnsky_diag - ); - -} - -int3d get_subcolumn_mask(const int ncol, const int nlay, const int ngpt, real2d &cldf, const int overlap_option, int1d &seeds) { - - // Routine will return subcolumn mask with values of 0 indicating no cloud, 1 indicating cloud - auto subcolumn_mask = int3d("subcolumn_mask", ncol, nlay, ngpt); - - // Subcolumn generators are a means for producing a variable x(i,j,k), where - // - // c(i,j,k) = 1 for x(i,j,k) > 1 - cldf(i,j) - // c(i,j,k) = 0 for x(i,j,k) <= 1 - cldf(i,j) - // - // I am going to call this "cldx" to be just slightly less ambiguous - auto cldx = real3d("cldx", ncol, nlay, ngpt); - - // Apply overlap assumption to set cldx - if (overlap_option == 0) { // Dummy mask, always cloudy - memset(cldx, 1); - } else { // Default case, maximum-random overlap - // Maximum-random overlap: - // Uses essentially the algorithm described in eq (14) in Raisanen et al. 2004, - // https://rmets.onlinelibrary.wiley.com/doi/epdf/10.1256/qj.03.99. Also the same - // algorithm used in RRTMG implementation of maximum-random overlap (see - // https://github.com/AER-RC/RRTMG_SW/blob/master/src/mcica_subcol_gen_sw.f90) - // - // First, fill cldx with random numbers. Need to use a unique seed for each column! - TIMED_KERNEL(parallel_for(SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - yakl::Random rand(seeds(icol)); - for (int igpt = 1; igpt <= ngpt; igpt++) { - for (int ilay = 1; ilay <= nlay; ilay++) { - cldx(icol,ilay,igpt) = rand.genFP(); - } - } - })); - // Step down columns and apply algorithm from eq (14) - TIMED_KERNEL(parallel_for(SimpleBounds<2>(ngpt,ncol), YAKL_LAMBDA(int igpt, int icol) { - for (int ilay = 2; ilay <= nlay; ilay++) { - // Check cldx in level above and see if it satisfies conditions to create a cloudy subcolumn - if (cldx(icol,ilay-1,igpt) > 1.0 - cldf(icol,ilay-1)) { - // Cloudy subcolumn above, use same random number here so that clouds in these two adjacent - // layers are maximimally overlapped - cldx(icol,ilay,igpt) = cldx(icol,ilay-1,igpt); - } else { - // Cloud-less above, use new random number so that clouds are distributed - // randomly in this layer. Need to scale new random number to range - // [0, 1.0 - cldf(ilay-1)] because we have artifically changed the distribution - // of random numbers in this layer with the above branch of the conditional, - // which would otherwise inflate cloud fraction in this layer. - cldx(icol,ilay,igpt) = cldx(icol,ilay ,igpt) * (1.0 - cldf(icol,ilay-1)); - } - } - })); - } - - // Use cldx array to create subcolumn mask - TIMED_KERNEL(parallel_for(SimpleBounds<3>(ngpt,nlay,ncol), YAKL_LAMBDA(int igpt, int ilay, int icol) { - if (cldx(icol,ilay,igpt) > 1.0 - cldf(icol,ilay)) { - subcolumn_mask(icol,ilay,igpt) = 1; - } else { - subcolumn_mask(icol,ilay,igpt) = 0; - } - })); - return subcolumn_mask; -} - -void rrtmgp_sw( - const int ncol, const int nlay, - GasOpticsRRTMGP &k_dist, - real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, - real2d &sfc_alb_dir, real2d &sfc_alb_dif, real1d &mu0, - OpticalProps2str &aerosol, OpticalProps2str &clouds, - FluxesByband &fluxes, FluxesBroadband &clnclrsky_fluxes, FluxesBroadband &clrsky_fluxes, FluxesBroadband &clnsky_fluxes, - const Real tsi_scaling, - const std::shared_ptr& logger, - const bool extra_clnclrsky_diag, const bool extra_clnsky_diag) { - - // Get problem sizes - int nbnd = k_dist.get_nband(); - int ngpt = k_dist.get_ngpt(); - int ngas = gas_concs.get_num_gases(); - - // Associate local pointers for fluxes - auto &flux_up = fluxes.flux_up; - auto &flux_dn = fluxes.flux_dn; - auto &flux_dn_dir = fluxes.flux_dn_dir; - auto &bnd_flux_up = fluxes.bnd_flux_up; - auto &bnd_flux_dn = fluxes.bnd_flux_dn; - auto &bnd_flux_dn_dir = fluxes.bnd_flux_dn_dir; - auto &clnclrsky_flux_up = clnclrsky_fluxes.flux_up; - auto &clnclrsky_flux_dn = clnclrsky_fluxes.flux_dn; - auto &clnclrsky_flux_dn_dir = clnclrsky_fluxes.flux_dn_dir; - auto &clrsky_flux_up = clrsky_fluxes.flux_up; - auto &clrsky_flux_dn = clrsky_fluxes.flux_dn; - auto &clrsky_flux_dn_dir = clrsky_fluxes.flux_dn_dir; - auto &clnsky_flux_up = clnsky_fluxes.flux_up; - auto &clnsky_flux_dn = clnsky_fluxes.flux_dn; - auto &clnsky_flux_dn_dir = clnsky_fluxes.flux_dn_dir; - - // Reset fluxes to zero - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay+1,ncol), YAKL_LAMBDA(int ilev, int icol) { - flux_up (icol,ilev) = 0; - flux_dn (icol,ilev) = 0; - flux_dn_dir(icol,ilev) = 0; - clnclrsky_flux_up (icol,ilev) = 0; - clnclrsky_flux_dn (icol,ilev) = 0; - clnclrsky_flux_dn_dir(icol,ilev) = 0; - clrsky_flux_up (icol,ilev) = 0; - clrsky_flux_dn (icol,ilev) = 0; - clrsky_flux_dn_dir(icol,ilev) = 0; - clnsky_flux_up (icol,ilev) = 0; - clnsky_flux_dn (icol,ilev) = 0; - clnsky_flux_dn_dir(icol,ilev) = 0; - })); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nbnd,nlay+1,ncol), YAKL_LAMBDA(int ibnd, int ilev, int icol) { - bnd_flux_up (icol,ilev,ibnd) = 0; - bnd_flux_dn (icol,ilev,ibnd) = 0; - bnd_flux_dn_dir(icol,ilev,ibnd) = 0; - })); - - // Get daytime indices - auto dayIndices = int1d("dayIndices", ncol); - memset(dayIndices, -1); - // Loop below has to be done on host, so create host copies - // TODO: there is probably a way to do this on the device - auto dayIndices_h = dayIndices.createHostCopy(); - auto mu0_h = mu0.createHostCopy(); - int nday = 0; - for (int icol = 1; icol <= ncol; icol++) { - if (mu0_h(icol) > 0) { - nday++; - dayIndices_h(nday) = icol; - } - } - - // Copy data back to the device - dayIndices_h.deep_copy_to(dayIndices); - if (nday == 0) { - // No daytime columns in this chunk, skip the rest of this routine - return; - } - - // Subset mu0 - auto mu0_day = real1d("mu0_day", nday); - TIMED_KERNEL(parallel_for(SimpleBounds<1>(nday), YAKL_LAMBDA(int iday) { - mu0_day(iday) = mu0(dayIndices(iday)); - })); - - // subset state variables - auto p_lay_day = real2d("p_lay_day", nday, nlay); - auto t_lay_day = real2d("t_lay_day", nday, nlay); - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay,nday), YAKL_LAMBDA(int ilay, int iday) { - p_lay_day(iday,ilay) = p_lay(dayIndices(iday),ilay); - t_lay_day(iday,ilay) = t_lay(dayIndices(iday),ilay); - })); - auto p_lev_day = real2d("p_lev_day", nday, nlay+1); - auto t_lev_day = real2d("t_lev_day", nday, nlay+1); - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay+1,nday), YAKL_LAMBDA(int ilev, int iday) { - p_lev_day(iday,ilev) = p_lev(dayIndices(iday),ilev); - t_lev_day(iday,ilev) = t_lev(dayIndices(iday),ilev); - })); - - // Subset gases - auto gas_names = gas_concs.get_gas_names(); - GasConcs gas_concs_day; - gas_concs_day.init(gas_names, nday, nlay); - for (int igas = 0; igas < ngas; igas++) { - auto vmr_day = real2d("vmr_day", nday, nlay); - auto vmr = real2d("vmr" , ncol, nlay); - gas_concs.get_vmr(gas_names[igas], vmr); - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay,nday), YAKL_LAMBDA(int ilay, int iday) { - vmr_day(iday,ilay) = vmr(dayIndices(iday),ilay); - })); - gas_concs_day.set_vmr(gas_names[igas], vmr_day); - } - - // Subset aerosol optics - OpticalProps2str aerosol_day; - aerosol_day.init(k_dist.get_band_lims_wavenumber()); - aerosol_day.alloc_2str(nday, nlay); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nbnd,nlay,nday), YAKL_LAMBDA(int ibnd, int ilay, int iday) { - aerosol_day.tau(iday,ilay,ibnd) = aerosol.tau(dayIndices(iday),ilay,ibnd); - aerosol_day.ssa(iday,ilay,ibnd) = aerosol.ssa(dayIndices(iday),ilay,ibnd); - aerosol_day.g (iday,ilay,ibnd) = aerosol.g (dayIndices(iday),ilay,ibnd); - })); - - // Subset cloud optics - // TODO: nbnd -> ngpt once we pass sub-sampled cloud state - OpticalProps2str clouds_day; - clouds_day.init(k_dist.get_band_lims_wavenumber(), k_dist.get_band_lims_gpoint()); - clouds_day.alloc_2str(nday, nlay); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(ngpt,nlay,nday), YAKL_LAMBDA(int igpt, int ilay, int iday) { - clouds_day.tau(iday,ilay,igpt) = clouds.tau(dayIndices(iday),ilay,igpt); - clouds_day.ssa(iday,ilay,igpt) = clouds.ssa(dayIndices(iday),ilay,igpt); - clouds_day.g (iday,ilay,igpt) = clouds.g (dayIndices(iday),ilay,igpt); - })); - - // RRTMGP assumes surface albedos have a screwy dimension ordering - // for some strange reason, so we need to transpose these; also do - // daytime subsetting in the same kernel - real2d sfc_alb_dir_T("sfc_alb_dir", nbnd, nday); - real2d sfc_alb_dif_T("sfc_alb_dif", nbnd, nday); - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nbnd,nday), YAKL_LAMBDA(int ibnd, int icol) { - sfc_alb_dir_T(ibnd,icol) = sfc_alb_dir(dayIndices(icol),ibnd); - sfc_alb_dif_T(ibnd,icol) = sfc_alb_dif(dayIndices(icol),ibnd); - })); - - // Temporaries we need for daytime-only fluxes - auto flux_up_day = real2d("flux_up_day", nday, nlay+1); - auto flux_dn_day = real2d("flux_dn_day", nday, nlay+1); - auto flux_dn_dir_day = real2d("flux_dn_dir_day", nday, nlay+1); - auto bnd_flux_up_day = real3d("bnd_flux_up_day", nday, nlay+1, nbnd); - auto bnd_flux_dn_day = real3d("bnd_flux_dn_day", nday, nlay+1, nbnd); - auto bnd_flux_dn_dir_day = real3d("bnd_flux_dn_dir_day", nday, nlay+1, nbnd); - FluxesByband fluxes_day; - fluxes_day.flux_up = flux_up_day; - fluxes_day.flux_dn = flux_dn_day; - fluxes_day.flux_dn_dir = flux_dn_dir_day; - fluxes_day.bnd_flux_up = bnd_flux_up_day; - fluxes_day.bnd_flux_dn = bnd_flux_dn_day; - fluxes_day.bnd_flux_dn_dir = bnd_flux_dn_dir_day; - - // Allocate space for optical properties - OpticalProps2str optics; - optics.alloc_2str(nday, nlay, k_dist); - - OpticalProps2str optics_no_aerosols; - if (extra_clnsky_diag) { - // Allocate space for optical properties (no aerosols) - optics_no_aerosols.alloc_2str(nday, nlay, k_dist); - } - - // Limit temperatures for gas optics look-up tables - auto t_lay_limited = real2d("t_lay_limited", nday, nlay); - limit_to_bounds(t_lay_day, k_dist_sw.get_temp_min(), k_dist_sw.get_temp_max(), t_lay_limited); - - // Do gas optics - real2d toa_flux("toa_flux", nday, ngpt); - auto p_lay_host = p_lay.createHostCopy(); - bool top_at_1 = p_lay_host(1, 1) < p_lay_host(1, nlay); - - k_dist.gas_optics(nday, nlay, top_at_1, p_lay_day, p_lev_day, t_lay_limited, gas_concs_day, optics, toa_flux); - if (extra_clnsky_diag) { - k_dist.gas_optics(nday, nlay, top_at_1, p_lay_day, p_lev_day, t_lay_limited, gas_concs_day, optics_no_aerosols, toa_flux); - } - -#ifdef SCREAM_RRTMGP_DEBUG - // Check gas optics - check_range(optics.tau, 0, std::numeric_limits::max(), "rrtmgp_sw:optics.tau"); - check_range(optics.ssa, 0, 1, "rrtmgp_sw:optics.ssa"); //, "optics.ssa"); - check_range(optics.g , -1, 1, "rrtmgp_sw:optics.g "); //, "optics.g" ); -#endif - - // Apply tsi_scaling - TIMED_KERNEL(parallel_for(SimpleBounds<2>(ngpt,nday), YAKL_LAMBDA(int igpt, int iday) { - toa_flux(iday,igpt) = tsi_scaling * toa_flux(iday,igpt); - })); - - if (extra_clnclrsky_diag) { - // Compute clear-clean-sky (just gas) fluxes on daytime columns - rte_sw(optics, top_at_1, mu0_day, toa_flux, sfc_alb_dir_T, sfc_alb_dif_T, fluxes_day); - // Expand daytime fluxes to all columns - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay+1,nday), YAKL_LAMBDA(int ilev, int iday) { - int icol = dayIndices(iday); - clnclrsky_flux_up (icol,ilev) = flux_up_day (iday,ilev); - clnclrsky_flux_dn (icol,ilev) = flux_dn_day (iday,ilev); - clnclrsky_flux_dn_dir(icol,ilev) = flux_dn_dir_day(iday,ilev); - })); - } - - // Combine gas and aerosol optics - aerosol_day.delta_scale(); - aerosol_day.increment(optics); - - // Compute clearsky (gas + aerosol) fluxes on daytime columns - rte_sw(optics, top_at_1, mu0_day, toa_flux, sfc_alb_dir_T, sfc_alb_dif_T, fluxes_day); - - // Expand daytime fluxes to all columns - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay+1,nday), YAKL_LAMBDA(int ilev, int iday) { - int icol = dayIndices(iday); - clrsky_flux_up (icol,ilev) = flux_up_day (iday,ilev); - clrsky_flux_dn (icol,ilev) = flux_dn_day (iday,ilev); - clrsky_flux_dn_dir(icol,ilev) = flux_dn_dir_day(iday,ilev); - })); - - // Now merge in cloud optics and do allsky calculations - - // Combine gas and cloud optics - clouds_day.delta_scale(); - clouds_day.increment(optics); - // Compute fluxes on daytime columns - rte_sw(optics, top_at_1, mu0_day, toa_flux, sfc_alb_dir_T, sfc_alb_dif_T, fluxes_day); - // Expand daytime fluxes to all columns - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay+1,nday), YAKL_LAMBDA(int ilev, int iday) { - int icol = dayIndices(iday); - flux_up (icol,ilev) = flux_up_day (iday,ilev); - flux_dn (icol,ilev) = flux_dn_day (iday,ilev); - flux_dn_dir(icol,ilev) = flux_dn_dir_day(iday,ilev); - })); - TIMED_KERNEL(parallel_for(SimpleBounds<3>(nbnd,nlay+1,nday), YAKL_LAMBDA(int ibnd, int ilev, int iday) { - int icol = dayIndices(iday); - bnd_flux_up (icol,ilev,ibnd) = bnd_flux_up_day (iday,ilev,ibnd); - bnd_flux_dn (icol,ilev,ibnd) = bnd_flux_dn_day (iday,ilev,ibnd); - bnd_flux_dn_dir(icol,ilev,ibnd) = bnd_flux_dn_dir_day(iday,ilev,ibnd); - })); - - if (extra_clnsky_diag) { - // First increment clouds in optics_no_aerosols - clouds_day.increment(optics_no_aerosols); - // Compute cleansky (gas + clouds) fluxes on daytime columns - rte_sw(optics_no_aerosols, top_at_1, mu0_day, toa_flux, sfc_alb_dir_T, sfc_alb_dif_T, fluxes_day); - // Expand daytime fluxes to all columns - TIMED_KERNEL(parallel_for(SimpleBounds<2>(nlay+1,nday), YAKL_LAMBDA(int ilev, int iday) { - int icol = dayIndices(iday); - clnsky_flux_up (icol,ilev) = flux_up_day (iday,ilev); - clnsky_flux_dn (icol,ilev) = flux_dn_day (iday,ilev); - clnsky_flux_dn_dir(icol,ilev) = flux_dn_dir_day(iday,ilev); - })); - } -} - -void rrtmgp_lw( - const int ncol, const int nlay, - GasOpticsRRTMGP &k_dist, - real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, - OpticalProps1scl &aerosol, - OpticalProps1scl &clouds, - FluxesByband &fluxes, FluxesBroadband &clnclrsky_fluxes, FluxesBroadband &clrsky_fluxes, FluxesBroadband &clnsky_fluxes, - const bool extra_clnclrsky_diag, const bool extra_clnsky_diag) { - - // Problem size - int nbnd = k_dist.get_nband(); - - // Associate local pointers for fluxes - auto &flux_up = fluxes.flux_up; - auto &flux_dn = fluxes.flux_dn; - auto &bnd_flux_up = fluxes.bnd_flux_up; - auto &bnd_flux_dn = fluxes.bnd_flux_dn; - auto &clnclrsky_flux_up = clnclrsky_fluxes.flux_up; - auto &clnclrsky_flux_dn = clnclrsky_fluxes.flux_dn; - auto &clrsky_flux_up = clrsky_fluxes.flux_up; - auto &clrsky_flux_dn = clrsky_fluxes.flux_dn; - auto &clnsky_flux_up = clnsky_fluxes.flux_up; - auto &clnsky_flux_dn = clnsky_fluxes.flux_dn; - - // Reset fluxes to zero - TIMED_KERNEL(parallel_for( - SimpleBounds<2>(nlay + 1, ncol), YAKL_LAMBDA(int ilev, int icol) { - flux_up(icol, ilev) = 0; - flux_dn(icol, ilev) = 0; - clnclrsky_flux_up(icol, ilev) = 0; - clnclrsky_flux_dn(icol, ilev) = 0; - clrsky_flux_up(icol, ilev) = 0; - clrsky_flux_dn(icol, ilev) = 0; - clnsky_flux_up(icol, ilev) = 0; - clnsky_flux_dn(icol, ilev) = 0; - })); - TIMED_KERNEL(parallel_for( - SimpleBounds<3>(nbnd, nlay + 1, ncol), - YAKL_LAMBDA(int ibnd, int ilev, int icol) { - bnd_flux_up(icol, ilev, ibnd) = 0; - bnd_flux_dn(icol, ilev, ibnd) = 0; - })); - - // Allocate space for optical properties - OpticalProps1scl optics; - optics.alloc_1scl(ncol, nlay, k_dist); - OpticalProps1scl optics_no_aerosols; - if (extra_clnsky_diag) { - // Allocate space for optical properties (no aerosols) - optics_no_aerosols.alloc_1scl(ncol, nlay, k_dist); - } - - // Boundary conditions - SourceFuncLW lw_sources; - lw_sources.alloc(ncol, nlay, k_dist); - real1d t_sfc ("t_sfc" ,ncol); - real2d emis_sfc("emis_sfc",nbnd,ncol); - - // Surface temperature - auto p_lay_host = p_lay.createHostCopy(); - bool top_at_1 = p_lay_host(1, 1) < p_lay_host(1, nlay); - TIMED_KERNEL(parallel_for(SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - t_sfc(icol) = t_lev(icol, merge(nlay+1, 1, top_at_1)); - })); - memset(emis_sfc , 0.98_wp); - - // Get Gaussian quadrature weights - // TODO: move this crap out of userland! - // Weights and angle secants for first order (k=1) Gaussian quadrature. - // Values from Table 2, Clough et al, 1992, doi:10.1029/92JD01419 - // after Abramowitz & Stegun 1972, page 921 - int constexpr max_gauss_pts = 4; - realHost2d gauss_Ds_host ("gauss_Ds" ,max_gauss_pts,max_gauss_pts); - gauss_Ds_host(1,1) = 1.66_wp ; gauss_Ds_host(2,1) = 0._wp; gauss_Ds_host(3,1) = 0._wp; gauss_Ds_host(4,1) = 0._wp; - gauss_Ds_host(1,2) = 1.18350343_wp; gauss_Ds_host(2,2) = 2.81649655_wp; gauss_Ds_host(3,2) = 0._wp; gauss_Ds_host(4,2) = 0._wp; - gauss_Ds_host(1,3) = 1.09719858_wp; gauss_Ds_host(2,3) = 1.69338507_wp; gauss_Ds_host(3,3) = 4.70941630_wp; gauss_Ds_host(4,3) = 0._wp; - gauss_Ds_host(1,4) = 1.06056257_wp; gauss_Ds_host(2,4) = 1.38282560_wp; gauss_Ds_host(3,4) = 2.40148179_wp; gauss_Ds_host(4,4) = 7.15513024_wp; - - realHost2d gauss_wts_host("gauss_wts",max_gauss_pts,max_gauss_pts); - gauss_wts_host(1,1) = 0.5_wp ; gauss_wts_host(2,1) = 0._wp ; gauss_wts_host(3,1) = 0._wp ; gauss_wts_host(4,1) = 0._wp ; - gauss_wts_host(1,2) = 0.3180413817_wp; gauss_wts_host(2,2) = 0.1819586183_wp; gauss_wts_host(3,2) = 0._wp ; gauss_wts_host(4,2) = 0._wp ; - gauss_wts_host(1,3) = 0.2009319137_wp; gauss_wts_host(2,3) = 0.2292411064_wp; gauss_wts_host(3,3) = 0.0698269799_wp; gauss_wts_host(4,3) = 0._wp ; - gauss_wts_host(1,4) = 0.1355069134_wp; gauss_wts_host(2,4) = 0.2034645680_wp; gauss_wts_host(3,4) = 0.1298475476_wp; gauss_wts_host(4,4) = 0.0311809710_wp; - - real2d gauss_Ds ("gauss_Ds" ,max_gauss_pts,max_gauss_pts); - real2d gauss_wts("gauss_wts",max_gauss_pts,max_gauss_pts); - gauss_Ds_host .deep_copy_to(gauss_Ds ); - gauss_wts_host.deep_copy_to(gauss_wts); - - // Limit temperatures for gas optics look-up tables - auto t_lay_limited = real2d("t_lay_limited", ncol, nlay); - auto t_lev_limited = real2d("t_lev_limited", ncol, nlay+1); - limit_to_bounds(t_lay, k_dist_lw.get_temp_min(), k_dist_lw.get_temp_max(), t_lay_limited); - limit_to_bounds(t_lev, k_dist_lw.get_temp_min(), k_dist_lw.get_temp_max(), t_lev_limited); - - // Do gas optics - k_dist.gas_optics(ncol, nlay, top_at_1, p_lay, p_lev, t_lay_limited, t_sfc, gas_concs, optics, lw_sources, real2d(), t_lev_limited); - if (extra_clnsky_diag) { - k_dist.gas_optics(ncol, nlay, top_at_1, p_lay, p_lev, t_lay_limited, t_sfc, gas_concs, optics_no_aerosols, lw_sources, real2d(), t_lev_limited); - } - -#ifdef SCREAM_RRTMGP_DEBUG - // Check gas optics - check_range(optics.tau, 0, std::numeric_limits::max(), "rrtmgp_lw:optics.tau"); -#endif - - if (extra_clnclrsky_diag) { - // Compute clean-clear-sky fluxes before we add in aerosols and clouds - rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, optics, top_at_1, lw_sources, emis_sfc, clnclrsky_fluxes); - } - - // Combine gas and aerosol optics - aerosol.increment(optics); - - // Compute clear-sky fluxes before we add in clouds - rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, optics, top_at_1, lw_sources, emis_sfc, clrsky_fluxes); - - // Combine gas and cloud optics - clouds.increment(optics); - - // Compute allsky fluxes - rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, optics, top_at_1, lw_sources, emis_sfc, fluxes); - - if (extra_clnsky_diag) { - // First increment clouds in optics_no_aerosols - clouds.increment(optics_no_aerosols); - // Compute clean-sky fluxes - rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, optics_no_aerosols, top_at_1, lw_sources, emis_sfc, clnsky_fluxes); - } - -} - -void compute_cloud_area( - int ncol, int nlay, int ngpt, const Real pmin, const Real pmax, - const real2d& pmid, const real3d& cld_tau_gpt, real1d& cld_area) { - // Subcolumn binary cld mask; if any layers with pressure between pmin and pmax are cloudy - // then 2d subcol mask is 1, otherwise it is 0 - auto subcol_mask = real2d("subcol_mask", ncol, ngpt); - memset(subcol_mask, 0); - TIMED_KERNEL(yakl::fortran::parallel_for(SimpleBounds<3>(ngpt, nlay, ncol), YAKL_LAMBDA(int igpt, int ilay, int icol) { - // NOTE: using plev would need to assume level ordering (top to bottom or bottom to top), but - // using play/pmid does not - if (cld_tau_gpt(icol,ilay,igpt) > 0 && pmid(icol,ilay) >= pmin && pmid(icol,ilay) < pmax) { - subcol_mask(icol,igpt) = 1; - } - })); - // Compute average over subcols to get cloud area - auto ngpt_inv = 1.0 / ngpt; - memset(cld_area, 0); - TIMED_KERNEL(yakl::fortran::parallel_for(SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - // This loop needs to be serial because of the atomic reduction - for (int igpt = 1; igpt <= ngpt; ++igpt) { - cld_area(icol) += subcol_mask(icol,igpt) * ngpt_inv; - } - })); -} - -int get_wavelength_index_sw(double wavelength) { return get_wavelength_index(k_dist_sw, wavelength); } - -int get_wavelength_index_lw(double wavelength) { return get_wavelength_index(k_dist_lw, wavelength); } - -int get_wavelength_index(OpticalProps &kdist, double wavelength) { - // Get wavelength bounds for all wavelength bands - auto wavelength_bounds = kdist.get_band_lims_wavelength(); - - // Find the band index for the specified wavelength - // Note that bands are stored in wavenumber space, units of cm-1, so if we are passed wavelength - // in units of meters, we need a conversion factor of 10^2 - int nbnds = kdist.get_nband(); - yakl::ScalarLiveOut band_index(-1); - TIMED_KERNEL(yakl::fortran::parallel_for(SimpleBounds<1>(nbnds), YAKL_LAMBDA(int ibnd) { - if (wavelength_bounds(1,ibnd) < wavelength_bounds(2,ibnd)) { - if (wavelength_bounds(1,ibnd) <= wavelength * 1e2 && wavelength * 1e2 <= wavelength_bounds(2,ibnd)) { - band_index = ibnd; - } - } else { - if (wavelength_bounds(1,ibnd) >= wavelength * 1e2 && wavelength * 1e2 >= wavelength_bounds(2,ibnd)) { - band_index = ibnd; - } - } - })); - return band_index.hostRead(); -} - -void compute_aerocom_cloudtop( - int ncol, int nlay, const real2d &tmid, const real2d &pmid, - const real2d &p_del, const real2d &z_del, const real2d &qc, - const real2d &qi, const real2d &rel, const real2d &rei, - const real2d &cldfrac_tot, const real2d &nc, - real1d &T_mid_at_cldtop, real1d &p_mid_at_cldtop, - real1d &cldfrac_ice_at_cldtop, real1d &cldfrac_liq_at_cldtop, - real1d &cldfrac_tot_at_cldtop, real1d &cdnc_at_cldtop, - real1d &eff_radius_qc_at_cldtop, real1d &eff_radius_qi_at_cldtop) { - /* The goal of this routine is to calculate properties at cloud top - * based on the AeroCom recommendation. See reference for routine - * get_subcolumn_mask above, where equation 14 is used for the - * maximum-random overlap assumption for subcolumn generation. We use - * equation 13, the column counterpart. - */ - // Set outputs to zero - memset(T_mid_at_cldtop, 0.0); - memset(p_mid_at_cldtop, 0.0); - memset(cldfrac_ice_at_cldtop, 0.0); - memset(cldfrac_liq_at_cldtop, 0.0); - memset(cldfrac_tot_at_cldtop, 0.0); - memset(cdnc_at_cldtop, 0.0); - memset(eff_radius_qc_at_cldtop, 0.0); - memset(eff_radius_qi_at_cldtop, 0.0); - // Initialize the 1D "clear fraction" as 1 (totally clear) - auto aerocom_clr = real1d("aerocom_clr", ncol); - memset(aerocom_clr, 1.0); - // Get gravity acceleration constant from constants - using physconst = scream::physics::Constants; - // TODO: move tunable constant to namelist - constexpr real q_threshold = 0.0; // BAD_CONSTANT! - // TODO: move tunable constant to namelist - constexpr real cldfrac_tot_threshold = 0.001; // BAD_CONSTANT! - // Loop over all columns in parallel - TIMED_KERNEL(yakl::fortran::parallel_for( - SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - // Loop over all layers in serial (due to accumulative - // product), starting at 2 (second highest) layer because the - // highest is assumed to hav no clouds - for(int ilay = 2; ilay <= nlay; ++ilay) { - // Only do the calculation if certain conditions are met - if((qc(icol, ilay) + qi(icol, ilay)) > q_threshold && - (cldfrac_tot(icol, ilay) > cldfrac_tot_threshold)) { - /* PART I: Probabilistically determining cloud top */ - // Populate aerocom_tmp as the clear-sky fraction - // probability of this level, where aerocom_clr is that of - // the previous level - auto aerocom_tmp = - aerocom_clr(icol) * - (1.0 - ekat::impl::max(cldfrac_tot(icol, ilay - 1), - cldfrac_tot(icol, ilay))) / - (1.0 - ekat::impl::min(cldfrac_tot(icol, ilay - 1), - 1.0 - cldfrac_tot_threshold)); - // Temporary variable for probability "weights" - auto aerocom_wts = aerocom_clr(icol) - aerocom_tmp; - // Temporary variable for liquid "phase" - auto aerocom_phi = - qc(icol, ilay) / (qc(icol, ilay) + qi(icol, ilay)); - /* PART II: The inferred properties */ - /* In general, converting a 3D property X to a 2D cloud-top - * counterpart x follows: x(i) += X(i,k) * weights * Phase - * but X and Phase are not always needed */ - // T_mid_at_cldtop - T_mid_at_cldtop(icol) += tmid(icol, ilay) * aerocom_wts; - // p_mid_at_cldtop - p_mid_at_cldtop(icol) += pmid(icol, ilay) * aerocom_wts; - // cldfrac_ice_at_cldtop - cldfrac_ice_at_cldtop(icol) += - (1.0 - aerocom_phi) * aerocom_wts; - // cldfrac_liq_at_cldtop - cldfrac_liq_at_cldtop(icol) += aerocom_phi * aerocom_wts; - // cdnc_at_cldtop - /* We need to convert nc from 1/mass to 1/volume first, and - * from grid-mean to in-cloud, but after that, the - * calculation follows the general logic */ - auto cdnc = nc(icol, ilay) * p_del(icol, ilay) / - z_del(icol, ilay) / physconst::gravit / - cldfrac_tot(icol, ilay); - cdnc_at_cldtop(icol) += cdnc * aerocom_phi * aerocom_wts; - // eff_radius_qc_at_cldtop - eff_radius_qc_at_cldtop(icol) += - rel(icol, ilay) * aerocom_phi * aerocom_wts; - // eff_radius_qi_at_cldtop - eff_radius_qi_at_cldtop(icol) += - rei(icol, ilay) * (1.0 - aerocom_phi) * aerocom_wts; - // Reset aerocom_clr to aerocom_tmp to accumulate - aerocom_clr(icol) = aerocom_tmp; - } - } - // After the serial loop over levels, the cloudy fraction is - // defined as (1 - aerocom_clr). This is true because - // aerocom_clr is the result of accumulative probabilities - // (their products) - cldfrac_tot_at_cldtop(icol) = 1.0 - aerocom_clr(icol); - })); -} - -} // namespace rrtmgp -#endif } // namespace scream diff --git a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.hpp b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.hpp index fd762b671d71..af0d935f4bcc 100644 --- a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.hpp +++ b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_interface.hpp @@ -21,9 +21,7 @@ #include "ekat/logging/ekat_logger.hpp" #include "ekat/util/ekat_math_utils.hpp" -#ifdef RRTMGP_ENABLE_KOKKOS #include "Kokkos_Random.hpp" -#endif namespace scream { @@ -32,133 +30,7 @@ void finalize_kls(); namespace rrtmgp { -#ifdef RRTMGP_ENABLE_YAKL -extern GasOpticsRRTMGP k_dist_sw; -extern GasOpticsRRTMGP k_dist_lw; - -extern CloudOptics cloud_optics_sw; -extern CloudOptics cloud_optics_lw; - -extern bool initialized; - -void rrtmgp_initialize( - GasConcs &gas_concs, - const std::string& coefficients_file_sw, const std::string& coefficients_file_lw, - const std::string& cloud_optics_file_sw, const std::string& cloud_optics_file_lw, - const std::shared_ptr& logger); - -void compute_band_by_band_surface_albedos( - const int ncol, const int nswbands, - real1d &sfc_alb_dir_vis, real1d &sfc_alb_dir_nir, - real1d &sfc_alb_dif_vis, real1d &sfc_alb_dif_nir, - real2d &sfc_alb_dir, real2d &sfc_alb_dif); - -void compute_broadband_surface_fluxes( - const int ncol, const int ktop, const int nswbands, - real3d &sw_bnd_flux_dir , real3d &sw_bnd_flux_dif , - real1d &sfc_flux_dir_vis, real1d &sfc_flux_dir_nir, - real1d &sfc_flux_dif_vis, real1d &sfc_flux_dif_nir); - -void rrtmgp_main( - const int ncol, const int nlay, - real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, - real2d &sfc_alb_dir, real2d &sfc_alb_dif, real1d &mu0, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei, real2d &cldfrac, - real3d &aer_tau_sw, real3d &aer_ssa_sw, real3d &aer_asm_sw, real3d &aer_tau_lw, - real3d &cld_tau_sw_bnd, real3d &cld_tau_lw_bnd, - real3d &cld_tau_sw_gpt, real3d &cld_tau_lw_gpt, - real2d &sw_flux_up, real2d &sw_flux_dn, real2d &sw_flux_dn_dir, - real2d &lw_flux_up, real2d &lw_flux_dn, - real2d &sw_clnclrsky_flux_up, real2d &sw_clnclrsky_flux_dn, real2d &sw_clnclrsky_flux_dn_dir, - real2d &sw_clrsky_flux_up, real2d &sw_clrsky_flux_dn, real2d &sw_clrsky_flux_dn_dir, - real2d &sw_clnsky_flux_up, real2d &sw_clnsky_flux_dn, real2d &sw_clnsky_flux_dn_dir, - real2d &lw_clnclrsky_flux_up, real2d &lw_clnclrsky_flux_dn, - real2d &lw_clrsky_flux_up, real2d &lw_clrsky_flux_dn, - real2d &lw_clnsky_flux_up, real2d &lw_clnsky_flux_dn, - real3d &sw_bnd_flux_up, real3d &sw_bnd_flux_dn, real3d &sw_bnd_flux_dn_dir, - real3d &lw_bnd_flux_up, real3d &lw_bnd_flux_dn, - const Real tsi_scaling, - const std::shared_ptr& logger, - const bool extra_clnclrsky_diag = false, const bool extra_clnsky_diag = false); - -void rrtmgp_finalize(); - -void rrtmgp_sw( - const int ncol, const int nlay, - GasOpticsRRTMGP &k_dist, - real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, - real2d &sfc_alb_dir, real2d &sfc_alb_dif, real1d &mu0, - OpticalProps2str &aerosol, OpticalProps2str &clouds, - FluxesByband &fluxes, FluxesBroadband &clnclrsky_fluxes, FluxesBroadband &clrsky_fluxes, FluxesBroadband &clnsky_fluxes, - const Real tsi_scaling, - const std::shared_ptr& logger, - const bool extra_clnclrsky_diag, const bool extra_clnsky_diag); - -void rrtmgp_lw( - const int ncol, const int nlay, - GasOpticsRRTMGP &k_dist, - real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, - OpticalProps1scl &aerosol, OpticalProps1scl &clouds, - FluxesByband &fluxes, FluxesBroadband &clnclrsky_fluxes, FluxesBroadband &clrsky_fluxes, FluxesBroadband &clnsky_fluxes, - const bool extra_clnclrsky_diag, const bool extra_clnsky_diag); - -int3d get_subcolumn_mask(const int ncol, const int nlay, const int ngpt, real2d &cldf, const int overlap_option, int1d &seeds); - -void compute_cloud_area( - int ncol, int nlay, int ngpt, Real pmin, Real pmax, - const real2d& pmid, const real3d& cld_tau_gpt, real1d& cld_area); - -void compute_aerocom_cloudtop( - int ncol, int nlay, const real2d &tmid, const real2d &pmid, - const real2d &p_del, const real2d &z_del, const real2d &qc, - const real2d &qi, const real2d &rel, const real2d &rei, - const real2d &cldfrac_tot, const real2d &nc, - real1d &T_mid_at_cldtop, real1d &p_mid_at_cldtop, - real1d &cldfrac_ice_at_cldtop, real1d &cldfrac_liq_at_cldtop, - real1d &cldfrac_tot_at_cldtop, real1d &cdnc_at_cldtop, - real1d &eff_radius_qc_at_cldtop, real1d &eff_radius_qi_at_cldtop); - -template -void mixing_ratio_to_cloud_mass( - yakl::Array const &mixing_ratio, - yakl::Array const &cloud_fraction, - yakl::Array const &dp, - yakl::Array &cloud_mass) { - int ncol = mixing_ratio.dimension[0]; - int nlay = mixing_ratio.dimension[1]; - using physconst = scream::physics::Constants; - TIMED_KERNEL(yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay, ncol), YAKL_LAMBDA(int ilay, int icol) { - // Compute in-cloud mixing ratio (mixing ratio of the cloudy part of the layer) - // NOTE: these thresholds (from E3SM) seem arbitrary, but included here for consistency - // This limits in-cloud mixing ratio to 0.005 kg/kg. According to note in cloud_diagnostics - // in EAM, this is consistent with limits in MG2. Is this true for P3? - if (cloud_fraction(icol,ilay) > 0) { - // Compute layer-integrated cloud mass (per unit area) - auto incloud_mixing_ratio = std::min(mixing_ratio(icol,ilay) / std::max(0.0001, cloud_fraction(icol,ilay)), 0.005); - cloud_mass(icol,ilay) = incloud_mixing_ratio * dp(icol,ilay) / physconst::gravit; - } else { - cloud_mass(icol,ilay) = 0; - } - })); -} - -template -void limit_to_bounds(S const &arr_in, T const lower, T const upper, S &arr_out) { - TIMED_KERNEL(yakl::c::parallel_for(arr_in.totElems(), YAKL_LAMBDA(int i) { - arr_out.data()[i] = std::min(std::max(arr_in.data()[i], lower), upper); - })); -} - -int get_wavelength_index(OpticalProps &kdist, double wavelength); -int get_wavelength_index_sw(double wavelength); -int get_wavelength_index_lw(double wavelength); -#endif // RRTMGP_ENABLE_YAKL - // New interface for Kokkos and flexible types -#ifdef RRTMGP_ENABLE_KOKKOS template struct rrtmgp_interface { @@ -1636,7 +1508,6 @@ static optical_props1_t get_subsampled_clouds( } }; // struct rrtmgp_interface -#endif // RRTMGP_ENABLE_KOKKOS } // namespace rrtmgp } // namespace scream diff --git a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp index 6b8f183d079b..9801c6d6201c 100644 --- a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp +++ b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp @@ -13,9 +13,6 @@ #include "ekat/ekat_assert.hpp" #include "cpp/rrtmgp/mo_gas_concentrations.h" -#ifdef RRTMGP_ENABLE_YAKL -#include "YAKL.h" -#endif namespace scream { @@ -82,6 +79,9 @@ RRTMGPRadiation (const ekat::Comm& comm, const ekat::ParameterList& params) } m_ngas = m_gas_names.size(); + + // Determine rad timestep, specified as number of atm steps + m_rad_freq_in_steps = m_params.get("rad_frequency", 1); } void RRTMGPRadiation::set_grids(const std::shared_ptr grids_manager) { @@ -201,7 +201,6 @@ void RRTMGPRadiation::set_grids(const std::shared_ptr grids_ add_field("LW_clrsky_flux_dn", scalar3d_int, W/m2, grid_name); add_field("LW_clnsky_flux_up", scalar3d_int, W/m2, grid_name); add_field("LW_clnsky_flux_dn", scalar3d_int, W/m2, grid_name); - add_field("rad_heating_pdel", scalar3d_mid, Pa*K/s, grid_name); // Cloud properties added as computed fields for diagnostic purposes add_field("cldlow" , scalar2d, nondim, grid_name); add_field("cldmed" , scalar2d, nondim, grid_name); @@ -222,6 +221,11 @@ void RRTMGPRadiation::set_grids(const std::shared_ptr grids_ add_field("eff_radius_qc_at_cldtop", scalar2d, micron, grid_name); add_field("eff_radius_qi_at_cldtop", scalar2d, micron, grid_name); + // This field is needed for restart + Field rad_heating_pdel (FieldIdentifier("rad_heating_pdel", scalar3d_mid, Pa*K/s, grid_name)); + rad_heating_pdel.allocate_view(); + add_internal_field(rad_heating_pdel); + // Translation of variables from EAM // -------------------------------------------------------------- // EAM name | EAMXX name | Description @@ -233,12 +237,19 @@ void RRTMGPRadiation::set_grids(const std::shared_ptr grids_ // netsw sfc_flux_sw_net net (down - up) SW flux at surface // flwds sfc_flux_lw_dn downwelling LW flux at surface // -------------------------------------------------------------- - add_field("sfc_flux_dir_nir", scalar2d, W/m2, grid_name); - add_field("sfc_flux_dir_vis", scalar2d, W/m2, grid_name); - add_field("sfc_flux_dif_nir", scalar2d, W/m2, grid_name); - add_field("sfc_flux_dif_vis", scalar2d, W/m2, grid_name); - add_field("sfc_flux_sw_net" , scalar2d, W/m2, grid_name); - add_field("sfc_flux_lw_dn" , scalar2d, W/m2, grid_name); + + // We need to ensure that these fields are added to the RESTART group, + // since the cpl will need them at every step, and rrtmgp may not run + // the 1st step after restart (depending on rad freq). + // NOTE: technically, we know rad freq, so we *could* avoid adding them + // to the rest file if rad_freq=1. But a) that is not common at high + // res anyways, and b) that could prevent changing rad_freq upon restart + add_field("sfc_flux_dir_nir", scalar2d, W/m2, grid_name, "RESTART"); + add_field("sfc_flux_dir_vis", scalar2d, W/m2, grid_name, "RESTART"); + add_field("sfc_flux_dif_nir", scalar2d, W/m2, grid_name, "RESTART"); + add_field("sfc_flux_dif_vis", scalar2d, W/m2, grid_name, "RESTART"); + add_field("sfc_flux_sw_net" , scalar2d, W/m2, grid_name, "RESTART"); + add_field("sfc_flux_lw_dn" , scalar2d, W/m2, grid_name, "RESTART"); // Boundary flux fields for energy and mass conservation checks if (has_column_conservation_check()) { @@ -248,6 +259,9 @@ void RRTMGPRadiation::set_grids(const std::shared_ptr grids_ add_field("heat_flux", scalar2d, W/m2, grid_name); } + // Working fields that we also want for diagnostic output + add_field("cosine_solar_zenith_angle", scalar2d, nondim, grid_name); + // Load bands bounds from coefficients files and compute the band centerpoint. // Store both in the grid (if not already present) const auto cm = centi*m; @@ -300,12 +314,7 @@ size_t RRTMGPRadiation::requested_buffer_size_in_bytes() const Buffer::num_3d_nlay_nswbands*m_col_chunk_size*(m_nlay)*m_nswbands + Buffer::num_3d_nlay_nlwbands*m_col_chunk_size*(m_nlay)*m_nlwbands + Buffer::num_3d_nlay_nswgpts*m_col_chunk_size*(m_nlay)*m_nswgpts + - Buffer::num_3d_nlay_nlwgpts*m_col_chunk_size*(m_nlay)*m_nlwgpts * -#if defined(RRTMGP_ENABLE_YAKL) && defined(RRTMGP_ENABLE_KOKKOS) - 2; -#else - 1; -#endif + Buffer::num_3d_nlay_nlwgpts*m_col_chunk_size*(m_nlay)*m_nlwgpts; return interface_request * sizeof(Real); } // RRTMGPRadiation::requested_buffer_size @@ -317,152 +326,7 @@ void RRTMGPRadiation::init_buffers(const ATMBufferManager &buffer_manager) Real* mem = reinterpret_cast(buffer_manager.get_memory()); -#ifdef RRTMGP_ENABLE_YAKL - // 1d arrays - m_buffer.mu0 = decltype(m_buffer.mu0)("mu0", mem, m_col_chunk_size); - mem += m_buffer.mu0.totElems(); - m_buffer.sfc_alb_dir_vis = decltype(m_buffer.sfc_alb_dir_vis)("sfc_alb_dir_vis", mem, m_col_chunk_size); - mem += m_buffer.sfc_alb_dir_vis.totElems(); - m_buffer.sfc_alb_dir_nir = decltype(m_buffer.sfc_alb_dir_nir)("sfc_alb_dir_nir", mem, m_col_chunk_size); - mem += m_buffer.sfc_alb_dir_nir.totElems(); - m_buffer.sfc_alb_dif_vis = decltype(m_buffer.sfc_alb_dif_vis)("sfc_alb_dif_vis", mem, m_col_chunk_size); - mem += m_buffer.sfc_alb_dif_vis.totElems(); - m_buffer.sfc_alb_dif_nir = decltype(m_buffer.sfc_alb_dif_nir)("sfc_alb_dif_nir", mem, m_col_chunk_size); - mem += m_buffer.sfc_alb_dif_nir.totElems(); - m_buffer.sfc_flux_dir_vis = decltype(m_buffer.sfc_flux_dir_vis)("sfc_flux_dir_vis", mem, m_col_chunk_size); - mem += m_buffer.sfc_flux_dir_vis.totElems(); - m_buffer.sfc_flux_dir_nir = decltype(m_buffer.sfc_flux_dir_nir)("sfc_flux_dir_nir", mem, m_col_chunk_size); - mem += m_buffer.sfc_flux_dir_nir.totElems(); - m_buffer.sfc_flux_dif_vis = decltype(m_buffer.sfc_flux_dif_vis)("sfc_flux_dif_vis", mem, m_col_chunk_size); - mem += m_buffer.sfc_flux_dif_vis.totElems(); - m_buffer.sfc_flux_dif_nir = decltype(m_buffer.sfc_flux_dif_nir)("sfc_flux_dif_nir", mem, m_col_chunk_size); - mem += m_buffer.sfc_flux_dif_nir.totElems(); - m_buffer.cosine_zenith = decltype(m_buffer.cosine_zenith)(mem, m_col_chunk_size); - mem += m_buffer.cosine_zenith.size(); - - // 2d arrays - m_buffer.p_lay = decltype(m_buffer.p_lay)("p_lay", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.p_lay.totElems(); - m_buffer.t_lay = decltype(m_buffer.t_lay)("t_lay", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.t_lay.totElems(); - m_buffer.z_del = decltype(m_buffer.z_del)("z_del", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.z_del.totElems(); - m_buffer.p_del = decltype(m_buffer.p_del)("p_del", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.p_del.totElems(); - m_buffer.qc = decltype(m_buffer.qc)("qc", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.qc.totElems(); - m_buffer.nc = decltype(m_buffer.nc)("nc", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.nc.totElems(); - m_buffer.qi = decltype(m_buffer.qi)("qi", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.qi.totElems(); - m_buffer.cldfrac_tot = decltype(m_buffer.cldfrac_tot)("cldfrac_tot", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.cldfrac_tot.totElems(); - m_buffer.eff_radius_qc = decltype(m_buffer.eff_radius_qc)("eff_radius_qc", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.eff_radius_qc.totElems(); - m_buffer.eff_radius_qi = decltype(m_buffer.eff_radius_qi)("eff_radius_qi", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.eff_radius_qi.totElems(); - m_buffer.tmp2d = decltype(m_buffer.tmp2d)("tmp2d", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.tmp2d.totElems(); - m_buffer.lwp = decltype(m_buffer.lwp)("lwp", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.lwp.totElems(); - m_buffer.iwp = decltype(m_buffer.iwp)("iwp", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.iwp.totElems(); - m_buffer.sw_heating = decltype(m_buffer.sw_heating)("sw_heating", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.sw_heating.totElems(); - m_buffer.lw_heating = decltype(m_buffer.lw_heating)("lw_heating", mem, m_col_chunk_size, m_nlay); - mem += m_buffer.lw_heating.totElems(); - m_buffer.p_lev = decltype(m_buffer.p_lev)("p_lev", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.p_lev.totElems(); - m_buffer.t_lev = decltype(m_buffer.t_lev)("t_lev", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.t_lev.totElems(); - m_buffer.d_tint = decltype(m_buffer.d_tint)(mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.d_tint.size(); - m_buffer.d_dz = decltype(m_buffer.d_dz )(mem, m_col_chunk_size, m_nlay); - mem += m_buffer.d_dz.size(); - // 3d arrays - m_buffer.sw_flux_up = decltype(m_buffer.sw_flux_up)("sw_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_flux_up.totElems(); - m_buffer.sw_flux_dn = decltype(m_buffer.sw_flux_dn)("sw_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_flux_dn.totElems(); - m_buffer.sw_flux_dn_dir = decltype(m_buffer.sw_flux_dn_dir)("sw_flux_dn_dir", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_flux_dn_dir.totElems(); - m_buffer.lw_flux_up = decltype(m_buffer.lw_flux_up)("lw_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_flux_up.totElems(); - m_buffer.lw_flux_dn = decltype(m_buffer.lw_flux_dn)("lw_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_flux_dn.totElems(); - m_buffer.sw_clnclrsky_flux_up = decltype(m_buffer.sw_clnclrsky_flux_up)("sw_clnclrsky_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clnclrsky_flux_up.totElems(); - m_buffer.sw_clnclrsky_flux_dn = decltype(m_buffer.sw_clnclrsky_flux_dn)("sw_clnclrsky_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clnclrsky_flux_dn.totElems(); - m_buffer.sw_clnclrsky_flux_dn_dir = decltype(m_buffer.sw_clnclrsky_flux_dn_dir)("sw_clnclrsky_flux_dn_dir", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clnclrsky_flux_dn_dir.totElems(); - m_buffer.sw_clrsky_flux_up = decltype(m_buffer.sw_clrsky_flux_up)("sw_clrsky_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clrsky_flux_up.totElems(); - m_buffer.sw_clrsky_flux_dn = decltype(m_buffer.sw_clrsky_flux_dn)("sw_clrsky_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clrsky_flux_dn.totElems(); - m_buffer.sw_clrsky_flux_dn_dir = decltype(m_buffer.sw_clrsky_flux_dn_dir)("sw_clrsky_flux_dn_dir", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clrsky_flux_dn_dir.totElems(); - m_buffer.sw_clnsky_flux_up = decltype(m_buffer.sw_clnsky_flux_up)("sw_clnsky_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clnsky_flux_up.totElems(); - m_buffer.sw_clnsky_flux_dn = decltype(m_buffer.sw_clnsky_flux_dn)("sw_clnsky_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clnsky_flux_dn.totElems(); - m_buffer.sw_clnsky_flux_dn_dir = decltype(m_buffer.sw_clnsky_flux_dn_dir)("sw_clnsky_flux_dn_dir", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.sw_clnsky_flux_dn_dir.totElems(); - m_buffer.lw_clnclrsky_flux_up = decltype(m_buffer.lw_clnclrsky_flux_up)("lw_clnclrsky_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_clnclrsky_flux_up.totElems(); - m_buffer.lw_clnclrsky_flux_dn = decltype(m_buffer.lw_clnclrsky_flux_dn)("lw_clnclrsky_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_clnclrsky_flux_dn.totElems(); - m_buffer.lw_clrsky_flux_up = decltype(m_buffer.lw_clrsky_flux_up)("lw_clrsky_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_clrsky_flux_up.totElems(); - m_buffer.lw_clrsky_flux_dn = decltype(m_buffer.lw_clrsky_flux_dn)("lw_clrsky_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_clrsky_flux_dn.totElems(); - m_buffer.lw_clnsky_flux_up = decltype(m_buffer.lw_clnsky_flux_up)("lw_clnsky_flux_up", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_clnsky_flux_up.totElems(); - m_buffer.lw_clnsky_flux_dn = decltype(m_buffer.lw_clnsky_flux_dn)("lw_clnsky_flux_dn", mem, m_col_chunk_size, m_nlay+1); - mem += m_buffer.lw_clnsky_flux_dn.totElems(); - // 3d arrays with nswbands dimension (shortwave fluxes by band) - m_buffer.sw_bnd_flux_up = decltype(m_buffer.sw_bnd_flux_up)("sw_bnd_flux_up", mem, m_col_chunk_size, m_nlay+1, m_nswbands); - mem += m_buffer.sw_bnd_flux_up.totElems(); - m_buffer.sw_bnd_flux_dn = decltype(m_buffer.sw_bnd_flux_dn)("sw_bnd_flux_dn", mem, m_col_chunk_size, m_nlay+1, m_nswbands); - mem += m_buffer.sw_bnd_flux_dn.totElems(); - m_buffer.sw_bnd_flux_dir = decltype(m_buffer.sw_bnd_flux_dir)("sw_bnd_flux_dir", mem, m_col_chunk_size, m_nlay+1, m_nswbands); - mem += m_buffer.sw_bnd_flux_dir.totElems(); - m_buffer.sw_bnd_flux_dif = decltype(m_buffer.sw_bnd_flux_dif)("sw_bnd_flux_dif", mem, m_col_chunk_size, m_nlay+1, m_nswbands); - mem += m_buffer.sw_bnd_flux_dif.totElems(); - // 3d arrays with nlwbands dimension (longwave fluxes by band) - m_buffer.lw_bnd_flux_up = decltype(m_buffer.lw_bnd_flux_up)("lw_bnd_flux_up", mem, m_col_chunk_size, m_nlay+1, m_nlwbands); - mem += m_buffer.lw_bnd_flux_up.totElems(); - m_buffer.lw_bnd_flux_dn = decltype(m_buffer.lw_bnd_flux_dn)("lw_bnd_flux_dn", mem, m_col_chunk_size, m_nlay+1, m_nlwbands); - mem += m_buffer.lw_bnd_flux_dn.totElems(); - // 2d arrays with extra nswbands dimension (surface albedos by band) - m_buffer.sfc_alb_dir = decltype(m_buffer.sfc_alb_dir)("sfc_alb_dir", mem, m_col_chunk_size, m_nswbands); - mem += m_buffer.sfc_alb_dir.totElems(); - m_buffer.sfc_alb_dif = decltype(m_buffer.sfc_alb_dif)("sfc_alb_dif", mem, m_col_chunk_size, m_nswbands); - mem += m_buffer.sfc_alb_dif.totElems(); - // 3d arrays with extra band dimension (aerosol optics by band) - m_buffer.aero_tau_sw = decltype(m_buffer.aero_tau_sw)("aero_tau_sw", mem, m_col_chunk_size, m_nlay, m_nswbands); - mem += m_buffer.aero_tau_sw.totElems(); - m_buffer.aero_ssa_sw = decltype(m_buffer.aero_ssa_sw)("aero_ssa_sw", mem, m_col_chunk_size, m_nlay, m_nswbands); - mem += m_buffer.aero_ssa_sw.totElems(); - m_buffer.aero_g_sw = decltype(m_buffer.aero_g_sw )("aero_g_sw" , mem, m_col_chunk_size, m_nlay, m_nswbands); - mem += m_buffer.aero_g_sw.totElems(); - m_buffer.aero_tau_lw = decltype(m_buffer.aero_tau_lw)("aero_tau_lw", mem, m_col_chunk_size, m_nlay, m_nlwbands); - mem += m_buffer.aero_tau_lw.totElems(); - // 3d arrays with extra ngpt dimension (cloud optics by gpoint; primarily for debugging) - m_buffer.cld_tau_sw_gpt = decltype(m_buffer.cld_tau_sw_gpt)("cld_tau_sw_gpt", mem, m_col_chunk_size, m_nlay, m_nswgpts); - mem += m_buffer.cld_tau_sw_gpt.totElems(); - m_buffer.cld_tau_lw_gpt = decltype(m_buffer.cld_tau_lw_gpt)("cld_tau_lw_gpt", mem, m_col_chunk_size, m_nlay, m_nlwgpts); - mem += m_buffer.cld_tau_lw_gpt.totElems(); - m_buffer.cld_tau_sw_bnd = decltype(m_buffer.cld_tau_sw_bnd)("cld_tau_sw_bnd", mem, m_col_chunk_size, m_nlay, m_nswbands); - mem += m_buffer.cld_tau_sw_bnd.totElems(); - m_buffer.cld_tau_lw_bnd = decltype(m_buffer.cld_tau_lw_bnd)("cld_tau_lw_bnd", mem, m_col_chunk_size, m_nlay, m_nlwbands); - mem += m_buffer.cld_tau_lw_bnd.totElems(); -#endif - -#ifdef RRTMGP_ENABLE_KOKKOS // 1d arrays - m_buffer.mu0_k = decltype(m_buffer.mu0_k)(mem, m_col_chunk_size); - mem += m_buffer.mu0_k.size(); m_buffer.sfc_alb_dir_vis_k = decltype(m_buffer.sfc_alb_dir_vis_k)(mem, m_col_chunk_size); mem += m_buffer.sfc_alb_dir_vis_k.size(); m_buffer.sfc_alb_dir_nir_k = decltype(m_buffer.sfc_alb_dir_nir_k)(mem, m_col_chunk_size); @@ -479,8 +343,6 @@ void RRTMGPRadiation::init_buffers(const ATMBufferManager &buffer_manager) mem += m_buffer.sfc_flux_dif_vis_k.size(); m_buffer.sfc_flux_dif_nir_k = decltype(m_buffer.sfc_flux_dif_nir_k)(mem, m_col_chunk_size); mem += m_buffer.sfc_flux_dif_nir_k.size(); - m_buffer.cosine_zenith = decltype(m_buffer.cosine_zenith)(mem, m_col_chunk_size); - mem += m_buffer.cosine_zenith.size(); // 2d arrays m_buffer.p_lay_k = decltype(m_buffer.p_lay_k)(mem, m_col_chunk_size, m_nlay); @@ -599,18 +461,14 @@ void RRTMGPRadiation::init_buffers(const ATMBufferManager &buffer_manager) mem += m_buffer.cld_tau_sw_bnd_k.size(); m_buffer.cld_tau_lw_bnd_k = decltype(m_buffer.cld_tau_lw_bnd_k)(mem, m_col_chunk_size, m_nlay, m_nlwbands); mem += m_buffer.cld_tau_lw_bnd_k.size(); -#endif size_t used_mem = (reinterpret_cast(mem) - buffer_manager.get_memory())*sizeof(Real); EKAT_REQUIRE_MSG(used_mem==requested_buffer_size_in_bytes(), "Error! Used memory != requested memory for RRTMGPRadiation."); } // RRTMGPRadiation::init_buffers -void RRTMGPRadiation::initialize_impl(const RunType /* run_type */) { +void RRTMGPRadiation::initialize_impl(const RunType run_type) { using PC = scream::physics::Constants; - // Determine rad timestep, specified as number of atm steps - m_rad_freq_in_steps = m_params.get("rad_frequency", 1); - // Determine orbital year. If orbital_year is negative, use current year // from timestamp for orbital year; if positive, use provided orbital year // for duration of simulation. @@ -639,19 +497,19 @@ void RRTMGPRadiation::initialize_impl(const RunType /* run_type */) { // Whether or not to do MCICA subcolumn sampling m_do_subcol_sampling = m_params.get("do_subcol_sampling",true); - // Initialize yakl + // Initialize kokkos init_kls(); // Names of active gases - auto gas_names_yakl_offset = string1dv(m_ngas); - m_gas_mol_weights = real1dk("gas_mol_weights",m_ngas); + auto gas_names_offset = string1dv(m_ngas); + m_gas_mol_weights = real1dk("gas_mol_weights",m_ngas); // the lookup function for getting the gas mol weights doesn't work on device auto gas_mol_w_host = Kokkos::create_mirror_view(m_gas_mol_weights); for (int igas = 0; igas < m_ngas; igas++) { const auto& gas_name = m_gas_names[igas]; - gas_names_yakl_offset[igas] = gas_name; - gas_mol_w_host[igas] = PC::get_gas_mol_weight(gas_name); + gas_names_offset[igas] = gas_name; + gas_mol_w_host[igas] = PC::get_gas_mol_weight(gas_name); } Kokkos::deep_copy(m_gas_mol_weights,gas_mol_w_host); @@ -661,19 +519,9 @@ void RRTMGPRadiation::initialize_impl(const RunType /* run_type */) { std::string coefficients_file_lw = m_params.get("rrtmgp_coefficients_file_lw"); std::string cloud_optics_file_sw = m_params.get("rrtmgp_cloud_optics_file_sw"); std::string cloud_optics_file_lw = m_params.get("rrtmgp_cloud_optics_file_lw"); -#ifdef RRTMGP_ENABLE_YAKL - m_gas_concs.init(gas_names_yakl_offset,m_col_chunk_size,m_nlay); - rrtmgp::rrtmgp_initialize( - m_gas_concs, - coefficients_file_sw, coefficients_file_lw, - cloud_optics_file_sw, cloud_optics_file_lw, - m_atm_logger - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS const double multiplier = m_params.get("pool_size_multiplier", 1.0); - m_gas_concs_k.init(gas_names_yakl_offset,m_col_chunk_size,m_nlay); + m_gas_concs_k.init(gas_names_offset,m_col_chunk_size,m_nlay); interface_t::rrtmgp_initialize( m_gas_concs_k, coefficients_file_sw, coefficients_file_lw, @@ -681,12 +529,6 @@ void RRTMGPRadiation::initialize_impl(const RunType /* run_type */) { m_atm_logger, multiplier ); - VALIDATE_KOKKOS(m_gas_concs, m_gas_concs_k); - VALIDATE_KOKKOS(rrtmgp::k_dist_sw, *interface_t::k_dist_sw_k); - VALIDATE_KOKKOS(rrtmgp::k_dist_lw, *interface_t::k_dist_lw_k); - VALIDATE_KOKKOS(rrtmgp::cloud_optics_sw, *interface_t::cloud_optics_sw_k); - VALIDATE_KOKKOS(rrtmgp::cloud_optics_lw, *interface_t::cloud_optics_lw_k); -#endif // Set property checks for fields in this process add_invariant_check(get_field_out("T_mid"),m_grid,100.0, 500.0,false); @@ -700,6 +542,13 @@ void RRTMGPRadiation::initialize_impl(const RunType /* run_type */) { auto co_vmr = get_field_out("co_volume_mix_ratio").get_view(); Kokkos::deep_copy(co_vmr, m_params.get("covmr", 1.0e-7)); } + + // Ensure rad_heating_pdel is recognized as initialized by the driver + auto& rad_heating = get_internal_field("rad_heating_pdel"); + rad_heating.get_header().get_tracking().update_time_stamp(start_of_step_ts()); + + m_force_run_on_next_step = run_type==RunType::Initial or + m_params.get("force_run_after_restart",false); } // ========================================================================================= @@ -765,7 +614,7 @@ void RRTMGPRadiation::run_impl (const double dt) { auto d_lw_clrsky_flux_dn = get_field_out("LW_clrsky_flux_dn").get_view(); auto d_lw_clnsky_flux_up = get_field_out("LW_clnsky_flux_up").get_view(); auto d_lw_clnsky_flux_dn = get_field_out("LW_clnsky_flux_dn").get_view(); - auto d_rad_heating_pdel = get_field_out("rad_heating_pdel").get_view(); + auto d_rad_heating_pdel = get_internal_field("rad_heating_pdel").get_view(); auto d_sfc_flux_dir_vis = get_field_out("sfc_flux_dir_vis").get_view(); auto d_sfc_flux_dir_nir = get_field_out("sfc_flux_dir_nir").get_view(); auto d_sfc_flux_dif_vis = get_field_out("sfc_flux_dif_vis").get_view(); @@ -806,21 +655,15 @@ void RRTMGPRadiation::run_impl (const double dt) { const auto do_aerosol_rad = m_do_aerosol_rad; // Are we going to update fluxes and heating this step? - auto ts = start_of_step_ts(); - auto update_rad = scream::rrtmgp::radiation_do(m_rad_freq_in_steps, ts.get_num_steps()); + auto ts = end_of_step_ts(); + auto update_rad = m_force_run_on_next_step or scream::rrtmgp::radiation_do(m_rad_freq_in_steps, ts.get_num_steps()); if (update_rad) { // On each chunk, we internally "reset" the GasConcs object to subview the concs 3d array // with the correct ncol dimension. So let's keep a copy of the original (ref-counted) // array, to restore at the end inside the m_gast_concs object. -#ifdef RRTMGP_ENABLE_YAKL - auto gas_concs = m_gas_concs.concs; - auto orig_ncol = m_gas_concs.ncol; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS auto gas_concs_k = m_gas_concs_k.concs; auto orig_ncol_k = m_gas_concs_k.ncol; -#endif // Compute orbital parameters; these are used both for computing // the solar zenith angle and also for computing total solar @@ -897,6 +740,9 @@ void RRTMGPRadiation::run_impl (const double dt) { } } + // Get solar zenith angle device view + auto d_mu0 = get_field_out("cosine_solar_zenith_angle").get_view(); + // Loop over each chunk of columns for (int ic=0; ic real1d { - return real1d(v.label(),v.myData,ncol); - }; - auto subview_2d = [&](const real2d v) -> real2d { - return real2d(v.label(),v.myData,ncol,v.dimension[1]); - }; - auto subview_3d = [&](const real3d v) -> real3d { - return real3d(v.label(),v.myData,ncol,v.dimension[1],v.dimension[2]); - }; - - auto p_lay = subview_2d(m_buffer.p_lay); - auto t_lay = subview_2d(m_buffer.t_lay); - auto p_lev = subview_2d(m_buffer.p_lev); - auto z_del = subview_2d(m_buffer.z_del); - auto p_del = subview_2d(m_buffer.p_del); - auto t_lev = subview_2d(m_buffer.t_lev); - auto mu0 = subview_1d(m_buffer.mu0); - auto sfc_alb_dir = subview_2d(m_buffer.sfc_alb_dir); - auto sfc_alb_dif = subview_2d(m_buffer.sfc_alb_dif); - auto sfc_alb_dir_vis = subview_1d(m_buffer.sfc_alb_dir_vis); - auto sfc_alb_dir_nir = subview_1d(m_buffer.sfc_alb_dir_nir); - auto sfc_alb_dif_vis = subview_1d(m_buffer.sfc_alb_dif_vis); - auto sfc_alb_dif_nir = subview_1d(m_buffer.sfc_alb_dif_nir); - auto qc = subview_2d(m_buffer.qc); - auto nc = subview_2d(m_buffer.nc); - auto qi = subview_2d(m_buffer.qi); - auto cldfrac_tot = subview_2d(m_buffer.cldfrac_tot); - auto rel = subview_2d(m_buffer.eff_radius_qc); - auto rei = subview_2d(m_buffer.eff_radius_qi); - auto sw_flux_up = subview_2d(m_buffer.sw_flux_up); - auto sw_flux_dn = subview_2d(m_buffer.sw_flux_dn); - auto sw_flux_dn_dir = subview_2d(m_buffer.sw_flux_dn_dir); - auto lw_flux_up = subview_2d(m_buffer.lw_flux_up); - auto lw_flux_dn = subview_2d(m_buffer.lw_flux_dn); - auto sw_clnclrsky_flux_up = subview_2d(m_buffer.sw_clnclrsky_flux_up); - auto sw_clnclrsky_flux_dn = subview_2d(m_buffer.sw_clnclrsky_flux_dn); - auto sw_clnclrsky_flux_dn_dir = subview_2d(m_buffer.sw_clnclrsky_flux_dn_dir); - auto sw_clrsky_flux_up = subview_2d(m_buffer.sw_clrsky_flux_up); - auto sw_clrsky_flux_dn = subview_2d(m_buffer.sw_clrsky_flux_dn); - auto sw_clrsky_flux_dn_dir = subview_2d(m_buffer.sw_clrsky_flux_dn_dir); - auto sw_clnsky_flux_up = subview_2d(m_buffer.sw_clnsky_flux_up); - auto sw_clnsky_flux_dn = subview_2d(m_buffer.sw_clnsky_flux_dn); - auto sw_clnsky_flux_dn_dir = subview_2d(m_buffer.sw_clnsky_flux_dn_dir); - auto lw_clnclrsky_flux_up = subview_2d(m_buffer.lw_clnclrsky_flux_up); - auto lw_clnclrsky_flux_dn = subview_2d(m_buffer.lw_clnclrsky_flux_dn); - auto lw_clrsky_flux_up = subview_2d(m_buffer.lw_clrsky_flux_up); - auto lw_clrsky_flux_dn = subview_2d(m_buffer.lw_clrsky_flux_dn); - auto lw_clnsky_flux_up = subview_2d(m_buffer.lw_clnsky_flux_up); - auto lw_clnsky_flux_dn = subview_2d(m_buffer.lw_clnsky_flux_dn); - auto sw_bnd_flux_up = subview_3d(m_buffer.sw_bnd_flux_up); - auto sw_bnd_flux_dn = subview_3d(m_buffer.sw_bnd_flux_dn); - auto sw_bnd_flux_dir = subview_3d(m_buffer.sw_bnd_flux_dir); - auto sw_bnd_flux_dif = subview_3d(m_buffer.sw_bnd_flux_dif); - auto lw_bnd_flux_up = subview_3d(m_buffer.lw_bnd_flux_up); - auto lw_bnd_flux_dn = subview_3d(m_buffer.lw_bnd_flux_dn); - auto sfc_flux_dir_vis = subview_1d(m_buffer.sfc_flux_dir_vis); - auto sfc_flux_dir_nir = subview_1d(m_buffer.sfc_flux_dir_nir); - auto sfc_flux_dif_vis = subview_1d(m_buffer.sfc_flux_dif_vis); - auto sfc_flux_dif_nir = subview_1d(m_buffer.sfc_flux_dif_nir); - auto aero_tau_sw = subview_3d(m_buffer.aero_tau_sw); - auto aero_ssa_sw = subview_3d(m_buffer.aero_ssa_sw); - auto aero_g_sw = subview_3d(m_buffer.aero_g_sw); - auto aero_tau_lw = subview_3d(m_buffer.aero_tau_lw); - auto cld_tau_sw_bnd = subview_3d(m_buffer.cld_tau_sw_bnd); - auto cld_tau_lw_bnd = subview_3d(m_buffer.cld_tau_lw_bnd); - auto cld_tau_sw_gpt = subview_3d(m_buffer.cld_tau_sw_gpt); - auto cld_tau_lw_gpt = subview_3d(m_buffer.cld_tau_lw_gpt); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ConvertToRrtmgpSubview conv = {beg, ncol}; TIMED_INLINE_KERNEL(init_views, @@ -1045,25 +816,19 @@ void RRTMGPRadiation::run_impl (const double dt) { auto cld_tau_lw_bnd_k = conv.subview3d(m_buffer.cld_tau_lw_bnd_k); auto cld_tau_sw_gpt_k = conv.subview3d(m_buffer.cld_tau_sw_gpt_k); auto cld_tau_lw_gpt_k = conv.subview3d(m_buffer.cld_tau_lw_gpt_k); + auto mu0_k = conv.subview1d(d_mu0); ); -#endif // Set gas concs to "view" only the first ncol columns -#ifdef RRTMGP_ENABLE_YAKL - m_gas_concs.ncol = ncol; - m_gas_concs.concs = subview_3d(gas_concs); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS m_gas_concs_k.ncol = ncol; m_gas_concs_k.concs = conv.subview3d(gas_concs_k); -#endif - // Copy data from the FieldManager to the YAKL arrays + // Copy data from the FieldManager to the Kokkos Views { // Determine the cosine zenith angle // NOTE: Since we are bridging to F90 arrays this must be done on HOST and then // deep copied to a device view. - auto h_mu0 = Kokkos::create_mirror_view(d_mu0); + auto h_mu0 = Kokkos::create_mirror_view(mu0_k); if (m_fixed_solar_zenith_angle > 0) { for (int i=0; i::get_default_team_policy(ncol, m_nlay); TIMED_KERNEL( @@ -1113,60 +878,6 @@ void RRTMGPRadiation::run_impl (const double dt) { } team.team_barrier(); -#ifdef RRTMGP_ENABLE_YAKL - mu0(i+1) = d_mu0(i); - sfc_alb_dir_vis(i+1) = d_sfc_alb_dir_vis(icol); - sfc_alb_dir_nir(i+1) = d_sfc_alb_dir_nir(icol); - sfc_alb_dif_vis(i+1) = d_sfc_alb_dif_vis(icol); - sfc_alb_dif_nir(i+1) = d_sfc_alb_dif_nir(icol); - - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { - p_lay(i+1,k+1) = d_pmid(icol,k); - t_lay(i+1,k+1) = d_tmid(icol,k); - z_del(i+1,k+1) = d_dz(i,k); - p_del(i+1,k+1) = d_pdel(icol,k); - qc(i+1,k+1) = d_qc(icol,k); - nc(i+1,k+1) = d_nc(icol,k); - qi(i+1,k+1) = d_qi(icol,k); - rel(i+1,k+1) = d_rel(icol,k); - rei(i+1,k+1) = d_rei(icol,k); - p_lev(i+1,k+1) = d_pint(icol,k); - t_lev(i+1,k+1) = d_tint(i,k); - }); - - p_lev(i+1,nlay+1) = d_pint(icol,nlay); - t_lev(i+1,nlay+1) = d_tint(i,nlay); - - // Note that RRTMGP expects ordering (col,lay,bnd) but the FM keeps things in (col,bnd,lay) order - if (do_aerosol_rad) { - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nswbands*nlay), [&] (const int&idx) { - auto b = idx / nlay; - auto k = idx % nlay; - aero_tau_sw(i+1,k+1,b+1) = d_aero_tau_sw(icol,b,k); - aero_ssa_sw(i+1,k+1,b+1) = d_aero_ssa_sw(icol,b,k); - aero_g_sw (i+1,k+1,b+1) = d_aero_g_sw (icol,b,k); - }); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlwbands*nlay), [&] (const int&idx) { - auto b = idx / nlay; - auto k = idx % nlay; - aero_tau_lw(i+1,k+1,b+1) = d_aero_tau_lw(icol,b,k); - }); - } else { - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nswbands*nlay), [&] (const int&idx) { - auto b = idx / nlay; - auto k = idx % nlay; - aero_tau_sw(i+1,k+1,b+1) = 0; - aero_ssa_sw(i+1,k+1,b+1) = 0; - aero_g_sw (i+1,k+1,b+1) = 0; - }); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlwbands*nlay), [&] (const int&idx) { - auto b = idx / nlay; - auto k = idx % nlay; - aero_tau_lw(i+1,k+1,b+1) = 0; - }); - } -#endif -#ifdef RRTMGP_ENABLE_KOKKOS #ifdef RRTMGP_LAYOUT_LEFT // Copy to layout left buffer views Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { @@ -1221,24 +932,16 @@ void RRTMGPRadiation::run_impl (const double dt) { aero_tau_lw_k(i,k,b) = 0.0; }); } -#endif }); ); } Kokkos::fence(); -#ifdef RRTMGP_ENABLE_KOKKOS - COMPARE_ALL_WRAP(std::vector({aero_tau_sw, aero_ssa_sw, aero_g_sw, aero_tau_lw}), - std::vector({aero_tau_sw_k, aero_ssa_sw_k, aero_g_sw_k, aero_tau_lw_k})); -#endif // Populate GasConcs object to pass to RRTMGP driver // set_vmr requires the input array size to have the correct size, // and the last chunk may have less columns, so create a temp of // correct size that uses m_buffer.tmp2d's pointer -#ifdef RRTMGP_ENABLE_YAKL - real2d tmp2d = subview_2d(m_buffer.tmp2d); -#endif for (int igas = 0; igas < m_ngas; igas++) { auto name = m_gas_names[igas]; auto full_name = name + "_volume_mix_ratio"; @@ -1246,31 +949,10 @@ void RRTMGPRadiation::run_impl (const double dt) { // 'o3' is marked as 'Required' rather than 'Computed', so we need to get the proper field auto f = name=="o3" ? get_field_in(full_name) : get_field_out(full_name); auto d_vmr = f.get_view(); -#ifdef RRTMGP_ENABLE_KOKKOS auto tmp2d_k = conv.subview2d_impl(d_vmr, m_nlay); -#endif - -#ifdef RRTMGP_ENABLE_YAKL - // Copy to YAKL - const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, m_nlay); - Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { - const int i = team.league_rank(); - const int icol = i + beg; - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { - tmp2d(i+1,k+1) = d_vmr(icol,k); // Note that for YAKL arrays i and k start with index 1 - }); - }); - Kokkos::fence(); -#endif // Populate GasConcs object -#ifdef RRTMGP_ENABLE_YAKL - m_gas_concs.set_vmr(name, tmp2d); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS - COMPARE_WRAP(tmp2d, tmp2d_k); m_gas_concs_k.set_vmr(name, tmp2d_k); -#endif } // Set layer cloud fraction. @@ -1284,36 +966,20 @@ void RRTMGPRadiation::run_impl (const double dt) { // If we *are* doing subcolumn sampling for MCICA, then keep cloud fraction as input // from cloud fraction parameterization, wherever that is computed. auto do_subcol_sampling = m_do_subcol_sampling; -#ifdef RRTMGP_ENABLE_YAKL - auto lwp = m_buffer.lwp; - auto iwp = m_buffer.iwp; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS auto lwp_k = m_buffer.lwp_k; auto iwp_k = m_buffer.iwp_k; -#endif if (not do_subcol_sampling) { const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, m_nlay); Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { const int i = team.league_rank(); const int icol = i + beg; Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { -#ifdef RRTMGP_ENABLE_YAKL - if (d_cldfrac_tot(icol,k) > 0) { - cldfrac_tot(i+1,k+1) = 1; - } else { - cldfrac_tot(i+1,k+1) = 0; - } - d_cldfrac_rad(icol,k) = cldfrac_tot(i+1,k+1); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS if (d_cldfrac_tot(icol,k) > 0) { cldfrac_tot_k(i,k) = 1; } else { cldfrac_tot_k(i,k) = 0; } d_cldfrac_rad(icol,k) = cldfrac_tot_k(i,k); -#endif }); }); } else { @@ -1322,47 +988,24 @@ void RRTMGPRadiation::run_impl (const double dt) { const int i = team.league_rank(); const int icol = i + beg; Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { -#ifdef RRTMGP_ENABLE_YAKL - cldfrac_tot(i+1,k+1) = d_cldfrac_tot(icol,k); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS cldfrac_tot_k(i,k) = d_cldfrac_tot(icol,k); -#endif d_cldfrac_rad(icol,k) = d_cldfrac_tot(icol,k); }); }); } Kokkos::fence(); -#ifdef RRTMGP_ENABLE_KOKKOS - COMPARE_WRAP(cldfrac_tot, cldfrac_tot_k); -#endif // Compute layer cloud mass (per unit area) -#ifdef RRTMGP_ENABLE_YAKL - rrtmgp::mixing_ratio_to_cloud_mass(qc, cldfrac_tot, p_del, lwp); - rrtmgp::mixing_ratio_to_cloud_mass(qi, cldfrac_tot, p_del, iwp); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS interface_t::mixing_ratio_to_cloud_mass(qc_k, cldfrac_tot_k, p_del_k, lwp_k); interface_t::mixing_ratio_to_cloud_mass(qi_k, cldfrac_tot_k, p_del_k, iwp_k); - COMPARE_ALL_WRAP(std::vector({lwp, iwp}), - std::vector({lwp_k, iwp_k})); -#endif // Convert to g/m2 (needed by RRTMGP) { const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, m_nlay); Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { const int i = team.league_rank(); Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { - // Note that for YAKL arrays i and k start with index 1 -#ifdef RRTMGP_ENABLE_YAKL - lwp(i+1,k+1) *= 1e3; - iwp(i+1,k+1) *= 1e3; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS lwp_k(i,k) *= 1e3; iwp_k(i,k) *= 1e3; -#endif }); }); } @@ -1370,16 +1013,6 @@ void RRTMGPRadiation::run_impl (const double dt) { // Compute band-by-band surface_albedos. This is needed since // the AD passes broadband albedos, but rrtmgp require band-by-band. -#ifdef RRTMGP_ENABLE_YAKL - TIMED_KERNEL( - rrtmgp::compute_band_by_band_surface_albedos( - ncol, nswbands, - sfc_alb_dir_vis, sfc_alb_dir_nir, - sfc_alb_dif_vis, sfc_alb_dif_nir, - sfc_alb_dir, sfc_alb_dif); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TIMED_KERNEL( interface_t::compute_band_by_band_surface_albedos( ncol, nswbands, @@ -1387,43 +1020,15 @@ void RRTMGPRadiation::run_impl (const double dt) { sfc_alb_dif_vis_k, sfc_alb_dif_nir_k, sfc_alb_dir_k, sfc_alb_dif_k); ); - COMPARE_ALL_WRAP(std::vector({sfc_alb_dir, sfc_alb_dif}), - std::vector({sfc_alb_dir_k, sfc_alb_dif_k})); -#endif // Compute cloud optical properties here? // Run RRTMGP driver -#ifdef RRTMGP_ENABLE_YAKL - TIMED_KERNEL( - rrtmgp::rrtmgp_main( - ncol, m_nlay, - p_lay, t_lay, p_lev, t_lev, - m_gas_concs, - sfc_alb_dir, sfc_alb_dif, mu0, - lwp, iwp, rel, rei, cldfrac_tot, - aero_tau_sw, aero_ssa_sw, aero_g_sw, aero_tau_lw, - cld_tau_sw_bnd, cld_tau_lw_bnd, - cld_tau_sw_gpt, cld_tau_lw_gpt, - sw_flux_up , sw_flux_dn , sw_flux_dn_dir , lw_flux_up , lw_flux_dn, - sw_clnclrsky_flux_up, sw_clnclrsky_flux_dn, sw_clnclrsky_flux_dn_dir, - sw_clrsky_flux_up, sw_clrsky_flux_dn, sw_clrsky_flux_dn_dir, - sw_clnsky_flux_up, sw_clnsky_flux_dn, sw_clnsky_flux_dn_dir, - lw_clnclrsky_flux_up, lw_clnclrsky_flux_dn, - lw_clrsky_flux_up, lw_clrsky_flux_dn, - lw_clnsky_flux_up, lw_clnsky_flux_dn, - sw_bnd_flux_up , sw_bnd_flux_dn , sw_bnd_flux_dir , lw_bnd_flux_up , lw_bnd_flux_dn, - eccf, m_atm_logger, - m_extra_clnclrsky_diag, m_extra_clnsky_diag - ); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TIMED_KERNEL( interface_t::rrtmgp_main( ncol, m_nlay, p_lay_k, t_lay_k, p_lev_k, t_lev_k, m_gas_concs_k, - sfc_alb_dir_k, sfc_alb_dif_k, d_mu0, + sfc_alb_dir_k, sfc_alb_dif_k, mu0_k, lwp_k, iwp_k, rel_k, rei_k, cldfrac_tot_k, aero_tau_sw_k, aero_ssa_sw_k, aero_g_sw_k, aero_tau_lw_k, cld_tau_sw_bnd_k, cld_tau_lw_bnd_k, @@ -1440,53 +1045,8 @@ void RRTMGPRadiation::run_impl (const double dt) { m_extra_clnclrsky_diag, m_extra_clnsky_diag ); ); - COMPARE_ALL_WRAP(std::vector({ - sw_flux_up, sw_flux_dn, sw_flux_dn_dir, lw_flux_up, lw_flux_dn, - sw_clnclrsky_flux_up, sw_clnclrsky_flux_dn, sw_clnclrsky_flux_dn_dir, - sw_clrsky_flux_up, sw_clrsky_flux_dn, sw_clrsky_flux_dn_dir, - sw_clnsky_flux_up, sw_clnsky_flux_dn, sw_clnsky_flux_dn_dir, - lw_clnclrsky_flux_up, lw_clnclrsky_flux_dn, - lw_clrsky_flux_up, lw_clrsky_flux_dn, - lw_clnsky_flux_up, lw_clnsky_flux_dn}), - std::vector({ - sw_flux_up_k, sw_flux_dn_k, sw_flux_dn_dir_k, lw_flux_up_k, lw_flux_dn_k, - sw_clnclrsky_flux_up_k, sw_clnclrsky_flux_dn_k, sw_clnclrsky_flux_dn_dir_k, - sw_clrsky_flux_up_k, sw_clrsky_flux_dn_k, sw_clrsky_flux_dn_dir_k, - sw_clnsky_flux_up_k, sw_clnsky_flux_dn_k, sw_clnsky_flux_dn_dir_k, - lw_clnclrsky_flux_up_k, lw_clnclrsky_flux_dn_k, - lw_clrsky_flux_up_k, lw_clrsky_flux_dn_k, - lw_clnsky_flux_up_k, lw_clnsky_flux_dn_k})); - COMPARE_ALL_WRAP(std::vector({sw_bnd_flux_up, sw_bnd_flux_dn, sw_bnd_flux_dir, lw_bnd_flux_up, lw_bnd_flux_dn}), - std::vector({sw_bnd_flux_up_k, sw_bnd_flux_dn_k, sw_bnd_flux_dir_k, lw_bnd_flux_up_k, lw_bnd_flux_dn_k})); -#endif // Update heating tendency -#ifdef RRTMGP_ENABLE_YAKL - TIMED_INLINE_KERNEL(heating_tendency, - auto sw_heating = m_buffer.sw_heating; - auto lw_heating = m_buffer.lw_heating; - rrtmgp::compute_heating_rate( - sw_flux_up, sw_flux_dn, p_del, sw_heating - ); - rrtmgp::compute_heating_rate( - lw_flux_up, lw_flux_dn, p_del, lw_heating - ); - { - const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, m_nlay); - Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { - const int idx = team.league_rank(); - const int icol = idx+beg; - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& ilay) { - // Combine SW and LW heating into a net heating tendency; use d_rad_heating_pdel temporarily - // Note that for YAKL arrays i and k start with index 1 - d_rad_heating_pdel(icol,ilay) = sw_heating(idx+1,ilay+1) + lw_heating(idx+1,ilay+1); - }); - }); - } - Kokkos::fence(); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TIMED_INLINE_KERNEL(heating_tendency, auto sw_heating_k = m_buffer.sw_heating_k; auto lw_heating_k = m_buffer.lw_heating_k; @@ -1503,48 +1063,20 @@ void RRTMGPRadiation::run_impl (const double dt) { const int icol = idx+beg; Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& ilay) { // Combine SW and LW heating into a net heating tendency; use d_rad_heating_pdel temporarily - // Note that for YAKL arrays i and k start with index 1 d_rad_heating_pdel(icol,ilay) = sw_heating_k(idx,ilay) + lw_heating_k(idx,ilay); }); }); } Kokkos::fence(); ); - COMPARE_ALL_WRAP(std::vector({sw_heating, lw_heating}), - std::vector({sw_heating_k, lw_heating_k})); -#endif // Index to surface (bottom of model); used to get surface fluxes below -#ifdef RRTMGP_ENABLE_YAKL - const int kbot = nlay+1; - - TIMED_KERNEL( - // Compute diffuse flux as difference between total and direct - Kokkos::parallel_for(Kokkos::RangePolicy(0,nswbands*(nlay+1)*ncol), - KOKKOS_LAMBDA (const int idx) { - // CAREFUL: these are YAKL arrays, with "LayoutLeft". So make the indices stride accordingly, and add 1. - const int ibnd = (idx / ncol) / (nlay+1) + 1; - const int ilev = (idx / ncol) % (nlay+1) + 1; - const int icol = idx % ncol + 1; - sw_bnd_flux_dif(icol,ilev,ibnd) = sw_bnd_flux_dn(icol,ilev,ibnd) - sw_bnd_flux_dir(icol,ilev,ibnd); - }); - // Compute surface fluxes - rrtmgp::compute_broadband_surface_fluxes( - ncol, kbot, nswbands, - sw_bnd_flux_dir, sw_bnd_flux_dif, - sfc_flux_dir_vis, sfc_flux_dir_nir, - sfc_flux_dif_vis, sfc_flux_dif_nir - ); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS const int kbot_k = nlay; TIMED_KERNEL( // Compute diffuse flux as difference between total and direct Kokkos::parallel_for(Kokkos::RangePolicy(0,nswbands*(nlay+1)*ncol), KOKKOS_LAMBDA (const int idx) { - // CAREFUL: these are YAKL arrays, with "LayoutLeft". So make the indices stride accordingly, and add 1. const int ibnd = (idx / ncol) / (nlay+1); const int ilev = (idx / ncol) % (nlay+1); const int icol = idx % ncol; @@ -1558,30 +1090,8 @@ void RRTMGPRadiation::run_impl (const double dt) { sfc_flux_dif_vis_k, sfc_flux_dif_nir_k ); ); - COMPARE_ALL_WRAP(std::vector({sfc_flux_dir_vis, sfc_flux_dir_nir, sfc_flux_dif_vis, sfc_flux_dif_nir}), - std::vector({sfc_flux_dir_vis_k, sfc_flux_dir_nir_k, sfc_flux_dif_vis_k, sfc_flux_dif_nir_k})); -#endif // Compute diagnostic total cloud area (vertically-projected cloud cover) -#ifdef RRTMGP_ENABLE_YAKL - TIMED_KERNEL( - real1d cldlow ("cldlow", d_cldlow.data() + m_col_chunk_beg[ic], ncol); - real1d cldmed ("cldmed", d_cldmed.data() + m_col_chunk_beg[ic], ncol); - real1d cldhgh ("cldhgh", d_cldhgh.data() + m_col_chunk_beg[ic], ncol); - real1d cldtot ("cldtot", d_cldtot.data() + m_col_chunk_beg[ic], ncol); - // NOTE: limits for low, mid, and high clouds are mostly taken from EAM F90 source, with the - // exception that I removed the restriction on low clouds to be above (numerically lower pressures) - // 1200 hPa, and on high clouds to be below (numerically high pressures) 50 hPa. This probably - // does not matter in practice, as clouds probably should not be produced above 50 hPa and we - // should not be encountering surface pressure above 1200 hPa, but in the event that things go off - // the rails we might want to look at these still. - rrtmgp::compute_cloud_area(ncol, nlay, nlwgpts, 700e2, std::numeric_limits::max(), p_lay, cld_tau_lw_gpt, cldlow); - rrtmgp::compute_cloud_area(ncol, nlay, nlwgpts, 400e2, 700e2, p_lay, cld_tau_lw_gpt, cldmed); - rrtmgp::compute_cloud_area(ncol, nlay, nlwgpts, 0, 400e2, p_lay, cld_tau_lw_gpt, cldhgh); - rrtmgp::compute_cloud_area(ncol, nlay, nlwgpts, 0, std::numeric_limits::max(), p_lay, cld_tau_lw_gpt, cldtot); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TIMED_KERNEL( real1dk cldlow_k (d_cldlow.data() + m_col_chunk_beg[ic], ncol); real1dk cldmed_k (d_cldmed.data() + m_col_chunk_beg[ic], ncol); @@ -1598,37 +1108,8 @@ void RRTMGPRadiation::run_impl (const double dt) { interface_t::compute_cloud_area(ncol, nlay, nlwgpts, 0, 400e2, p_lay_k, cld_tau_lw_gpt_k, cldhgh_k); interface_t::compute_cloud_area(ncol, nlay, nlwgpts, 0, std::numeric_limits::max(), p_lay_k, cld_tau_lw_gpt_k, cldtot_k); ); - COMPARE_ALL_WRAP(std::vector({cldlow, cldmed, cldhgh, cldtot}), - std::vector({cldlow_k, cldmed_k, cldhgh_k, cldtot_k})); -#endif // Compute cloud-top diagnostics following AeroCOM recommendation -#ifdef RRTMGP_ENABLE_YAKL - TIMED_INLINE_KERNEL(cloud_top, - - // Get visible 0.67 micron band for COSP - auto idx_067 = rrtmgp::get_wavelength_index_sw(0.67e-6); - // Get IR 10.5 micron band for COSP - auto idx_105 = rrtmgp::get_wavelength_index_lw(10.5e-6); - - // Compute cloud-top diagnostics following AeroCom recommendation - real1d T_mid_at_cldtop ("T_mid_at_cldtop", d_T_mid_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d p_mid_at_cldtop ("p_mid_at_cldtop", d_p_mid_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d cldfrac_ice_at_cldtop ("cldfrac_ice_at_cldtop", d_cldfrac_ice_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d cldfrac_liq_at_cldtop ("cldfrac_liq_at_cldtop", d_cldfrac_liq_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d cldfrac_tot_at_cldtop ("cldfrac_tot_at_cldtop", d_cldfrac_tot_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d cdnc_at_cldtop ("cdnc_at_cldtop", d_cdnc_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d eff_radius_qc_at_cldtop ("eff_radius_qc_at_cldtop", d_eff_radius_qc_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - real1d eff_radius_qi_at_cldtop ("eff_radius_qi_at_cldtop", d_eff_radius_qi_at_cldtop.data() + m_col_chunk_beg[ic], ncol); - - rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, t_lay, p_lay, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, - nc, T_mid_at_cldtop, p_mid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TIMED_INLINE_KERNEL(cloud_top, // Get visible 0.67 micron band for COSP auto idx_067_k = interface_t::get_wavelength_index_sw_k(0.67e-6); @@ -1650,65 +1131,9 @@ void RRTMGPRadiation::run_impl (const double dt) { cldfrac_liq_at_cldtop_k, cldfrac_tot_at_cldtop_k, cdnc_at_cldtop_k, eff_radius_qc_at_cldtop_k, eff_radius_qi_at_cldtop_k); ); - COMPARE_ALL_WRAP(std::vector({ - T_mid_at_cldtop, p_mid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop}), - std::vector({ - T_mid_at_cldtop_k, p_mid_at_cldtop_k, cldfrac_ice_at_cldtop_k, - cldfrac_liq_at_cldtop_k, cldfrac_tot_at_cldtop_k, cdnc_at_cldtop_k, - eff_radius_qc_at_cldtop_k, eff_radius_qi_at_cldtop_k})); -#endif // Copy output data back to FieldManager const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, m_nlay); -#ifdef RRTMGP_ENABLE_YAKL - TIMED_KERNEL( - Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { - const int i = team.league_rank(); - const int icol = i + beg; - d_sfc_flux_dir_nir(icol) = sfc_flux_dir_nir(i+1); - d_sfc_flux_dir_vis(icol) = sfc_flux_dir_vis(i+1); - d_sfc_flux_dif_nir(icol) = sfc_flux_dif_nir(i+1); - d_sfc_flux_dif_vis(icol) = sfc_flux_dif_vis(i+1); - d_sfc_flux_sw_net(icol) = sw_flux_dn(i+1,kbot) - sw_flux_up(i+1,kbot); - d_sfc_flux_lw_dn(icol) = lw_flux_dn(i+1,kbot); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay+1), [&] (const int& k) { - d_sw_flux_up(icol,k) = sw_flux_up(i+1,k+1); - d_sw_flux_dn(icol,k) = sw_flux_dn(i+1,k+1); - d_sw_flux_dn_dir(icol,k) = sw_flux_dn_dir(i+1,k+1); - d_lw_flux_up(icol,k) = lw_flux_up(i+1,k+1); - d_lw_flux_dn(icol,k) = lw_flux_dn(i+1,k+1); - d_sw_clnclrsky_flux_up(icol,k) = sw_clnclrsky_flux_up(i+1,k+1); - d_sw_clnclrsky_flux_dn(icol,k) = sw_clnclrsky_flux_dn(i+1,k+1); - d_sw_clnclrsky_flux_dn_dir(icol,k) = sw_clnclrsky_flux_dn_dir(i+1,k+1); - d_sw_clrsky_flux_up(icol,k) = sw_clrsky_flux_up(i+1,k+1); - d_sw_clrsky_flux_dn(icol,k) = sw_clrsky_flux_dn(i+1,k+1); - d_sw_clrsky_flux_dn_dir(icol,k) = sw_clrsky_flux_dn_dir(i+1,k+1); - d_sw_clnsky_flux_up(icol,k) = sw_clnsky_flux_up(i+1,k+1); - d_sw_clnsky_flux_dn(icol,k) = sw_clnsky_flux_dn(i+1,k+1); - d_sw_clnsky_flux_dn_dir(icol,k) = sw_clnsky_flux_dn_dir(i+1,k+1); - d_lw_clnclrsky_flux_up(icol,k) = lw_clnclrsky_flux_up(i+1,k+1); - d_lw_clnclrsky_flux_dn(icol,k) = lw_clnclrsky_flux_dn(i+1,k+1); - d_lw_clrsky_flux_up(icol,k) = lw_clrsky_flux_up(i+1,k+1); - d_lw_clrsky_flux_dn(icol,k) = lw_clrsky_flux_dn(i+1,k+1); - d_lw_clnsky_flux_up(icol,k) = lw_clnsky_flux_up(i+1,k+1); - d_lw_clnsky_flux_dn(icol,k) = lw_clnsky_flux_dn(i+1,k+1); - }); - // Extract optical properties for COSP - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { - d_dtau067(icol,k) = cld_tau_sw_bnd(i+1,k+1,idx_067); - d_dtau105(icol,k) = cld_tau_lw_bnd(i+1,k+1,idx_105); - }); - if (d_sw_clrsky_flux_dn(icol,0) > 0) { - d_sunlit(icol) = 1.0; - } else { - d_sunlit(icol) = 0.0; - } - }); - ); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TIMED_KERNEL( Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { const int i = team.league_rank(); @@ -1752,23 +1177,11 @@ void RRTMGPRadiation::run_impl (const double dt) { } }); ); -#ifdef RRTMGP_ENABLE_YAKL - // Sync back to gas_concs_k - real3dk temp(gas_concs_k, std::make_pair(0, ncol), Kokkos::ALL, Kokkos::ALL); - Kokkos::deep_copy(temp, m_gas_concs_k.concs); -#endif -#endif } // loop over chunk // Restore the refCounted array. -#ifdef RRTMGP_ENABLE_YAKL - m_gas_concs.concs = gas_concs; - m_gas_concs.ncol = orig_ncol; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS m_gas_concs_k.concs = gas_concs_k; m_gas_concs_k.ncol = orig_ncol_k; -#endif } // update_rad // Apply temperature tendency; if we updated radiation this timestep, then d_rad_heating_pdel should @@ -1818,20 +1231,15 @@ void RRTMGPRadiation::run_impl (const double dt) { }); } + m_force_run_on_next_step = false; } // ========================================================================================= void RRTMGPRadiation::finalize_impl () { -#ifdef RRTMGP_ENABLE_YAKL - m_gas_concs.reset(); - rrtmgp::rrtmgp_finalize(); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS m_gas_concs_k.reset(); // Finalize the interface, passing a bool for rank 0 // to print info about memory stats on that rank interface_t::rrtmgp_finalize(m_comm.am_i_root()); -#endif finalize_kls(); } diff --git a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.hpp b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.hpp index c7c11c9df841..674000223a99 100644 --- a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.hpp +++ b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.hpp @@ -46,9 +46,7 @@ class RRTMGPRadiation : public AtmosphereProcess { using lrreal2dk = typename KT::template view_2d; using ulrreal2dk = Unmanaged; -#ifdef RRTMGP_ENABLE_KOKKOS using interface_t = rrtmgp::rrtmgp_interface; -#endif // Constructors RRTMGPRadiation (const ekat::Comm& comm, const ekat::ParameterList& params); @@ -115,12 +113,7 @@ class RRTMGPRadiation : public AtmosphereProcess { int m_ngas; std::vector m_gas_names; real1dk m_gas_mol_weights; -#ifdef RRTMGP_ENABLE_YAKL - GasConcs m_gas_concs; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS GasConcsK m_gas_concs_k; -#endif // Prescribed greenhouse gas surface concentrations in moles / moles air Real m_co2vmr; @@ -139,7 +132,7 @@ class RRTMGPRadiation : public AtmosphereProcess { // Structure for storing local variables initialized using the ATMBufferManager struct Buffer { - static constexpr int num_1d_ncol = 10; + static constexpr int num_1d_ncol = 8; static constexpr int num_2d_nlay = 16; static constexpr int num_2d_nlay_p1 = 23; static constexpr int num_2d_nswbands = 2; @@ -151,20 +144,6 @@ class RRTMGPRadiation : public AtmosphereProcess { static constexpr int num_3d_nlay_nlwgpts = 1; // 1d size (ncol) - ureal1dk cosine_zenith; -#ifdef RRTMGP_ENABLE_YAKL - real1d mu0; - real1d sfc_alb_dir_vis; - real1d sfc_alb_dir_nir; - real1d sfc_alb_dif_vis; - real1d sfc_alb_dif_nir; - real1d sfc_flux_dir_vis; - real1d sfc_flux_dir_nir; - real1d sfc_flux_dif_vis; - real1d sfc_flux_dif_nir; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS - ureal1dk mu0_k; ureal1dk sfc_alb_dir_vis_k; ureal1dk sfc_alb_dir_nir_k; ureal1dk sfc_alb_dif_vis_k; @@ -173,28 +152,9 @@ class RRTMGPRadiation : public AtmosphereProcess { ureal1dk sfc_flux_dir_nir_k; ureal1dk sfc_flux_dif_vis_k; ureal1dk sfc_flux_dif_nir_k; -#endif // 2d size (ncol, nlay) ureal2dk d_dz; -#ifdef RRTMGP_ENABLE_YAKL - real2d p_lay; - real2d t_lay; - real2d z_del; - real2d p_del; - real2d qc; - real2d nc; - real2d qi; - real2d cldfrac_tot; - real2d eff_radius_qc; - real2d eff_radius_qi; - real2d tmp2d; - real2d lwp; - real2d iwp; - real2d sw_heating; - real2d lw_heating; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal2dk p_lay_k; ureal2dk t_lay_k; ureal2dk z_del_k; @@ -210,35 +170,9 @@ class RRTMGPRadiation : public AtmosphereProcess { ureal2dk iwp_k; ureal2dk sw_heating_k; ureal2dk lw_heating_k; -#endif // 2d size (ncol, nlay+1) ureal2dk d_tint; -#ifdef RRTMGP_ENABLE_YAKL - real2d p_lev; - real2d t_lev; - real2d sw_flux_up; - real2d sw_flux_dn; - real2d sw_flux_dn_dir; - real2d lw_flux_up; - real2d lw_flux_dn; - real2d sw_clnclrsky_flux_up; - real2d sw_clnclrsky_flux_dn; - real2d sw_clnclrsky_flux_dn_dir; - real2d sw_clrsky_flux_up; - real2d sw_clrsky_flux_dn; - real2d sw_clrsky_flux_dn_dir; - real2d sw_clnsky_flux_up; - real2d sw_clnsky_flux_dn; - real2d sw_clnsky_flux_dn_dir; - real2d lw_clnclrsky_flux_up; - real2d lw_clnclrsky_flux_dn; - real2d lw_clrsky_flux_up; - real2d lw_clrsky_flux_dn; - real2d lw_clnsky_flux_up; - real2d lw_clnsky_flux_dn; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal2dk p_lev_k; ureal2dk t_lev_k; ureal2dk sw_flux_up_k; @@ -261,76 +195,34 @@ class RRTMGPRadiation : public AtmosphereProcess { ureal2dk lw_clrsky_flux_dn_k; ureal2dk lw_clnsky_flux_up_k; ureal2dk lw_clnsky_flux_dn_k; -#endif // 3d size (ncol, nlay+1, nswbands) -#ifdef RRTMGP_ENABLE_YAKL - real3d sw_bnd_flux_up; - real3d sw_bnd_flux_dn; - real3d sw_bnd_flux_dir; - real3d sw_bnd_flux_dif; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal3dk sw_bnd_flux_up_k; ureal3dk sw_bnd_flux_dn_k; ureal3dk sw_bnd_flux_dir_k; ureal3dk sw_bnd_flux_dif_k; -#endif // 3d size (ncol, nlay+1, nlwbands) -#ifdef RRTMGP_ENABLE_YAKL - real3d lw_bnd_flux_up; - real3d lw_bnd_flux_dn; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal3dk lw_bnd_flux_up_k; ureal3dk lw_bnd_flux_dn_k; -#endif // 2d size (ncol, nswbands) -#ifdef RRTMGP_ENABLE_YAKL - real2d sfc_alb_dir; - real2d sfc_alb_dif; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal2dk sfc_alb_dir_k; ureal2dk sfc_alb_dif_k; -#endif // 3d size (ncol, nlay, n[sw,lw]bands) -#ifdef RRTMGP_ENABLE_YAKL - real3d aero_tau_sw; - real3d aero_ssa_sw; - real3d aero_g_sw; - real3d aero_tau_lw; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal3dk aero_tau_sw_k; ureal3dk aero_ssa_sw_k; ureal3dk aero_g_sw_k; ureal3dk aero_tau_lw_k; -#endif // 3d size (ncol, nlay, n[sw,lw]bnds) -#ifdef RRTMGP_ENABLE_YAKL - real3d cld_tau_sw_bnd; - real3d cld_tau_lw_bnd; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal3dk cld_tau_sw_bnd_k; ureal3dk cld_tau_lw_bnd_k; -#endif // 3d size (ncol, nlay, n[sw,lw]gpts) -#ifdef RRTMGP_ENABLE_YAKL - real3d cld_tau_sw_gpt; - real3d cld_tau_lw_gpt; -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ureal3dk cld_tau_sw_gpt_k; ureal3dk cld_tau_lw_gpt_k; -#endif - }; protected: @@ -346,6 +238,8 @@ class RRTMGPRadiation : public AtmosphereProcess { // Struct which contains local variables Buffer m_buffer; + + bool m_force_run_on_next_step = false; }; // class RRTMGPRadiation } // namespace scream diff --git a/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.cpp b/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.cpp index 65cc99e09cc3..d78cb4ed115a 100644 --- a/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.cpp +++ b/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.cpp @@ -1,7 +1,4 @@ #include "physics/rrtmgp/rrtmgp_test_utils.hpp" -#ifdef RRTMGP_ENABLE_YAKL -#include "YAKL_netcdf.h" -#endif #include #include @@ -17,122 +14,4 @@ bool file_exists(const char *filename) { } } -#ifdef RRTMGP_ENABLE_YAKL -using yakl::fortran::parallel_for; -using yakl::fortran::SimpleBounds; -using yakl::intrinsics::mod; -using yakl::intrinsics::merge; - -bool all_close(real2d &arr1, real2d &arr2, double tolerance) { - int nx = arr1.dimension[0]; - int ny = arr2.dimension[1]; - auto arr1_h = arr1.createHostCopy(); - auto arr2_h = arr2.createHostCopy(); - for (int i=1; i tolerance || std::isnan(arr1_h(i,j) - arr2_h(i,j))) { - printf("arr1 = %f, arr2 = %f at %i,%i\n", arr1_h(i,j), arr2_h(i,j), i, j); - return false; - } - } - } - return true; -} - -void dummy_atmos( - std::string inputfile, - int ncol, real2d &p_lay, real2d &t_lay, - real1d &sfc_alb_dir_vis, real1d &sfc_alb_dir_nir, - real1d &sfc_alb_dif_vis, real1d &sfc_alb_dif_nir, - real1d &mu0, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei, real2d &cld) { - - // Setup boundary conditions, solar zenith angle, etc - // NOTE: this stuff would come from the model in a real run - - // Ocean-ish values for surface albedos, just for example - memset(sfc_alb_dir_vis , 0.06_wp ); - memset(sfc_alb_dir_nir , 0.06_wp ); - memset(sfc_alb_dif_vis , 0.06_wp ); - memset(sfc_alb_dif_nir , 0.06_wp ); - - // Pick a solar zenith angle; this should come from the model - memset(mu0, 0.86_wp ); - - // Get dummy cloud PHYSICAL properties. Note that this function call - // needs the CloudOptics object only because it uses the min and max - // valid values from the lookup tables for liquid and ice water path to - // create a dummy atmosphere. - dummy_clouds(scream::rrtmgp::cloud_optics_sw, p_lay, t_lay, lwp, iwp, rel, rei, cld); -} - -void dummy_clouds( - CloudOptics &cloud_optics, real2d &p_lay, real2d &t_lay, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei, real2d &cloud_mask) { - - // Problem sizes - int ncol = t_lay.dimension[0]; - int nlay = t_lay.dimension[1]; - - // Generate some fake liquid and ice water data. We pick values to be midway between - // the min and max of the valid lookup table values for effective radii - real rel_val = 0.5 * (cloud_optics.get_min_radius_liq() + cloud_optics.get_max_radius_liq()); - real rei_val = 0.5 * (cloud_optics.get_min_radius_ice() + cloud_optics.get_max_radius_ice()); - - // Restrict clouds to troposphere (> 100 hPa = 100*100 Pa) and not very close to the ground (< 900 hPa), and - // put them in 2/3 of the columns since that's roughly the total cloudiness of earth. - // Set sane values for liquid and ice water path. - // NOTE: these "sane" values are in g/m2! - parallel_for( SimpleBounds<2>(nlay,ncol) , YAKL_LAMBDA (int ilay, int icol) { - cloud_mask(icol,ilay) = p_lay(icol,ilay) > 100._wp * 100._wp && p_lay(icol,ilay) < 900._wp * 100._wp && mod(icol, 3) != 0; - // Ice and liquid will overlap in a few layers - lwp(icol,ilay) = merge(10._wp, 0._wp, cloud_mask(icol,ilay) && t_lay(icol,ilay) > 263._wp); - iwp(icol,ilay) = merge(10._wp, 0._wp, cloud_mask(icol,ilay) && t_lay(icol,ilay) < 273._wp); - rel(icol,ilay) = merge(rel_val, 0._wp, lwp(icol,ilay) > 0._wp); - rei(icol,ilay) = merge(rei_val, 0._wp, iwp(icol,ilay) > 0._wp); - }); -} - -void read_fluxes( - std::string inputfile, - real2d &sw_flux_up, real2d &sw_flux_dn, real2d &sw_flux_dir, - real2d &lw_flux_up, real2d &lw_flux_dn) { - - // Initialize netcdf reader - yakl::SimpleNetCDF io; - io.open(inputfile, NC_NOWRITE); - - // Initialize arrays to hold fluxes - int nlev = io.getDimSize("lev"); - int ncol = io.getDimSize("col_flx"); - sw_flux_up = real2d("sw_flux_up" , ncol, nlev); - sw_flux_dn = real2d("sw_flux_dn" , ncol, nlev); - sw_flux_dir = real2d("sw_flux_dir", ncol, nlev); - lw_flux_up = real2d("lw_flux_up" , ncol, nlev); - lw_flux_dn = real2d("lw_flux_dn" , ncol, nlev); - - // Read data - io.read(sw_flux_up, "sw_flux_up" ); - io.read(sw_flux_dn, "sw_flux_dn" ); - io.read(sw_flux_dir, "sw_flux_dir"); - io.read(lw_flux_up, "lw_flux_up" ); - io.read(lw_flux_dn, "lw_flux_dn" ); -} - -void write_fluxes( - std::string outputfile, - real2d &sw_flux_up, real2d &sw_flux_dn, real2d &sw_flux_dir, - real2d &lw_flux_up, real2d &lw_flux_dn) { - - yakl::SimpleNetCDF io; - io.create(outputfile); - io.write(sw_flux_up , "sw_flux_up" , {"col_flx","lev"}); - io.write(sw_flux_dn , "sw_flux_dn" , {"col_flx","lev"}); - io.write(sw_flux_dir, "sw_flux_dir", {"col_flx","lev"}); - io.write(lw_flux_up , "lw_flux_up" , {"col_flx","lev"}); - io.write(lw_flux_dn , "lw_flux_dn" , {"col_flx","lev"}); - io.close(); -} -#endif - } // namespace rrtmgp diff --git a/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp b/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp index 32bdfd9e44d2..2a4ad6195bef 100644 --- a/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp +++ b/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp @@ -11,37 +11,6 @@ namespace rrtmgpTest { bool file_exists(const char *filename); -#ifdef RRTMGP_ENABLE_YAKL -bool all_close(real2d &arr1, real2d &arr2, double tolerance); - -void dummy_clouds( - CloudOptics &cloud_optics, real2d &p_lay, real2d &t_lay, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei, real2d &cld -); - -void dummy_atmos( - std::string inputfile, - int ncol, real2d &p_lay, real2d &t_lay, - real1d &sfc_alb_dir_vis, real1d &sfc_alb_dir_nir, - real1d &sfc_alb_dif_vis, real1d &sfc_alb_dif_nir, - real1d &mu0, - real2d &lwp, real2d &iwp, real2d &rel, real2d &rei, real2d &cld -); - -void read_fluxes( - std::string inputfile, - real2d &sw_flux_up, real2d &sw_flux_dn, real2d &sw_flux_dir, - real2d &lw_flux_up, real2d &lw_flux_dn -); - -void write_fluxes( - std::string outputfile, - real2d &sw_flux_up, real2d &sw_flux_dn, real2d &sw_flux_dir, - real2d &lw_flux_up, real2d &lw_flux_dn -); -#endif - -#ifdef RRTMGP_ENABLE_KOKKOS template struct rrtmgp_test_utils { @@ -170,7 +139,6 @@ static void write_fluxes( } }; -#endif } #endif diff --git a/components/eamxx/src/physics/rrtmgp/rrtmgp_utils.hpp b/components/eamxx/src/physics/rrtmgp/rrtmgp_utils.hpp index 863597a4fea3..530f98b476b6 100644 --- a/components/eamxx/src/physics/rrtmgp/rrtmgp_utils.hpp +++ b/components/eamxx/src/physics/rrtmgp/rrtmgp_utils.hpp @@ -5,22 +5,9 @@ #include "cpp/rrtmgp_const.h" #include "cpp/rrtmgp_conversion.h" -#ifdef RRTMGP_ENABLE_YAKL -#include "YAKL.h" -#include "YAKL_Bounds_fortran.h" -#endif - namespace scream { namespace rrtmgp { -#ifdef RRTMGP_ENABLE_YAKL -// Things we need from YAKL -using yakl::intrinsics::maxval; -using yakl::intrinsics::minval; -using yakl::intrinsics::count; -using yakl::intrinsics::sum; -#endif - // Provide a routine to compute heating due to radiative fluxes. This is // computed as net flux into a layer, converted to a heating rate. It is // the responsibility of the user to ensure fields are passed with the @@ -31,24 +18,6 @@ using yakl::intrinsics::sum; // of approximating pdel by differencing the level interface pressures. // We are leaving this for the time being for consistency with SCREAMv0, // from which this code was directly ported. -#ifdef RRTMGP_ENABLE_YAKL -template -void compute_heating_rate ( - yakl::Array const &flux_up, yakl::Array const &flux_dn, - yakl::Array const &pdel , yakl::Array &heating_rate - ) { - using physconst = scream::physics::Constants; - auto ncol = flux_up.dimension[0]; - auto nlay = flux_up.dimension[1]-1; - TIMED_KERNEL(yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { - heating_rate(icol,ilay) = ( - flux_up(icol,ilay+1) - flux_up(icol,ilay) - - flux_dn(icol,ilay+1) + flux_dn(icol,ilay) - ) * physconst::gravit / (physconst::Cpair * pdel(icol,ilay)); - })); -} -#endif -#ifdef RRTMGP_ENABLE_KOKKOS template void compute_heating_rate ( View1 const &flux_up, @@ -67,51 +36,21 @@ void compute_heating_rate ( ) * physconst::gravit / (physconst::Cpair * pdel(icol,ilay)); )); } -#endif -inline bool radiation_do(const int irad, const int nstep) { - // If irad == 0, then never do radiation; +inline bool radiation_do(const int rad_freq, const int nstep) { + // If rad_freq == 0, then never do radiation; // Otherwise, we always call radiation at the first step, // and afterwards we do radiation if the timestep is divisible - // by irad - if (irad == 0) { + // by rad_freq + if (rad_freq == 0) { return false; } else { - return ( (nstep == 0) || (nstep % irad == 0) ); + return nstep % rad_freq == 0; } } // Verify that array only contains values within valid range, and if not // report min and max of array -#ifdef RRTMGP_ENABLE_YAKL -template -bool check_range(T x, Real xmin, Real xmax, std::string msg, std::ostream& out=std::cout) { - bool pass = true; - auto _xmin = minval(x); - auto _xmax = maxval(x); - if (_xmin < xmin or _xmax > xmax) { - // How many outside range? - auto bad_mask = x.createDeviceCopy(); - memset(bad_mask, 0); - yakl::c::parallel_for(yakl::c::SimpleBounds<1>(x.totElems()), YAKL_LAMBDA (int i) { - if (x.data()[i] < xmin or x.data()[i] > xmax) { - bad_mask.data()[i] = 1; - } - }); - auto num_bad = sum(bad_mask); - if (num_bad > 0) { - pass = false; - out << msg << ": " - << num_bad << " values outside range " - << "[" << xmin << "," << xmax << "]" - << "; minval = " << _xmin - << "; maxval = " << _xmax << "\n"; - } - } - return pass; -} -#endif -#ifdef RRTMGP_ENABLE_KOKKOS template ::type* dummy = nullptr> bool check_range_k(T x, typename T::const_value_type xmin, typename T::const_value_type xmax, std::string msg, std::ostream& out=std::cout) { @@ -197,9 +136,6 @@ bool check_range_k(T x, typename T::const_value_type xmin, typename T::const_val return pass; } - -#endif - } // namespace rrtmgp } // namespace scream diff --git a/components/eamxx/src/physics/rrtmgp/tests/generate_baseline.cpp b/components/eamxx/src/physics/rrtmgp/tests/generate_baseline.cpp index 7d107aec284b..6b58b27c7249 100644 --- a/components/eamxx/src/physics/rrtmgp/tests/generate_baseline.cpp +++ b/components/eamxx/src/physics/rrtmgp/tests/generate_baseline.cpp @@ -7,10 +7,6 @@ #include #include -#ifdef RRTMGP_ENABLE_YAKL -#include -#endif - #include #include @@ -31,14 +27,6 @@ int main (int argc, char** argv) { using namespace ekat::logger; using logger_t = Logger; -#ifdef RRTMGP_ENABLE_YAKL - using r1d = real1d; - using r2d = real2d; - using r3d = real3d; - using gas_concs_t = GasConcs; - namespace utils_t = rrtmgpTest; - namespace interface_t = scream::rrtmgp; -#else using layout_t = Kokkos::LayoutLeft; using interface_t = scream::rrtmgp::rrtmgp_interface; using utils_t = rrtmgpTest::rrtmgp_test_utils; @@ -47,7 +35,6 @@ int main (int argc, char** argv) { using r2d = typename interface_t::real2dk; using r3d = typename interface_t::real3dk; using MDRP = typename interface_t::MDRP; -#endif ekat::Comm comm(MPI_COMM_WORLD); auto logger = std::make_shared("",LogLevel::info,comm); @@ -76,13 +63,8 @@ int main (int argc, char** argv) { utils_t::read_fluxes(inputfile, sw_flux_up_ref, sw_flux_dn_ref, sw_flux_dn_dir_ref, lw_flux_up_ref, lw_flux_dn_ref ); // Get dimension sizes -#ifdef RRTMGP_ENABLE_YAKL - const int ncol = sw_flux_up_ref.dimension[0]; - const int nlev = sw_flux_up_ref.dimension[1]; -#else const int ncol = sw_flux_up_ref.extent(0); const int nlev = sw_flux_up_ref.extent(1); -#endif const int nlay = nlev - 1; // Read in dummy Garand atmosphere; if this were an actual model simulation, @@ -103,11 +85,7 @@ int main (int argc, char** argv) { // Initialize the RRTMGP interface; this will read in the k-distribution // data that contains information about absorption coefficients for gases logger->info("rrtmgp_initialize..."); -#ifdef RRTMGP_ENABLE_YAKL - interface_t::rrtmgp_initialize(gas_concs, coefficients_file_sw, coefficients_file_lw, cloud_optics_file_sw, cloud_optics_file_lw, logger); -#else interface_t::rrtmgp_initialize(gas_concs, coefficients_file_sw, coefficients_file_lw, cloud_optics_file_sw, cloud_optics_file_lw, logger, 2.0); -#endif // Setup dummy all-sky problem r1d sfc_alb_dir_vis ("sfc_alb_dir_vis", ncol); @@ -132,13 +110,8 @@ int main (int argc, char** argv) { // input/outputs into the driver (persisting between calls), and // we would just have to setup the pointers to them in the // FluxesBroadband object -#ifdef RRTMGP_ENABLE_YAKL - const auto nswbands = scream::rrtmgp::k_dist_sw.get_nband(); - const auto nlwbands = scream::rrtmgp::k_dist_lw.get_nband(); -#else const auto nswbands = interface_t::k_dist_sw_k->get_nband(); const auto nlwbands = interface_t::k_dist_lw_k->get_nband(); -#endif r2d sw_flux_up ("sw_flux_up" , ncol, nlay+1); r2d sw_flux_dn ("sw_flux_dn" , ncol, nlay+1); r2d sw_flux_dn_dir("sw_flux_dn_dir", ncol, nlay+1); @@ -179,32 +152,19 @@ int main (int argc, char** argv) { auto aer_ssa_sw = r3d("aer_ssa_sw", ncol, nlay, nswbands); auto aer_asm_sw = r3d("aer_asm_sw", ncol, nlay, nswbands); auto aer_tau_lw = r3d("aer_tau_lw", ncol, nlay, nlwbands); -#ifdef RRTMGP_ENABLE_YAKL - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nswbands,nlay,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { -#else Kokkos::parallel_for( MDRP::template get<3>({nswbands,nlay,ncol}) , KOKKOS_LAMBDA (int ibnd, int ilay, int icol) { -#endif aer_tau_sw(icol,ilay,ibnd) = 0; aer_ssa_sw(icol,ilay,ibnd) = 0; aer_asm_sw(icol,ilay,ibnd) = 0; }); -#ifdef RRTMGP_ENABLE_YAKL - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nlwbands,nlay,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { -#else Kokkos::parallel_for( MDRP::template get<3>({nlwbands,nlay,ncol}) , KOKKOS_LAMBDA (int ibnd, int ilay, int icol) { -#endif aer_tau_lw(icol,ilay,ibnd) = 0; }); // These are returned as outputs now from rrtmgp_main // TODO: provide as inputs consistent with how aerosol is treated? -#ifdef RRTMGP_ENABLE_YAKL - const auto nswgpts = scream::rrtmgp::k_dist_sw.get_ngpt(); - const auto nlwgpts = scream::rrtmgp::k_dist_lw.get_ngpt(); -#else const auto nswgpts = interface_t::k_dist_sw_k->get_ngpt(); const auto nlwgpts = interface_t::k_dist_lw_k->get_ngpt(); -#endif auto cld_tau_sw_bnd = r3d("cld_tau_sw_bnd", ncol, nlay, nswbands); auto cld_tau_lw_bnd = r3d("cld_tau_lw_bnd", ncol, nlay, nlwbands); auto cld_tau_sw = r3d("cld_tau_sw", ncol, nlay, nswgpts); @@ -248,63 +208,6 @@ int main (int argc, char** argv) { // Clean up from test; this is probably not necessary, these things // should be deallocated when they fall out of scope, but we should be // good citizens and clean up our mess. -#ifdef RRTMGP_ENABLE_YAKL - p_lay.deallocate(); - t_lay.deallocate(); - p_lev.deallocate(); - t_lev.deallocate(); - col_dry.deallocate(); - sfc_alb_dir_vis.deallocate(); - sfc_alb_dir_nir.deallocate(); - sfc_alb_dif_vis.deallocate(); - sfc_alb_dif_nir.deallocate(); - sfc_alb_dir.deallocate(); - sfc_alb_dif.deallocate(); - mu0.deallocate(); - lwp.deallocate(); - iwp.deallocate(); - rel.deallocate(); - rei.deallocate(); - cld.deallocate(); - aer_tau_sw.deallocate(); - aer_ssa_sw.deallocate(); - aer_asm_sw.deallocate(); - aer_tau_lw.deallocate(); - cld_tau_sw.deallocate(); - cld_tau_lw.deallocate(); - cld_tau_sw_bnd.deallocate(); - cld_tau_lw_bnd.deallocate(); - sw_flux_up_ref.deallocate(); - sw_flux_dn_ref.deallocate(); - sw_flux_dn_dir_ref.deallocate(); - lw_flux_up_ref.deallocate(); - lw_flux_dn_ref.deallocate(); - sw_flux_up.deallocate(); - sw_flux_dn.deallocate(); - sw_flux_dn_dir.deallocate(); - lw_flux_up.deallocate(); - lw_flux_dn.deallocate(); - sw_clnclrsky_flux_up.deallocate(); - sw_clnclrsky_flux_dn.deallocate(); - sw_clnclrsky_flux_dn_dir.deallocate(); - sw_clrsky_flux_up.deallocate(); - sw_clrsky_flux_dn.deallocate(); - sw_clrsky_flux_dn_dir.deallocate(); - sw_clnsky_flux_up.deallocate(); - sw_clnsky_flux_dn.deallocate(); - sw_clnsky_flux_dn_dir.deallocate(); - lw_clnclrsky_flux_up.deallocate(); - lw_clnclrsky_flux_dn.deallocate(); - lw_clrsky_flux_up.deallocate(); - lw_clrsky_flux_dn.deallocate(); - lw_clnsky_flux_up.deallocate(); - lw_clnsky_flux_dn.deallocate(); - sw_bnd_flux_up.deallocate(); - sw_bnd_flux_dn.deallocate(); - sw_bnd_flux_dir.deallocate(); - lw_bnd_flux_up.deallocate(); - lw_bnd_flux_dn.deallocate(); -#endif gas_concs.reset(); interface_t::rrtmgp_finalize(); diff --git a/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_tests.cpp b/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_tests.cpp index bc5d9eca70f1..811a3bc61ddf 100644 --- a/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_tests.cpp +++ b/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_tests.cpp @@ -7,9 +7,6 @@ #include "cpp/rrtmgp/mo_gas_concentrations.h" #include "examples/all-sky/mo_garand_atmos_io.h" -#ifdef RRTMGP_ENABLE_YAKL -#include "YAKL.h" -#endif #include "ekat/util/ekat_test_utils.hpp" #include @@ -30,291 +27,6 @@ void expect_another_arg (int i, int argc) { EKAT_REQUIRE_MSG(i != argc-1, "Expected another cmd-line arg."); } -#ifdef RRTMGP_ENABLE_YAKL -int run_yakl(int argc, char** argv) { - using namespace ekat::logger; - using logger_t = Logger; - - ekat::Comm comm(MPI_COMM_WORLD); - auto logger = std::make_shared("",LogLevel::info,comm); - - // Parse command line arguments - if (argc < 3) { - std::string msg = "Missing required inputs. Usage:\n"; - msg += argv[0]; - msg += " -i -b [options]\n"; - logger->error(msg); - return 1; - } - std::string inputfile, baseline; - - for (int i = 1; i < argc-1; ++i) { - if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { - expect_another_arg(i, argc); - ++i; - baseline = argv[i]; - } - if (ekat::argv_matches(argv[i], "-i", "--input-file")) { - expect_another_arg(i, argc); - ++i; - inputfile = argv[i]; - } - // RRTMGP baselines tests to not use kokoks. Swallow the arg, but ignore it - if (std::string(argv[i])=="--kokkos-device-id=") { - continue; - } - } - - // Check to see that inputfiles exist - if (!rrtmgpTest::file_exists(inputfile.c_str())) { - logger->error("Inputfile " + inputfile + " does not exist.\n"); - return -1; - } - if (!rrtmgpTest::file_exists(baseline.c_str())) { - logger->error("Baseline " + baseline + " does not exist.\n"); - return -1; - } - - // Initialize yakl - logger->info("Initialize yakl...\n"); - yakl::init(); - - // Get reference fluxes from input file; do this here so we can get ncol dimension - logger->info("Read fluxes...\n"); - real2d sw_flux_up_ref; - real2d sw_flux_dn_ref; - real2d sw_flux_dir_ref; - real2d lw_flux_up_ref; - real2d lw_flux_dn_ref; - rrtmgpTest::read_fluxes(inputfile, sw_flux_up_ref, sw_flux_dn_ref, sw_flux_dir_ref, lw_flux_up_ref, lw_flux_dn_ref ); - - // Get dimension sizes - int ncol = sw_flux_up_ref.dimension[0]; - int nlev = sw_flux_up_ref.dimension[1]; - int nlay = nlev - 1; - - // Read in dummy Garand atmosphere; if this were an actual model simulation, - // these would be passed as inputs to the driver - // NOTE: set ncol to size of col_flx dimension in the input file. This is so - // that we can compare to the reference data provided in that file. Note that - // this will copy the first column of the input data (the first profile) ncol - // times. We will then fill some fraction of these columns with clouds for - // the test problem. - logger->info("Read dummy atmos...\n"); - real2d p_lay("p_lay", ncol, nlay); - real2d t_lay("t_lay", ncol, nlay); - real2d p_lev("p_lev", ncol, nlay+1); - real2d t_lev("t_lev", ncol, nlay+1); - real2d col_dry; - GasConcs gas_concs; - read_atmos(inputfile, p_lay, t_lay, p_lev, t_lev, gas_concs, col_dry, ncol); - - // Initialize absorption coefficients - logger->info("Initialize RRTMGP...\n"); - scream::rrtmgp::rrtmgp_initialize(gas_concs, coefficients_file_sw, coefficients_file_lw, cloud_optics_file_sw, cloud_optics_file_lw, logger); - - // Setup our dummy atmosphere based on the input data we read in - logger->info("Setup dummy atmos...\n"); - real1d sfc_alb_dir_vis("sfc_alb_dir_vis", ncol); - real1d sfc_alb_dir_nir("sfc_alb_dir_nir", ncol); - real1d sfc_alb_dif_vis("sfc_alb_dif_vis", ncol); - real1d sfc_alb_dif_nir("sfc_alb_dif_nir", ncol); - real1d mu0("mu0", ncol); - real2d lwp("lwp", ncol, nlay); - real2d iwp("iwp", ncol, nlay); - real2d rel("rel", ncol, nlay); - real2d rei("rei", ncol, nlay); - real2d cld("cld", ncol, nlay); - rrtmgpTest::dummy_atmos( - inputfile, ncol, p_lay, t_lay, - sfc_alb_dir_vis, sfc_alb_dir_nir, - sfc_alb_dif_vis, sfc_alb_dif_nir, - mu0, - lwp, iwp, rel, rei, cld - ); - - // Setup flux outputs; In a real model run, the fluxes would be - // input/outputs into the driver (persisting between calls), and - // we would just have to setup the pointers to them in the - // FluxesBroadband object - logger->info("Setup fluxes...\n"); - const auto nswbands = scream::rrtmgp::k_dist_sw.get_nband(); - const auto nlwbands = scream::rrtmgp::k_dist_lw.get_nband(); - real2d sw_flux_up ("sw_flux_up" , ncol, nlay+1); - real2d sw_flux_dn ("sw_flux_dn" , ncol, nlay+1); - real2d sw_flux_dir("sw_flux_dir", ncol, nlay+1); - real2d lw_flux_up ("lw_flux_up" , ncol, nlay+1); - real2d lw_flux_dn ("lw_flux_dn" , ncol, nlay+1); - real2d sw_clnclrsky_flux_up ("sw_clnclrsky_flux_up" , ncol, nlay+1); - real2d sw_clnclrsky_flux_dn ("sw_clnclrsky_flux_dn" , ncol, nlay+1); - real2d sw_clnclrsky_flux_dir("sw_clnclrsky_flux_dir", ncol, nlay+1); - real2d sw_clrsky_flux_up ("sw_clrsky_flux_up" , ncol, nlay+1); - real2d sw_clrsky_flux_dn ("sw_clrsky_flux_dn" , ncol, nlay+1); - real2d sw_clrsky_flux_dir("sw_clrsky_flux_dir", ncol, nlay+1); - real2d sw_clnsky_flux_up ("sw_clnsky_flux_up" , ncol, nlay+1); - real2d sw_clnsky_flux_dn ("sw_clnsky_flux_dn" , ncol, nlay+1); - real2d sw_clnsky_flux_dir("sw_clnsky_flux_dir", ncol, nlay+1); - real2d lw_clnclrsky_flux_up ("lw_clnclrsky_flux_up" , ncol, nlay+1); - real2d lw_clnclrsky_flux_dn ("lw_clnclrsky_flux_dn" , ncol, nlay+1); - real2d lw_clrsky_flux_up ("lw_clrsky_flux_up" , ncol, nlay+1); - real2d lw_clrsky_flux_dn ("lw_clrsky_flux_dn" , ncol, nlay+1); - real2d lw_clnsky_flux_up ("lw_clnsky_flux_up" , ncol, nlay+1); - real2d lw_clnsky_flux_dn ("lw_clnsky_flux_dn" , ncol, nlay+1); - real3d sw_bnd_flux_up ("sw_bnd_flux_up" , ncol, nlay+1, nswbands); - real3d sw_bnd_flux_dn ("sw_bnd_flux_dn" , ncol, nlay+1, nswbands); - real3d sw_bnd_flux_dir("sw_bnd_flux_dir", ncol, nlay+1, nswbands); - real3d lw_bnd_flux_up ("lw_bnd_flux_up" , ncol, nlay+1, nlwbands); - real3d lw_bnd_flux_dn ("lw_bnd_flux_dn" , ncol, nlay+1, nlwbands); - - // Compute band-by-band surface_albedos. - real2d sfc_alb_dir("sfc_alb_dir", ncol, nswbands); - real2d sfc_alb_dif("sfc_alb_dif", ncol, nswbands); - rrtmgp::compute_band_by_band_surface_albedos( - ncol, nswbands, - sfc_alb_dir_vis, sfc_alb_dir_nir, - sfc_alb_dif_vis, sfc_alb_dif_nir, - sfc_alb_dir, sfc_alb_dif); - - // Setup some dummy aerosol optical properties - auto aer_tau_sw = real3d("aer_tau_sw", ncol, nlay, nswbands); - auto aer_ssa_sw = real3d("aer_ssa_sw", ncol, nlay, nswbands); - auto aer_asm_sw = real3d("aer_asm_sw", ncol, nlay, nswbands); - auto aer_tau_lw = real3d("aer_tau_lw", ncol, nlay, nlwbands); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nswbands,nlay,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { - aer_tau_sw(icol,ilay,ibnd) = 0; - aer_ssa_sw(icol,ilay,ibnd) = 0; - aer_asm_sw(icol,ilay,ibnd) = 0; - }); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nlwbands,nlay,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { - aer_tau_lw(icol,ilay,ibnd) = 0; - }); - - // These are returned as outputs now from rrtmgp_main - // TODO: provide as inputs consistent with how aerosol is treated? - const auto nswgpts = scream::rrtmgp::k_dist_sw.get_ngpt(); - const auto nlwgpts = scream::rrtmgp::k_dist_lw.get_ngpt(); - auto cld_tau_sw_bnd = real3d("cld_tau_sw_bnd", ncol, nlay, nswbands); - auto cld_tau_lw_bnd = real3d("cld_tau_lw_bnd", ncol, nlay, nlwbands); - auto cld_tau_sw = real3d("cld_tau_sw", ncol, nlay, nswgpts); - auto cld_tau_lw = real3d("cld_tau_lw", ncol, nlay, nlwgpts); - - // Run RRTMGP code on dummy atmosphere - logger->info("Run RRTMGP...\n"); - const Real tsi_scaling = 1; - scream::rrtmgp::rrtmgp_main( - ncol, nlay, - p_lay, t_lay, p_lev, t_lev, gas_concs, - sfc_alb_dir, sfc_alb_dif, mu0, - lwp, iwp, rel, rei, cld, - aer_tau_sw, aer_ssa_sw, aer_asm_sw, aer_tau_lw, - cld_tau_sw_bnd, cld_tau_lw_bnd, // outputs - cld_tau_sw, cld_tau_lw, // outputs - sw_flux_up, sw_flux_dn, sw_flux_dir, - lw_flux_up, lw_flux_dn, - sw_clnclrsky_flux_up, sw_clnclrsky_flux_dn, sw_clnclrsky_flux_dir, - sw_clrsky_flux_up, sw_clrsky_flux_dn, sw_clrsky_flux_dir, - sw_clnsky_flux_up, sw_clnsky_flux_dn, sw_clnsky_flux_dir, - lw_clnclrsky_flux_up, lw_clnclrsky_flux_dn, - lw_clrsky_flux_up, lw_clrsky_flux_dn, - lw_clnsky_flux_up, lw_clnsky_flux_dn, - sw_bnd_flux_up, sw_bnd_flux_dn, sw_bnd_flux_dir, - lw_bnd_flux_up, lw_bnd_flux_dn, tsi_scaling, logger, - true, true // extra_clnclrsky_diag, extra_clnsky_diag - // set them both to true because we are testing them below - ); - - // Check values against baseline - logger->info("Check values...\n"); - rrtmgpTest::read_fluxes( - baseline, - sw_flux_up_ref, sw_flux_dn_ref, sw_flux_dir_ref, - lw_flux_up_ref, lw_flux_dn_ref - ); - int nerr = 0; - if (!rrtmgpTest::all_close(sw_flux_up_ref , sw_flux_up , 0.001)) nerr++; - if (!rrtmgpTest::all_close(sw_flux_dn_ref , sw_flux_dn , 0.001)) nerr++; - if (!rrtmgpTest::all_close(sw_flux_dir_ref, sw_flux_dir, 0.001)) nerr++; - if (!rrtmgpTest::all_close(lw_flux_up_ref , lw_flux_up , 0.001)) nerr++; - if (!rrtmgpTest::all_close(lw_flux_dn_ref , lw_flux_dn , 0.001)) nerr++; - - // Because the aerosol optical properties are all set to zero, these fluxes must be equal - if (!rrtmgpTest::all_close(sw_flux_up , sw_clnsky_flux_up , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(sw_clrsky_flux_up , sw_clnclrsky_flux_up , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(sw_flux_dn , sw_clnsky_flux_dn , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(sw_clrsky_flux_dn , sw_clnclrsky_flux_dn , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(sw_flux_dir , sw_clnsky_flux_dir , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(sw_clrsky_flux_dir , sw_clnclrsky_flux_dir , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(lw_flux_up , lw_clnsky_flux_up , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(lw_clrsky_flux_up , lw_clnclrsky_flux_up , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(lw_flux_dn , lw_clnsky_flux_dn , 0.0000000001)) nerr++; - if (!rrtmgpTest::all_close(lw_clrsky_flux_dn , lw_clnclrsky_flux_dn , 0.0000000001)) nerr++; - - logger->info("Cleaning up...\n"); - // Clean up or else YAKL will throw errors - scream::rrtmgp::rrtmgp_finalize(); - sw_flux_up_ref.deallocate(); - sw_flux_dn_ref.deallocate(); - sw_flux_dir_ref.deallocate(); - lw_flux_up_ref.deallocate(); - lw_flux_dn_ref.deallocate(); - sw_flux_up.deallocate(); - sw_flux_dn.deallocate(); - sw_flux_dir.deallocate(); - lw_flux_up.deallocate(); - lw_flux_dn.deallocate(); - sw_clnclrsky_flux_up.deallocate(); - sw_clnclrsky_flux_dn.deallocate(); - sw_clnclrsky_flux_dir.deallocate(); - sw_clrsky_flux_up.deallocate(); - sw_clrsky_flux_dn.deallocate(); - sw_clrsky_flux_dir.deallocate(); - sw_clnsky_flux_up.deallocate(); - sw_clnsky_flux_dn.deallocate(); - sw_clnsky_flux_dir.deallocate(); - lw_clnclrsky_flux_up.deallocate(); - lw_clnclrsky_flux_dn.deallocate(); - lw_clrsky_flux_up.deallocate(); - lw_clrsky_flux_dn.deallocate(); - lw_clnsky_flux_up.deallocate(); - lw_clnsky_flux_dn.deallocate(); - sw_bnd_flux_up.deallocate(); - sw_bnd_flux_dn.deallocate(); - sw_bnd_flux_dir.deallocate(); - lw_bnd_flux_up.deallocate(); - lw_bnd_flux_dn.deallocate(); - p_lay.deallocate(); - t_lay.deallocate(); - p_lev.deallocate(); - t_lev.deallocate(); - gas_concs.reset(); - sfc_alb_dir_vis.deallocate(); - sfc_alb_dir_nir.deallocate(); - sfc_alb_dif_vis.deallocate(); - sfc_alb_dif_nir.deallocate(); - sfc_alb_dir.deallocate(); - sfc_alb_dif.deallocate(); - mu0.deallocate(); - lwp.deallocate(); - iwp.deallocate(); - rel.deallocate(); - rei.deallocate(); - cld.deallocate(); - aer_tau_sw.deallocate(); - aer_ssa_sw.deallocate(); - aer_asm_sw.deallocate(); - aer_tau_lw.deallocate(); - cld_tau_sw.deallocate(); - cld_tau_lw.deallocate(); - cld_tau_sw_bnd.deallocate(); - cld_tau_lw_bnd.deallocate(); - col_dry.deallocate(); - yakl::finalize(); - - return nerr != 0 ? 1 : 0; -} // end of main driver code -#endif - -#ifdef RRTMGP_ENABLE_KOKKOS int run_kokkos(int argc, char** argv) { using namespace ekat::logger; using logger_t = Logger; @@ -365,8 +77,8 @@ int run_kokkos(int argc, char** argv) { return -1; } - // Initialize yakl - logger->info("Initialize yakl...\n"); + // Initialize kokkos + logger->info("Initialize kokkos...\n"); scream::init_kls(); // Get reference fluxes from input file; do this here so we can get ncol dimension @@ -540,13 +252,12 @@ int run_kokkos(int argc, char** argv) { if (!utils_t::all_close(lw_clrsky_flux_dn , lw_clnclrsky_flux_dn , 0.0000000001)) nerr++; logger->info("Cleaning up...\n"); - // Clean up or else YAKL will throw errors + // Clean up or else Kokkos will throw errors interface_t::rrtmgp_finalize(); scream::finalize_kls(); return nerr != 0 ? 1 : 0; } // end of main driver code -#endif } @@ -554,12 +265,7 @@ int main(int argc, char** argv) { MPI_Init(&argc,&argv); int ret = 0; -#ifdef RRTMGP_ENABLE_YAKL - ret += run_yakl(argc,argv); -#endif -#ifdef RRTMGP_ENABLE_KOKKOS ret += run_kokkos(argc,argv); -#endif MPI_Finalize(); return ret; diff --git a/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_unit_tests.cpp b/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_unit_tests.cpp index b179533b4eaf..699c600687b0 100644 --- a/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_unit_tests.cpp +++ b/components/eamxx/src/physics/rrtmgp/tests/rrtmgp_unit_tests.cpp @@ -5,19 +5,13 @@ #include "physics/rrtmgp/shr_orb_mod_c2f.hpp" #include "mo_load_coefficients.h" -#ifdef RRTMGP_ENABLE_YAKL -#include "YAKL.h" -#endif - namespace { -#ifdef RRTMGP_ENABLE_KOKKOS template auto chc(const View& view) { return Kokkos::create_mirror_view_and_copy(HostDevice(), view); } -#endif // Names of input files we will need. std::string coefficients_file_sw = SCREAM_DATA_DIR "/init/rrtmgp-data-sw-g112-210809.nc"; @@ -25,830 +19,6 @@ std::string coefficients_file_lw = SCREAM_DATA_DIR "/init/rrtmgp-data-lw-g128-21 std::string cloud_optics_file_sw = SCREAM_DATA_DIR "/init/rrtmgp-cloud-optics-coeffs-sw.nc"; std::string cloud_optics_file_lw = SCREAM_DATA_DIR "/init/rrtmgp-cloud-optics-coeffs-lw.nc"; -#ifdef RRTMGP_ENABLE_YAKL -TEST_CASE("rrtmgp_test_heating") { - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - - // Test heating rate function by passing simple inputs - auto dp = real2d("dp", 1, 1); - auto flux_up = real2d("flux_up", 1, 2); - auto flux_dn = real2d("flux_dn", 1, 2); - auto heating = real2d("heating", 1, 1); - // Simple no-heating test - // NOTE: yakl::fortran::parallel_for because we need to do these in a kernel on the device - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - dp(1, 1) = 10; - flux_up(1, 1) = 1.0; - flux_up(1, 2) = 1.0; - flux_dn(1, 1) = 1.0; - flux_dn(1, 2) = 1.0; - }); - scream::rrtmgp::compute_heating_rate(flux_up, flux_dn, dp, heating); - REQUIRE(heating.createHostCopy()(1,1) == 0); - - // Simple net postive heating; net flux into layer should be 1.0 - // NOTE: yakl::fortran::parallel_for because we need to do these in a kernel on the device - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - flux_up(1, 1) = 1.0; - flux_up(1, 2) = 1.0; - flux_dn(1, 1) = 1.5; - flux_dn(1, 2) = 0.5; - }); - using physconst = scream::physics::Constants; - auto g = physconst::gravit; //9.81; - auto cp_air = physconst::Cpair; //1005.0; - auto pdel = dp.createHostCopy()(1,1); - auto heating_ref = 1.0 * g / (cp_air * pdel); - scream::rrtmgp::compute_heating_rate(flux_up, flux_dn, dp, heating); - REQUIRE(heating.createHostCopy()(1,1) == heating_ref); - - // Simple net negative heating; net flux into layer should be -1.0 - // NOTE: yakl::fortran::parallel_for because we need to do these in a kernel on the device - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - flux_up(1,1) = 1.5; - flux_up(1,2) = 0.5; - flux_dn(1,1) = 1.0; - flux_dn(1,2) = 1.0; - }); - heating_ref = -1.0 * g / (cp_air * pdel); - scream::rrtmgp::compute_heating_rate(flux_up, flux_dn, dp, heating); - REQUIRE(heating.createHostCopy()(1,1) == heating_ref); - - // Clean up - dp.deallocate(); - flux_up.deallocate(); - flux_dn.deallocate(); - heating.deallocate(); - yakl::finalize(); -} - -TEST_CASE("rrtmgp_test_mixing_ratio_to_cloud_mass") { - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - - using physconst = scream::physics::Constants; - - // Test mixing ratio to cloud mass function by passing simple inputs - auto dp = real2d("dp", 1, 1); - auto mixing_ratio = real2d("mixing_ratio", 1, 1); - auto cloud_fraction = real2d("cloud_fration", 1, 1); - auto cloud_mass = real2d("cloud_mass", 1, 1); - - // Test with cell completely filled with cloud - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - dp(1,1) = 10.0; - mixing_ratio(1,1) = 0.0001; - cloud_fraction(1,1) = 1.0; - }); - auto cloud_mass_ref = mixing_ratio.createHostCopy()(1,1) / cloud_fraction.createHostCopy()(1,1) * dp.createHostCopy()(1,1) / physconst::gravit; - scream::rrtmgp::mixing_ratio_to_cloud_mass(mixing_ratio, cloud_fraction, dp, cloud_mass); - REQUIRE(cloud_mass.createHostCopy()(1,1) == cloud_mass_ref); - - // Test with no cloud - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - dp(1,1) = 10.0; - mixing_ratio(1,1) = 0.0; - cloud_fraction(1,1) = 0.0; - }); - cloud_mass_ref = 0.0; - scream::rrtmgp::mixing_ratio_to_cloud_mass(mixing_ratio, cloud_fraction, dp, cloud_mass); - REQUIRE(cloud_mass.createHostCopy()(1,1) == cloud_mass_ref); - - // Test with empty clouds (cloud fraction but with no associated mixing ratio) - // This case could happen if we use a total cloud fraction, but compute layer - // cloud mass separately for liquid and ice. - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - dp(1,1) = 10.0; - mixing_ratio(1,1) = 0.0; - cloud_fraction(1,1) = 0.1; - }); - cloud_mass_ref = 0.0; - scream::rrtmgp::mixing_ratio_to_cloud_mass(mixing_ratio, cloud_fraction, dp, cloud_mass); - REQUIRE(cloud_mass.createHostCopy()(1,1) == cloud_mass_ref); - - // Test with cell half filled with cloud - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - dp(1,1) = 10.0; - mixing_ratio(1,1) = 0.0001; - cloud_fraction(1,1) = 0.5; - }); - cloud_mass_ref = mixing_ratio.createHostCopy()(1,1) / cloud_fraction.createHostCopy()(1,1) * dp.createHostCopy()(1,1) / physconst::gravit; - scream::rrtmgp::mixing_ratio_to_cloud_mass(mixing_ratio, cloud_fraction, dp, cloud_mass); - REQUIRE(cloud_mass.createHostCopy()(1,1) == cloud_mass_ref); - - // Clean up - dp.deallocate(); - mixing_ratio.deallocate(); - cloud_fraction.deallocate(); - cloud_mass.deallocate(); - yakl::finalize(); -} - -TEST_CASE("rrtmgp_test_limit_to_bounds") { - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - - // Test limiter function - auto arr = real2d("arr", 2, 2); - auto arr_limited = real2d("arr_limited", 2, 2); - - // Setup dummy array - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - arr(1,1) = 1.0; - arr(1,2) = 2.0; - arr(2,1) = 3.0; - arr(2,2) = 4.0; - }); - - // Limit to bounds that contain the data; should be no change in values - scream::rrtmgp::limit_to_bounds(arr, 0.0, 5.0, arr_limited); - REQUIRE(arr.createHostCopy()(1,1) == arr_limited.createHostCopy()(1,1)); - REQUIRE(arr.createHostCopy()(1,2) == arr_limited.createHostCopy()(1,2)); - REQUIRE(arr.createHostCopy()(2,1) == arr_limited.createHostCopy()(2,1)); - REQUIRE(arr.createHostCopy()(2,2) == arr_limited.createHostCopy()(2,2)); - - // Limit to bounds that do not completely contain the data; should be a change in values! - scream::rrtmgp::limit_to_bounds(arr, 1.5, 3.5, arr_limited); - REQUIRE(arr_limited.createHostCopy()(1,1) == 1.5); - REQUIRE(arr_limited.createHostCopy()(1,2) == 2.0); - REQUIRE(arr_limited.createHostCopy()(2,1) == 3.0); - REQUIRE(arr_limited.createHostCopy()(2,2) == 3.5); - arr.deallocate(); - arr_limited.deallocate(); - yakl::finalize(); -} - -TEST_CASE("rrtmgp_test_zenith") { - - // Create some dummy data - int orbital_year = 1990; - double calday = 1.0000000000000000; - double eccen_ref = 1.6707719799280658E-002; - double mvelpp_ref = 4.9344679089867318; - double lambm0_ref = -3.2503635878519378E-002; - double obliqr_ref = 0.40912382465788016; - double delta_ref = -0.40302893695478670; - double eccf_ref = 1.0342222039093694; - double lat = -7.7397590528644963E-002; - double lon = 2.2584340271163548; - double coszrs_ref = 0.61243613606766745; - - // Test shr_orb_params() - // Get orbital parameters based on calendar day - double eccen; - double obliq; // obliquity in degrees - double mvelp; // moving vernal equinox long of perihelion; degrees? - double obliqr; - double lambm0; - double mvelpp; - // bool flag_print = false; - shr_orb_params_c2f(&orbital_year, &eccen, &obliq, &mvelp, - &obliqr, &lambm0, &mvelpp); //, flag_print); // Note fortran code has optional arg - REQUIRE(eccen == eccen_ref); - REQUIRE(obliqr == obliqr_ref); - REQUIRE(mvelpp == mvelpp_ref); - REQUIRE(lambm0 == lambm0_ref); - REQUIRE(mvelpp == mvelpp_ref); - - // Test shr_orb_decl() - double delta; - double eccf; - shr_orb_decl_c2f(calday, eccen, mvelpp, lambm0, - obliqr, &delta, &eccf); - REQUIRE(delta == delta_ref); - REQUIRE(eccf == eccf_ref ); - - double dt_avg = 0.; //3600.0000000000000; - double coszrs = shr_orb_cosz_c2f(calday, lat, lon, delta, dt_avg); - REQUIRE(std::abs(coszrs-coszrs_ref)<1e-14); - - // Another case, this time WITH dt_avg flag: - calday = 1.0833333333333333; - eccen = 1.6707719799280658E-002; - mvelpp = 4.9344679089867318; - lambm0 = -3.2503635878519378E-002; - obliqr = 0.40912382465788016; - delta = -0.40292121709083456; - eccf = 1.0342248931660425; - lat = -1.0724153591027763; - lon = 4.5284876076962712; - dt_avg = 3600.0000000000000; - coszrs_ref = 0.14559973262047626; - coszrs = shr_orb_cosz_c2f(calday, lat, lon, delta, dt_avg); - REQUIRE(std::abs(coszrs-coszrs_ref)<1e-14); - -} - -TEST_CASE("rrtmgp_test_compute_broadband_surface_flux") { - using namespace ekat::logger; - using logger_t = Logger; - - ekat::Comm comm(MPI_COMM_WORLD); - auto logger = std::make_shared("",LogLevel::info,comm); - - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - - // Create arrays - const int ncol = 1; - const int nlay = 1; - const int nbnd = 14; - const int kbot = nlay + 1; - auto sfc_flux_dir_nir = real1d("sfc_flux_dir_nir", ncol); - auto sfc_flux_dir_vis = real1d("sfc_flux_dir_vis", ncol); - auto sfc_flux_dif_nir = real1d("sfc_flux_dif_nir", ncol); - auto sfc_flux_dif_vis = real1d("sfc_flux_dif_vis", ncol); - - // Need to initialize RRTMGP with dummy gases - logger->info("Init gases...\n"); - GasConcs gas_concs; - string1dv gas_names = {"h2o", "co2", "o3", "n2o", "co", "ch4", "o2", "n2"}; - gas_concs.init(gas_names,ncol,nlay); - logger->info("Init RRTMGP...\n"); - scream::rrtmgp::rrtmgp_initialize(gas_concs, coefficients_file_sw, coefficients_file_lw, cloud_optics_file_sw, cloud_optics_file_lw, logger); - - // Create simple test cases; We expect, given the input data, that band 10 - // will straddle the NIR and VIS, bands 1-9 will be purely NIR, and bands 11-14 - // will be purely VIS. The implementation in EAMF90 was hard-coded with this - // band information, but our implementation of compute_broadband_surface_fluxes - // actually checks the wavenumber limits. These tests will mostly check to make - // sure our implementation of that is doing what we think it is. - - // --------------------------------- - // Test case: flux only in straddled band - auto sw_bnd_flux_dir = real3d("sw_bnd_flux_dir", ncol, nlay+1, nbnd); - auto sw_bnd_flux_dif = real3d("sw_bnd_flux_dif", ncol, nlay+1, nbnd); - logger->info("Populate band-resolved 3d fluxes for test case with only transition band flux...\n"); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nbnd,nlay+1,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { - if (ibnd < 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 0; - } else if (ibnd == 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 1; - sw_bnd_flux_dif(icol,ilay,ibnd) = 1; - } else { - sw_bnd_flux_dir(icol,ilay,ibnd) = 0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 0; - } - }); - // Compute surface fluxes - logger->info("Compute broadband surface fluxes...\n"); - scream::rrtmgp::compute_broadband_surface_fluxes( - ncol, kbot, nbnd, - sw_bnd_flux_dir, sw_bnd_flux_dif, - sfc_flux_dir_vis, sfc_flux_dir_nir, - sfc_flux_dif_vis, sfc_flux_dif_nir - ); - // Check computed surface fluxes - logger->info("Check computed fluxes...\n"); - const double tol = 1e-10; // tolerance on floating point inequality for assertions - REQUIRE(std::abs(sfc_flux_dir_nir.createHostCopy()(1) - 0.5) < tol); - REQUIRE(std::abs(sfc_flux_dir_vis.createHostCopy()(1) - 0.5) < tol); - REQUIRE(std::abs(sfc_flux_dif_nir.createHostCopy()(1) - 0.5) < tol); - REQUIRE(std::abs(sfc_flux_dif_vis.createHostCopy()(1) - 0.5) < tol); - // --------------------------------- - - // --------------------------------- - // Test case, only flux in NIR bands - logger->info("Populate band-resolved 3d fluxes for test case with only NIR flux...\n"); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nbnd,nlay+1,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { - if (ibnd < 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 1; - sw_bnd_flux_dif(icol,ilay,ibnd) = 1; - } else if (ibnd == 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 0; - } else { - sw_bnd_flux_dir(icol,ilay,ibnd) = 0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 0; - } - }); - // Compute surface fluxes - logger->info("Compute broadband surface fluxes...\n"); - scream::rrtmgp::compute_broadband_surface_fluxes( - ncol, kbot, nbnd, - sw_bnd_flux_dir, sw_bnd_flux_dif, - sfc_flux_dir_vis, sfc_flux_dir_nir, - sfc_flux_dif_vis, sfc_flux_dif_nir - ); - // Check computed surface fluxes - logger->info("Check computed fluxes...\n"); - REQUIRE(std::abs(sfc_flux_dir_nir.createHostCopy()(1) - 9.0) < tol); - REQUIRE(std::abs(sfc_flux_dir_vis.createHostCopy()(1) - 0.0) < tol); - REQUIRE(std::abs(sfc_flux_dif_nir.createHostCopy()(1) - 9.0) < tol); - REQUIRE(std::abs(sfc_flux_dif_vis.createHostCopy()(1) - 0.0) < tol); - // --------------------------------- - - // --------------------------------- - // Test case, only flux in VIS bands - logger->info("Populate band-resolved 3d fluxes for test case with only VIS/UV flux...\n"); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nbnd,nlay+1,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { - if (ibnd < 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 0; - } else if (ibnd == 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 0; - } else { - sw_bnd_flux_dir(icol,ilay,ibnd) = 1; - sw_bnd_flux_dif(icol,ilay,ibnd) = 1; - } - }); - // Compute surface fluxes - logger->info("Compute broadband surface fluxes...\n"); - scream::rrtmgp::compute_broadband_surface_fluxes( - ncol, kbot, nbnd, - sw_bnd_flux_dir, sw_bnd_flux_dif, - sfc_flux_dir_vis, sfc_flux_dir_nir, - sfc_flux_dif_vis, sfc_flux_dif_nir - ); - // Check computed surface fluxes - logger->info("Check computed fluxes...\n"); - REQUIRE(std::abs(sfc_flux_dir_nir.createHostCopy()(1) - 0.0) < tol); - REQUIRE(std::abs(sfc_flux_dir_vis.createHostCopy()(1) - 4.0) < tol); - REQUIRE(std::abs(sfc_flux_dif_nir.createHostCopy()(1) - 0.0) < tol); - REQUIRE(std::abs(sfc_flux_dif_vis.createHostCopy()(1) - 4.0) < tol); - // --------------------------------- - - // --------------------------------- - // Test case, only flux in all bands - logger->info("Populate band-resolved 3d fluxes for test with non-zero flux in all bands...\n"); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(nbnd,nlay+1,ncol), YAKL_LAMBDA(int ibnd, int ilay, int icol) { - if (ibnd < 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 1.0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 2.0; - } else if (ibnd == 10) { - sw_bnd_flux_dir(icol,ilay,ibnd) = 3.0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 4.0; - } else { - sw_bnd_flux_dir(icol,ilay,ibnd) = 5.0; - sw_bnd_flux_dif(icol,ilay,ibnd) = 6.0; - } - }); - // Compute surface fluxes - logger->info("Compute broadband surface fluxes...\n"); - scream::rrtmgp::compute_broadband_surface_fluxes( - ncol, kbot, nbnd, - sw_bnd_flux_dir, sw_bnd_flux_dif, - sfc_flux_dir_vis, sfc_flux_dir_nir, - sfc_flux_dif_vis, sfc_flux_dif_nir - ); - // Check computed surface fluxes - logger->info("Check computed fluxes...\n"); - REQUIRE(std::abs(sfc_flux_dir_nir.createHostCopy()(1) - 10.5) < tol); - REQUIRE(std::abs(sfc_flux_dir_vis.createHostCopy()(1) - 21.5) < tol); - REQUIRE(std::abs(sfc_flux_dif_nir.createHostCopy()(1) - 20.0) < tol); - REQUIRE(std::abs(sfc_flux_dif_vis.createHostCopy()(1) - 26.0) < tol); - // --------------------------------- - - // Finalize YAKL - logger->info("Free memory...\n"); - scream::rrtmgp::rrtmgp_finalize(); - gas_concs.reset(); - sw_bnd_flux_dir.deallocate(); - sw_bnd_flux_dif.deallocate(); - sfc_flux_dir_nir.deallocate(); - sfc_flux_dir_vis.deallocate(); - sfc_flux_dif_nir.deallocate(); - sfc_flux_dif_vis.deallocate(); - if (yakl::isInitialized()) { yakl::finalize(); } -} - -TEST_CASE("rrtmgp_test_radiation_do") { - // If we specify rad every step, radiation_do should always be true - REQUIRE(scream::rrtmgp::radiation_do(1, 0) == true); - REQUIRE(scream::rrtmgp::radiation_do(1, 1) == true); - REQUIRE(scream::rrtmgp::radiation_do(1, 2) == true); - - // Test cases where we want rad called every other step - REQUIRE(scream::rrtmgp::radiation_do(2, 0) == true); - REQUIRE(scream::rrtmgp::radiation_do(2, 1) == false); - REQUIRE(scream::rrtmgp::radiation_do(2, 2) == true); - REQUIRE(scream::rrtmgp::radiation_do(2, 3) == false); - - // Test cases where we want rad every third step - REQUIRE(scream::rrtmgp::radiation_do(3, 0) == true); - REQUIRE(scream::rrtmgp::radiation_do(3, 1) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 2) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 3) == true); - REQUIRE(scream::rrtmgp::radiation_do(3, 4) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 5) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 6) == true); -} - -TEST_CASE("rrtmgp_test_check_range") { - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - // Create some dummy data and test with both values inside valid range and outside - auto dummy = real2d("dummy", 2, 1); - // All values within range - memset(dummy, 0.1); - REQUIRE(scream::rrtmgp::check_range(dummy, 0.0, 1.0, "dummy") == true); - // At least one value below lower bound - yakl::fortran::parallel_for(1, YAKL_LAMBDA (int i) {dummy(i, 1) = -0.1;}); - REQUIRE(scream::rrtmgp::check_range(dummy, 0.0, 1.0, "dummy") == false); - // At least one value above upper bound - yakl::fortran::parallel_for(1, YAKL_LAMBDA (int i) {dummy(i, 1) = 1.1;}); - REQUIRE(scream::rrtmgp::check_range(dummy, 0.0, 1.0, "dummy") == false); - dummy.deallocate(); - if (yakl::isInitialized()) { yakl::finalize(); } -} - -TEST_CASE("rrtmgp_test_subcol_gen") { - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - // Create dummy data - const int ncol = 1; - const int nlay = 4; - const int ngpt = 10; - auto cldfrac = real2d("cldfrac", ncol, nlay); - // Set cldfrac values - memset(cldfrac, 0.0); - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - cldfrac(1,1) = 1; - cldfrac(1,2) = 0.5; - cldfrac(1,3) = 0; - cldfrac(1,4) = 1; - }); - auto cldmask = int3d("cldmask", ncol, nlay, ngpt); - auto cldfrac_from_mask = real2d("cldfrac_from_mask", ncol, nlay); - // Run subcol gen, make sure we get what we expect; do this for some different seed values - for (unsigned seed = 1; seed <= 10; seed++) { - auto seeds = int1d("seeds", ncol); - memset(seeds, seed); - cldmask = scream::rrtmgp::get_subcolumn_mask(ncol, nlay, ngpt, cldfrac, 1, seeds); - // Check answers by computing new cldfrac from mask - memset(cldfrac_from_mask, 0.0); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { - for (int igpt = 1; igpt <= ngpt; ++igpt) { - real cldmask_real = cldmask(icol,ilay,igpt); - cldfrac_from_mask(icol,ilay) += cldmask_real; - } - }); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { - cldfrac_from_mask(icol,ilay) = cldfrac_from_mask(icol,ilay) / ngpt; - }); - // For cldfrac 1 we should get 1, for cldfrac 0 we should get 0, but in between we cannot be sure - // deterministically, since the computed cloud mask depends on pseudo-random numbers - REQUIRE(cldfrac_from_mask.createHostCopy()(1,1) == 1); - REQUIRE(cldfrac_from_mask.createHostCopy()(1,2) <= 1); - REQUIRE(cldfrac_from_mask.createHostCopy()(1,3) == 0); - REQUIRE(cldfrac_from_mask.createHostCopy()(1,4) == 1); - } - - // For maximum-random overlap, vertically-contiguous layers maximimally overlap, - // thus if we have non-zero cloud fraction in two adjacent layers, then every subcolumn - // that has cloud in the layer above must also have cloud in the layer below; test - // this property by creating two layers with non-zero cloud fraction, creating subcolums, - // and verifying that every subcolumn with cloud in layer 1 has cloud in layer 2 - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - cldfrac(1,1) = 0.5; - cldfrac(1,2) = 0.5; - cldfrac(1,3) = 0; - cldfrac(1,4) = 0; - }); - for (unsigned seed = 1; seed <= 10; seed++) { - auto seeds = int1d("seeds", ncol); - memset(seeds, seed); - cldmask = scream::rrtmgp::get_subcolumn_mask(ncol, nlay, ngpt, cldfrac, 1, seeds); - auto cldmask_h = cldmask.createHostCopy(); - for (int igpt = 1; igpt <= ngpt; igpt++) { - if (cldmask_h(1,1,igpt) == 1) { - REQUIRE(cldmask_h(1,2,igpt) == 1); - } - } - } - // Clean up after test - cldfrac.deallocate(); - cldmask.deallocate(); - cldfrac_from_mask.deallocate(); - yakl::finalize(); -} - - -TEST_CASE("rrtmgp_cloud_area") { - // Initialize YAKL - if (!yakl::isInitialized()) { yakl::init(); } - // Create dummy data - const int ncol = 1; - const int nlay = 2; - const int ngpt = 3; - auto cldtau = real3d("cldtau", ncol, nlay, ngpt); - auto cldtot = real1d("cldtot", ncol); - auto pmid = real2d("pmid", ncol, nlay); - - // Set up pressure levels for test problem - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - pmid(1,1) = 100; - pmid(1,2) = 200; - }); - - // Case: - // - // 0 0 0 - // 0 0 0 - // - // should give cldtot = 0.0 - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - cldtau(1,1,1) = 0; - cldtau(1,1,2) = 0; - cldtau(1,1,3) = 0; - cldtau(1,2,1) = 0; - cldtau(1,2,2) = 0; - cldtau(1,2,3) = 0; - }); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 0, std::numeric_limits::max(), pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 0.0); - - // Case: - // - // 1 1 1 - // 1 1 1 - // - // should give cldtot = 1.0 - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - cldtau(1,1,1) = 1; - cldtau(1,1,2) = 1; - cldtau(1,1,3) = 1; - cldtau(1,2,1) = 1; - cldtau(1,2,2) = 1; - cldtau(1,2,3) = 1; - }); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 0, std::numeric_limits::max(), pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 1.0); - - // Case: - // - // 1 1 0 100 - // 0 0 1 200 - // - // should give cldtot = 1.0 - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - cldtau(1,1,1) = 0.1; - cldtau(1,1,2) = 1.5; - cldtau(1,1,3) = 0; - cldtau(1,2,1) = 0; - cldtau(1,2,2) = 0; - cldtau(1,2,3) = 1.0; - }); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 0, std::numeric_limits::max(), pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 1.0); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 0, 150, pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 2.0 / 3.0); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 110, 250, pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 1.0 / 3.0); - - // Case: - // - // 1 0 0 - // 1 0 1 - // - // should give cldtot = 2/3 - yakl::fortran::parallel_for(1, YAKL_LAMBDA(int /* dummy */) { - cldtau(1,1,1) = 1; - cldtau(1,1,2) = 0; - cldtau(1,1,3) = 0; - cldtau(1,2,1) = 1; - cldtau(1,2,2) = 0; - cldtau(1,2,3) = 1; - }); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 0, std::numeric_limits::max(), pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 2.0 / 3.0); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 0, 100, pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 0.0); - scream::rrtmgp::compute_cloud_area(ncol, nlay, ngpt, 100, 300, pmid, cldtau, cldtot); - REQUIRE(cldtot.createHostCopy()(1) == 2.0 / 3.0); - pmid.deallocate(); - cldtau.deallocate(); - cldtot.deallocate(); - yakl::finalize(); -} - -TEST_CASE("rrtmgp_aerocom_cloudtop") { - // Initialize YAKL - if(!yakl::isInitialized()) { - yakl::init(); - } - // Create dummy data - const int ncol = 1; - const int nlay = 9; - // Set up input fields - auto tmid = real2d("tmid", ncol, nlay); - auto pmid = real2d("pmid", ncol, nlay); - auto p_del = real2d("p_del", ncol, nlay); - auto z_del = real2d("z_del", ncol, nlay); - auto qc = real2d("qc", ncol, nlay); - auto qi = real2d("qi", ncol, nlay); - auto rel = real2d("rel", ncol, nlay); - auto rei = real2d("rei", ncol, nlay); - auto cldfrac_tot = real2d("cldfrac_tot", ncol, nlay); - auto nc = real2d("nc", ncol, nlay); - // Set up output fields - auto tmid_at_cldtop = real1d("tmid_at_cldtop", ncol); - auto pmid_at_cldtop = real1d("pmid_at_cldtop", ncol); - auto cldfrac_ice_at_cldtop = real1d("cldfrac_ice_at_cldtop", ncol); - auto cldfrac_liq_at_cldtop = real1d("cldfrac_liq_at_cldtop", ncol); - auto cldfrac_tot_at_cldtop = real1d("cldfrac_tot_at_cldtop", ncol); - auto cdnc_at_cldtop = real1d("cdnc_at_cldtop", ncol); - auto eff_radius_qc_at_cldtop = real1d("eff_radius_qc_at_cldtop", ncol); - auto eff_radius_qi_at_cldtop = real1d("eff_radius_qi_at_cldtop", ncol); - - // Case 1: if no clouds, everything goes to zero - memset(tmid, 300.0); - memset(pmid, 100.0); - memset(p_del, 10.0); - memset(z_del, 100.0); - memset(qc, 1.0); - memset(qi, 1.0); - memset(cldfrac_tot, 0.0); - memset(nc, 5.0); - memset(rel, 10.0); - memset(rei, 10.0); - // Call the function - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - // Check the results - REQUIRE(tmid_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(pmid_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(cldfrac_liq_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(cldfrac_ice_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(cdnc_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(eff_radius_qc_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(eff_radius_qi_at_cldtop.createHostCopy()(1) == 0.0); - - // Case 2: if all clouds, everything goes to 1 * its value - memset(cldfrac_tot, 1.0); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - REQUIRE(tmid_at_cldtop.createHostCopy()(1) == 300.0); - REQUIRE(pmid_at_cldtop.createHostCopy()(1) == 100.0); - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) == 1.0); - REQUIRE(cldfrac_liq_at_cldtop.createHostCopy()(1) == 0.5); - REQUIRE(cldfrac_ice_at_cldtop.createHostCopy()(1) == 0.5); - REQUIRE(cdnc_at_cldtop.createHostCopy()(1) > 0.0); - REQUIRE(eff_radius_qc_at_cldtop.createHostCopy()(1) > 0.0); - REQUIRE(eff_radius_qi_at_cldtop.createHostCopy()(1) > 0.0); - - // Case 3: test max overlap (if contiguous cloudy layers, then max) - memset(cldfrac_tot, 0.0); - yakl::fortran::parallel_for( - 1, YAKL_LAMBDA(int /* dummy */) { - cldfrac_tot(1, 2) = 0.5; - cldfrac_tot(1, 3) = 0.7; - cldfrac_tot(1, 4) = 0.3; - cldfrac_tot(1, 5) = 0.2; - }); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) == .7); - - // Case 3xtra: test max overlap - // This case produces >0.7 due to slight enhancement in the presence of a - // local minimum (0.1 is the local minimum between 0.2 and 0.4) - yakl::fortran::parallel_for( - 1, YAKL_LAMBDA(int /* dummy */) { - cldfrac_tot(1, 5) = 0.1; - cldfrac_tot(1, 6) = 0.4; - cldfrac_tot(1, 7) = 0.2; - }); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) > .7); - - // Case 4: test random overlap (if non-contiguous cloudy layers, then - // random) - yakl::fortran::parallel_for( - 1, YAKL_LAMBDA(int /* dummy */) { - cldfrac_tot(1, 5) = 0.0; - cldfrac_tot(1, 6) = 0.1; - }); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) > - .7); // larger than the max - - // Case 5a: test independence of ice and liquid fractions - yakl::fortran::parallel_for( - 1, YAKL_LAMBDA(int /* dummy */) { - cldfrac_tot(1, 2) = 1.0; - cldfrac_tot(1, 7) = 1.0; - cldfrac_tot(1, 8) = 0.2; - }); - memset(qc, 1.0); - memset(qi, 0.0); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) == 1.0); - REQUIRE(cldfrac_liq_at_cldtop.createHostCopy()(1) == 1.0); - REQUIRE(cldfrac_ice_at_cldtop.createHostCopy()(1) == 0.0); - - // Case 5b: test independence of ice and liquid fractions - yakl::fortran::parallel_for( - 1, YAKL_LAMBDA(int /* dummy */) { - cldfrac_tot(1, 2) = 1.0; - cldfrac_tot(1, 7) = 1.0; - cldfrac_tot(1, 8) = 0.2; - }); - memset(qc, 0.0); - memset(qi, 1.0); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) == 1.0); - REQUIRE(cldfrac_liq_at_cldtop.createHostCopy()(1) == 0.0); - REQUIRE(cldfrac_ice_at_cldtop.createHostCopy()(1) == 1.0); - - // Case 6: test independence of ice and liquid fractions - // There is NOT complete independence... - // Essentially, higher ice clouds mask lower liquid clouds - // This can be problematic if the ice clouds are thin... - // We will revisit and validate this assumption later - memset(cldfrac_tot, 0.0); - memset(qc, 0.0); - memset(qi, 0.0); - yakl::fortran::parallel_for( - 1, YAKL_LAMBDA(int /* dummy */) { - cldfrac_tot(1, 2) = 0.5; // ice - cldfrac_tot(1, 3) = 0.7; // ice ------> max - cldfrac_tot(1, 4) = 0.3; // ice - // note cldfrac_tot(1, 5) is 0 - cldfrac_tot(1, 6) = 0.2; // liq - cldfrac_tot(1, 7) = 0.5; // liq ------> not max - cldfrac_tot(1, 8) = 0.1; // liq - // note cldfrac_tot(1, 9) is 0 - qi(1, 2) = 100; - qi(1, 3) = 200; - qi(1, 4) = 50; - // note qc(1, 5) is 0 - // note qi(1, 5) is 0 - qc(1, 6) = 20; - qc(1, 7) = 50; - qc(1, 8) = 10; - }); - scream::rrtmgp::compute_aerocom_cloudtop( - ncol, nlay, tmid, pmid, p_del, z_del, qc, qi, rel, rei, cldfrac_tot, nc, - tmid_at_cldtop, pmid_at_cldtop, cldfrac_ice_at_cldtop, - cldfrac_liq_at_cldtop, cldfrac_tot_at_cldtop, cdnc_at_cldtop, - eff_radius_qc_at_cldtop, eff_radius_qi_at_cldtop); - REQUIRE(cldfrac_tot_at_cldtop.createHostCopy()(1) > 0.70); // unaffected - REQUIRE(cldfrac_liq_at_cldtop.createHostCopy()(1) < 0.50); // not max - REQUIRE(cldfrac_ice_at_cldtop.createHostCopy()(1) == 0.7); // max - - // cleanup - tmid.deallocate(); - pmid.deallocate(); - p_del.deallocate(); - z_del.deallocate(); - qc.deallocate(); - qi.deallocate(); - rel.deallocate(); - rei.deallocate(); - cldfrac_tot.deallocate(); - nc.deallocate(); - - tmid_at_cldtop.deallocate(); - pmid_at_cldtop.deallocate(); - cldfrac_ice_at_cldtop.deallocate(); - cldfrac_liq_at_cldtop.deallocate(); - cldfrac_tot_at_cldtop.deallocate(); - cdnc_at_cldtop.deallocate(); - eff_radius_qc_at_cldtop.deallocate(); - eff_radius_qi_at_cldtop.deallocate(); - - yakl::finalize(); -} -#endif - -#ifdef RRTMGP_ENABLE_KOKKOS using interface_t = scream::rrtmgp::rrtmgp_interface<>; using pool_t = interface_t::pool_t; using real1dk = interface_t::view_t; @@ -915,7 +85,7 @@ TEST_CASE("rrtmgp_test_heating_k") { } TEST_CASE("rrtmgp_test_mixing_ratio_to_cloud_mass_k") { - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); @@ -975,7 +145,7 @@ TEST_CASE("rrtmgp_test_mixing_ratio_to_cloud_mass_k") { } TEST_CASE("rrtmgp_test_limit_to_bounds_k") { - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); @@ -1076,7 +246,7 @@ TEST_CASE("rrtmgp_test_compute_broadband_surface_flux_k") { ekat::Comm comm(MPI_COMM_WORLD); auto logger = std::make_shared("",LogLevel::info,comm); - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); @@ -1232,7 +402,7 @@ TEST_CASE("rrtmgp_test_compute_broadband_surface_flux_k") { REQUIRE(std::abs(chc(sfc_flux_dif_vis)(0) - 26.0) < tol); // --------------------------------- - // Finalize YAKL + // Finalize Kokkos logger->info("Free memory...\n"); interface_t::rrtmgp_finalize(); gas_concs.reset(); @@ -1241,29 +411,18 @@ TEST_CASE("rrtmgp_test_compute_broadband_surface_flux_k") { } TEST_CASE("rrtmgp_test_radiation_do_k") { - // If we specify rad every step, radiation_do should always be true - REQUIRE(scream::rrtmgp::radiation_do(1, 0) == true); - REQUIRE(scream::rrtmgp::radiation_do(1, 1) == true); - REQUIRE(scream::rrtmgp::radiation_do(1, 2) == true); - - // Test cases where we want rad called every other step - REQUIRE(scream::rrtmgp::radiation_do(2, 0) == true); - REQUIRE(scream::rrtmgp::radiation_do(2, 1) == false); - REQUIRE(scream::rrtmgp::radiation_do(2, 2) == true); - REQUIRE(scream::rrtmgp::radiation_do(2, 3) == false); - - // Test cases where we want rad every third step - REQUIRE(scream::rrtmgp::radiation_do(3, 0) == true); - REQUIRE(scream::rrtmgp::radiation_do(3, 1) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 2) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 3) == true); - REQUIRE(scream::rrtmgp::radiation_do(3, 4) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 5) == false); - REQUIRE(scream::rrtmgp::radiation_do(3, 6) == true); + // Rad runs whenever step is a multiple of freq + // NOTE: the rrtmgp process class handles logic for running on 1st step + for (int istep : {1,2,3,4,5,6}) { + for (int rad_freq : {1,2,3}) { + bool divides = istep%rad_freq == 0; + REQUIRE( scream::rrtmgp::radiation_do(rad_freq,istep)== divides ); + } + } } TEST_CASE("rrtmgp_test_check_range_k") { - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); // Create some dummy data and test with both values inside valid range and outside @@ -1282,7 +441,7 @@ TEST_CASE("rrtmgp_test_check_range_k") { } TEST_CASE("rrtmgp_test_subcol_gen_k") { - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); // Create dummy data @@ -1352,7 +511,7 @@ TEST_CASE("rrtmgp_test_subcol_gen_k") { } TEST_CASE("rrtmgp_cloud_area_k") { - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); // Create dummy data @@ -1449,7 +608,7 @@ TEST_CASE("rrtmgp_cloud_area_k") { } TEST_CASE("rrtmgp_aerocom_cloudtop_k") { - // Initialize YAKL + // Initialize Kokkos scream::init_kls(); pool_t::init(10000); @@ -1643,6 +802,5 @@ TEST_CASE("rrtmgp_aerocom_cloudtop_k") { pool_t::finalize(); scream::finalize_kls(); } -#endif } diff --git a/components/eamxx/src/physics/share/physics_test_data.hpp b/components/eamxx/src/physics/share/physics_test_data.hpp index 92522d499e68..576aa6ea014b 100644 --- a/components/eamxx/src/physics/share/physics_test_data.hpp +++ b/components/eamxx/src/physics/share/physics_test_data.hpp @@ -6,6 +6,8 @@ #include "ekat/util/ekat_math_utils.hpp" #include "ekat/ekat_assert.hpp" #include "ekat/util/ekat_file_utils.hpp" +#include "ekat/util/ekat_test_utils.hpp" +#include "share/util/eamxx_setup_random_test.hpp" #include #include @@ -69,6 +71,9 @@ struct SHOCGridData : public PhysicsTestData { #define PTD_DATA_COPY_CTOR(name, num_args) \ name(const name& rhs) : name(PTD_ONES(num_args)) { *this = rhs; } +#define PTD_DATA_COPY_CTOR_INIT(name, num_args) \ + name(const name& rhs) : name(PTD_ONES(num_args), rhs.init) { *this = rhs; } + #define PTD_ASS0() ((void) (0)) #define PTD_ASS1(first) first = rhs.first; PTD_ASS0() #define PTD_ASS2(first, ...) first = rhs.first; PTD_ASS1(__VA_ARGS__) @@ -127,6 +132,9 @@ struct SHOCGridData : public PhysicsTestData { #define PTD_ASSIGN_OP(name, num_scalars, ...) \ name& operator=(const name& rhs) { PTD_ASS##num_scalars(__VA_ARGS__); assignment_impl(rhs); return *this; } +#define PTD_ASSIGN_OP_INIT(name, num_scalars, ...) \ + name& operator=(const name& rhs) { PTD_ASS##num_scalars(__VA_ARGS__); assignment_impl(rhs); init = rhs.init; return *this; } + #define PTD_RW_SCALARS(num_scalars, ...) \ void read_scalars(const ekat::FILEPtr& fid) { EKAT_REQUIRE_MSG(fid, "Tried to read from missing file. You may have forgotten to generate baselines for some BFB unit tests"); PTD_RW##num_scalars(read, __VA_ARGS__); } \ void write_scalars(const ekat::FILEPtr& fid) const { PTD_RW##num_scalars(write, __VA_ARGS__); } @@ -145,6 +153,12 @@ struct SHOCGridData : public PhysicsTestData { PTD_RW() \ PTD_RW_SCALARS(num_scalars, __VA_ARGS__) +#define PTD_STD_DEF_INIT(name, num_scalars, ...) \ + PTD_DATA_COPY_CTOR_INIT(name, num_scalars); \ + PTD_ASSIGN_OP_INIT(name, num_scalars, __VA_ARGS__) \ + PTD_RW() \ + PTD_RW_SCALARS(num_scalars, __VA_ARGS__) + namespace scream { // Fully Generic Data struct for multi-dimensions reals and ints @@ -413,6 +427,79 @@ class PhysicsTestData PTDImpl m_bools; // manage bool data with this member, use chars internally to dodge vector specialization }; +enum BASELINE_ACTION { + NONE, + COMPARE, + GENERATE +}; + +/** + * In $phys_unit_tests_common.hpp, the UnitWrap struct should have an inner struct "Base" + * that inherits from the struct below. This will ensure common BFB baseline unit tests + * are set up in a consistent manner. + */ +struct UnitBase +{ + + std::string m_baseline_path; + std::string m_test_name; + BASELINE_ACTION m_baseline_action; + ekat::FILEPtr m_fid; + + UnitBase() : + m_baseline_path(""), + m_test_name(Catch::getResultCapture().getCurrentTestName()), + m_baseline_action(NONE), + m_fid() + { + auto& ts = ekat::TestSession::get(); + if (ts.flags["c"]) { + m_baseline_action = COMPARE; + } + else if (ts.flags["g"]) { + m_baseline_action = GENERATE; + } + else if (ts.flags["n"]) { + m_baseline_action = NONE; + } + m_baseline_path = ts.params["b"]; + + EKAT_REQUIRE_MSG( !(m_baseline_action != NONE && m_baseline_path == ""), + "Unit test flags problem: baseline actions were requested but no baseline path was provided"); + + std::string baseline_name = m_baseline_path + "/" + m_test_name; + if (m_baseline_action == COMPARE) { + m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "r")); + EKAT_REQUIRE_MSG(m_fid, "Missing baselines: " << baseline_name); + } + else if (m_baseline_action == GENERATE) { + m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "w")); + } + } + + ~UnitBase() = default; + + std::mt19937_64 get_engine() + { + if (m_baseline_action != COMPARE) { + // We can use any seed + int seed; + auto engine = setup_random_test(nullptr, &seed); + if (m_baseline_action == GENERATE) { + // Write the seed + ekat::write(&seed, 1, m_fid); + } + return engine; + } + else { + // Read the seed + int seed; + ekat::read(&seed, 1, m_fid); + return setup_random_test(seed); + } + } +}; + } // namespace scream #endif // SCREAM_PHYSICS_TEST_DATA_HPP diff --git a/components/eamxx/src/physics/shoc/CMakeLists.txt b/components/eamxx/src/physics/shoc/CMakeLists.txt index f6106bb01deb..277b2a2ee3bd 100644 --- a/components/eamxx/src/physics/shoc/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/CMakeLists.txt @@ -86,7 +86,7 @@ if (NOT SCREAM_DEBUG) endif() endif() -if (HIP_BUILD) +if (Kokkos_ENABLE_HIP) #this is needed for crusher even with small kernels set_source_files_properties(shoc_diag_second_shoc_moments_disp.cpp PROPERTIES COMPILE_FLAGS -O1) endif() diff --git a/components/eamxx/src/physics/shoc/disp/shoc_assumed_pdf_disp.cpp b/components/eamxx/src/physics/shoc/disp/shoc_assumed_pdf_disp.cpp index d04401d1e7f3..d4cdeef88829 100644 --- a/components/eamxx/src/physics/shoc/disp/shoc_assumed_pdf_disp.cpp +++ b/components/eamxx/src/physics/shoc/disp/shoc_assumed_pdf_disp.cpp @@ -16,6 +16,8 @@ ::shoc_assumed_pdf_disp( const view_2d& w_field, const view_2d& thl_sec, const view_2d& qw_sec, + const Scalar& dtime, + const bool& extra_diags, const view_2d& wthl_sec, const view_2d& w_sec, const view_2d& wqw_sec, @@ -25,6 +27,8 @@ ::shoc_assumed_pdf_disp( const view_2d& zt_grid, const view_2d& zi_grid, const WorkspaceMgr& workspace_mgr, + const view_2d& shoc_cond, + const view_2d& shoc_evap, const view_2d& shoc_cldfrac, const view_2d& shoc_ql, const view_2d& wqls, @@ -47,6 +51,8 @@ ::shoc_assumed_pdf_disp( ekat::subview(w_field, i), ekat::subview(thl_sec, i), ekat::subview(qw_sec, i), + dtime, + extra_diags, ekat::subview(wthl_sec, i), ekat::subview(w_sec, i), ekat::subview(wqw_sec, i), @@ -56,6 +62,8 @@ ::shoc_assumed_pdf_disp( ekat::subview(zt_grid, i), ekat::subview(zi_grid, i), workspace, + ekat::subview(shoc_cond, i), + ekat::subview(shoc_evap, i), ekat::subview(shoc_cldfrac, i), ekat::subview(shoc_ql, i), ekat::subview(wqls, i), diff --git a/components/eamxx/src/physics/shoc/disp/shoc_diag_second_shoc_moments_disp.cpp b/components/eamxx/src/physics/shoc/disp/shoc_diag_second_shoc_moments_disp.cpp index 5561b80324d2..98410db99e25 100644 --- a/components/eamxx/src/physics/shoc/disp/shoc_diag_second_shoc_moments_disp.cpp +++ b/components/eamxx/src/physics/shoc/disp/shoc_diag_second_shoc_moments_disp.cpp @@ -10,6 +10,7 @@ void Functions ::diag_second_shoc_moments_disp( const Int& shcol, const Int& nlev, const Int& nlevi, const Real& thl2tune, const Real& qw2tune, const Real& qwthl2tune, const Real& w2tune, + const bool& shoc_1p5tke, const view_2d& thetal, const view_2d& qw, const view_2d& u_wind, @@ -51,6 +52,7 @@ ::diag_second_shoc_moments_disp( diag_second_shoc_moments( team, nlev, nlevi, thl2tune, qw2tune, qwthl2tune, w2tune, + shoc_1p5tke, ekat::subview(thetal, i), ekat::subview(qw, i), ekat::subview(u_wind, i), diff --git a/components/eamxx/src/physics/shoc/disp/shoc_diag_third_shoc_moments_disp.cpp b/components/eamxx/src/physics/shoc/disp/shoc_diag_third_shoc_moments_disp.cpp index 9d9ac106a3fb..048fac215c3f 100644 --- a/components/eamxx/src/physics/shoc/disp/shoc_diag_third_shoc_moments_disp.cpp +++ b/components/eamxx/src/physics/shoc/disp/shoc_diag_third_shoc_moments_disp.cpp @@ -12,6 +12,7 @@ ::diag_third_shoc_moments_disp( const Int& nlev, const Int& nlevi, const Scalar& c_diag_3rd_mom, + const bool& shoc_1p5tke, const view_2d& w_sec, const view_2d& thl_sec, const view_2d& wthl_sec, @@ -38,6 +39,7 @@ ::diag_third_shoc_moments_disp( diag_third_shoc_moments( team, nlev, nlevi, c_diag_3rd_mom, + shoc_1p5tke, ekat::subview(w_sec, i), ekat::subview(thl_sec, i), ekat::subview(wthl_sec, i), diff --git a/components/eamxx/src/physics/shoc/disp/shoc_length_disp.cpp b/components/eamxx/src/physics/shoc/disp/shoc_length_disp.cpp index a30078816548..9dce33ca846b 100644 --- a/components/eamxx/src/physics/shoc/disp/shoc_length_disp.cpp +++ b/components/eamxx/src/physics/shoc/disp/shoc_length_disp.cpp @@ -12,6 +12,7 @@ ::shoc_length_disp( const Int& nlev, const Int& nlevi, const Scalar& length_fac, + const bool& shoc_1p5tke, const view_1d& dx, const view_1d& dy, const view_2d& zt_grid, @@ -19,6 +20,7 @@ ::shoc_length_disp( const view_2d& dz_zt, const view_2d& tke, const view_2d& thv, + const view_2d& tk, const WorkspaceMgr& workspace_mgr, const view_2d& brunt, const view_2d& shoc_mix) @@ -32,13 +34,14 @@ ::shoc_length_disp( auto workspace = workspace_mgr.get_workspace(team); - shoc_length(team, nlev, nlevi, length_fac, + shoc_length(team, nlev, nlevi, length_fac, shoc_1p5tke, dx(i), dy(i), ekat::subview(zt_grid, i), ekat::subview(zi_grid, i), ekat::subview(dz_zt, i), ekat::subview(tke, i), ekat::subview(thv, i), + ekat::subview(tk, i), workspace, ekat::subview(brunt, i), ekat::subview(shoc_mix, i)); diff --git a/components/eamxx/src/physics/shoc/disp/shoc_tke_disp.cpp b/components/eamxx/src/physics/shoc/disp/shoc_tke_disp.cpp index eb66cd2c4431..240509b59d01 100644 --- a/components/eamxx/src/physics/shoc/disp/shoc_tke_disp.cpp +++ b/components/eamxx/src/physics/shoc/disp/shoc_tke_disp.cpp @@ -18,6 +18,7 @@ ::shoc_tke_disp( const Scalar& lambda_thresh, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, const view_2d& wthv_sec, const view_2d& shoc_mix, const view_2d& dz_zi, @@ -47,7 +48,7 @@ ::shoc_tke_disp( shoc_tke(team, nlev, nlevi, dtime, lambda_low, lambda_high, lambda_slope, lambda_thresh, - Ckh, Ckm, + Ckh, Ckm, shoc_1p5tke, ekat::subview(wthv_sec, i), ekat::subview(shoc_mix, i), ekat::subview(dz_zi, i), diff --git a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp index b86266dd00da..e22209869e08 100644 --- a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp +++ b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp @@ -98,6 +98,8 @@ void SHOCMacrophysics::set_grids(const std::shared_ptr grids add_field("brunt", scalar3d_mid, pow(s,-1), grid_name, ps); add_field("shoc_mix", scalar3d_mid, m, grid_name, ps); add_field("isotropy", scalar3d_mid, s, grid_name, ps); + add_field("shoc_cond", scalar3d_mid, kg/kg/s, grid_name, ps); + add_field("shoc_evap", scalar3d_mid, kg/kg/s, grid_name, ps); // Diagnostic output - interface grid add_field("wthl_sec", scalar3d_int, K*(m/s), grid_name, ps); @@ -198,7 +200,7 @@ void SHOCMacrophysics::init_buffers(const ATMBufferManager &buffer_manager) using spack_2d_view_t = decltype(m_buffer.z_mid); spack_2d_view_t* _2d_spack_mid_view_ptrs[Buffer::num_2d_vector_mid] = { - &m_buffer.z_mid, &m_buffer.rrho, &m_buffer.thv, &m_buffer.dz, &m_buffer.zt_grid, &m_buffer.wm_zt, + &m_buffer.z_mid, &m_buffer.rrho, &m_buffer.thv, &m_buffer.dz, &m_buffer.zt_grid, &m_buffer.wm_zt, &m_buffer.unused, &m_buffer.inv_exner, &m_buffer.thlm, &m_buffer.qw, &m_buffer.dse, &m_buffer.tke_copy, &m_buffer.qc_copy, &m_buffer.shoc_ql2, &m_buffer.shoc_mix, &m_buffer.isotropy, &m_buffer.w_sec, &m_buffer.wqls_sec, &m_buffer.brunt #ifdef SCREAM_SHOC_SMALL_KERNELS @@ -258,6 +260,8 @@ void SHOCMacrophysics::initialize_impl (const RunType run_type) runtime_options.c_diag_3rd_mom = m_params.get("c_diag_3rd_mom"); runtime_options.Ckh = m_params.get("coeff_kh"); runtime_options.Ckm = m_params.get("coeff_km"); + runtime_options.shoc_1p5tke = m_params.get("shoc_1p5tke"); + runtime_options.extra_diags = m_params.get("extra_shoc_diags"); // Initialize all of the structures that are passed to shoc_main in run_impl. // Note: Some variables in the structures are not stored in the field manager. For these // variables a local view is constructed. @@ -315,7 +319,7 @@ void SHOCMacrophysics::initialize_impl (const RunType run_type) Kokkos::deep_copy(cldfrac_liq,0.0); } - shoc_preprocess.set_variables(m_num_cols,m_num_levs,m_num_tracers,z_surf, + shoc_preprocess.set_variables(m_num_cols,m_num_levs,z_surf, T_mid,p_mid,p_int,pseudo_density,omega,phis,surf_sens_flux,surf_evap, surf_mom_flux,qtracers,qv,qc,qc_copy,tke,tke_copy,z_mid,z_int, dse,rrho,rrho_i,thv,dz,zt_grid,zi_grid,wpthlp_sfc,wprtp_sfc,upwp_sfc,vpwp_sfc, @@ -359,6 +363,13 @@ void SHOCMacrophysics::initialize_impl (const RunType run_type) // Ouput (diagnostic) history_output.shoc_mix = m_buffer.shoc_mix; history_output.isotropy = m_buffer.isotropy; + if (m_params.get("extra_shoc_diags", false)) { + history_output.shoc_cond = get_field_out("shoc_cond").get_view(); + history_output.shoc_evap = get_field_out("shoc_evap").get_view(); + } else { + history_output.shoc_cond = m_buffer.unused; + history_output.shoc_evap = m_buffer.unused; + } history_output.w_sec = get_field_out("w_variance").get_view(); history_output.thl_sec = m_buffer.thl_sec; history_output.qw_sec = m_buffer.qw_sec; @@ -392,7 +403,7 @@ void SHOCMacrophysics::initialize_impl (const RunType run_type) temporaries.dz_zi = m_buffer.dz_zi; #endif - shoc_postprocess.set_variables(m_num_cols,m_num_levs,m_num_tracers, + shoc_postprocess.set_variables(m_num_cols,m_num_levs, rrho,qv,qw,qc,qc_copy,tke,tke_copy,qtracers,shoc_ql2, cldfrac_liq,inv_qc_relvar, T_mid, dse, z_mid, phis); @@ -484,6 +495,9 @@ void SHOCMacrophysics::run_impl (const double dt) shoc_preprocess); Kokkos::fence(); + auto wtracer_sfc = shoc_preprocess.wtracer_sfc; + Kokkos::deep_copy(wtracer_sfc, 0); + if (m_params.get("apply_tms", false)) { apply_turbulent_mountain_stress(); } diff --git a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.hpp b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.hpp index 48126bbc302a..2b7c737a864e 100644 --- a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.hpp +++ b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.hpp @@ -158,15 +158,10 @@ class SHOCMacrophysics : public scream::AtmosphereProcess wprtp_sfc(i) = surf_evap(i)/rrho_i(i,nlevi_v)[nlevi_p]; upwp_sfc(i) = surf_mom_flux(i,0)/rrho_i(i,nlevi_v)[nlevi_p]; vpwp_sfc(i) = surf_mom_flux(i,1)/rrho_i(i,nlevi_v)[nlevi_p]; - - const int num_qtracer_packs = ekat::npack(num_qtracers); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, num_qtracer_packs), [&] (const Int& q) { - wtracer_sfc(i,q) = 0; - }); } // operator // Local variables - int ncol, nlev, num_qtracers; + int ncol, nlev; Real z_surf; view_2d_const T_mid; view_2d_const p_mid; @@ -206,7 +201,7 @@ class SHOCMacrophysics : public scream::AtmosphereProcess view_2d cldfrac_liq_prev; // Assigning local variables - void set_variables(const int ncol_, const int nlev_, const int num_qtracers_, + void set_variables(const int ncol_, const int nlev_, const Real z_surf_, const view_2d_const& T_mid_, const view_2d_const& p_mid_, const view_2d_const& p_int_, const view_2d_const& pseudo_density_, const view_2d_const& omega_, @@ -224,7 +219,6 @@ class SHOCMacrophysics : public scream::AtmosphereProcess { ncol = ncol_; nlev = nlev_; - num_qtracers = num_qtracers_; z_surf = z_surf_; // IN T_mid = T_mid_; @@ -320,7 +314,7 @@ class SHOCMacrophysics : public scream::AtmosphereProcess } // operator // Local variables - int ncol, nlev, num_qtracers; + int ncol, nlev; view_2d_const rrho; view_2d qv, qc, tke; view_2d_const tke_copy, qc_copy, qw; @@ -340,7 +334,7 @@ class SHOCMacrophysics : public scream::AtmosphereProcess view_1d heat_flux; // Assigning local variables - void set_variables(const int ncol_, const int nlev_, const int num_qtracers_, + void set_variables(const int ncol_, const int nlev_, const view_2d_const& rrho_, const view_2d& qv_, const view_2d_const& qw_, const view_2d& qc_, const view_2d_const& qc_copy_, const view_2d& tke_, const view_2d_const& tke_copy_, const view_3d_strided& qtracers_, const view_2d_const& qc2_, @@ -349,7 +343,6 @@ class SHOCMacrophysics : public scream::AtmosphereProcess { ncol = ncol_; nlev = nlev_; - num_qtracers = num_qtracers_; rrho = rrho_; qv = qv_; qw = qw_; @@ -391,10 +384,10 @@ class SHOCMacrophysics : public scream::AtmosphereProcess #endif static constexpr int num_1d_scalar_nlev = 1; #ifndef SCREAM_SHOC_SMALL_KERNELS - static constexpr int num_2d_vector_mid = 18; + static constexpr int num_2d_vector_mid = 19; static constexpr int num_2d_vector_int = 12; #else - static constexpr int num_2d_vector_mid = 22; + static constexpr int num_2d_vector_mid = 23; static constexpr int num_2d_vector_int = 13; #endif static constexpr int num_2d_vector_tr = 1; @@ -419,6 +412,7 @@ class SHOCMacrophysics : public scream::AtmosphereProcess uview_1d pref_mid; + uview_2d unused; // Placeholder for unused views uview_2d z_mid; uview_2d z_int; uview_2d rrho; diff --git a/components/eamxx/src/physics/shoc/impl/shoc_adv_sgs_tke_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_adv_sgs_tke_impl.hpp index 80a63edeff88..0f03b72ca238 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_adv_sgs_tke_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_adv_sgs_tke_impl.hpp @@ -18,10 +18,12 @@ ::adv_sgs_tke( const MemberType& team, const Int& nlev, const Real& dtime, + const bool& shoc_1p5tke, const uview_1d& shoc_mix, const uview_1d& wthv_sec, const uview_1d& sterm_zt, const uview_1d& tk, + const uview_1d& brunt, const uview_1d& tke, const uview_1d& a_diss) { @@ -31,6 +33,7 @@ ::adv_sgs_tke( static constexpr Scalar basetemp = C::basetemp; static constexpr Scalar mintke = scream::shoc::Constants::mintke; static constexpr Scalar maxtke = scream::shoc::Constants::maxtke; + Spack a_prod_bu; //declare some constants static constexpr Scalar Cs = 0.15; @@ -44,7 +47,14 @@ ::adv_sgs_tke( Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_pack), [&] (const Int& k) { // Compute buoyant production term - const Spack a_prod_bu = (ggr/basetemp)*wthv_sec(k); + if (shoc_1p5tke){ + // If there is no SGS variability the buoyant production term is closed + // as a function of the local moist brunt vaisalla frequency. + a_prod_bu = -tke(k)*brunt(k); + } + else{ + a_prod_bu = (ggr/basetemp)*wthv_sec(k); + } tke(k) = ekat::max(0,tke(k)); diff --git a/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp index 19d897c63d9e..af6de895792f 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp @@ -47,6 +47,8 @@ void Functions::shoc_assumed_pdf( const uview_1d& w_field, const uview_1d& thl_sec, const uview_1d& qw_sec, + const Scalar& dtime, + const bool& extra_diags, const uview_1d& wthl_sec, const uview_1d& w_sec, const uview_1d& wqw_sec, @@ -56,6 +58,8 @@ void Functions::shoc_assumed_pdf( const uview_1d& zt_grid, const uview_1d& zi_grid, const Workspace& workspace, + const uview_1d& shoc_cond, + const uview_1d& shoc_evap, const uview_1d& shoc_cldfrac, const uview_1d& shoc_ql, const uview_1d& wqls, @@ -242,6 +246,13 @@ void Functions::shoc_assumed_pdf( s2, ql2, C2, std_s2, shoc_ql(k), shoc_ql2(k)); + // Compute cond and evap tendencies + if (extra_diags) { + auto dum = ekat::max(0, a * ql1 + (1 - a) * ql2); + shoc_cond(k) = ekat::max(0, (dum - shoc_ql(k)) / dtime); + shoc_evap(k) = ekat::max(0, (shoc_ql(k) - dum) / dtime); + } + // Compute liquid water flux shoc_assumed_pdf_compute_liquid_water_flux(a, w1_1, w_first, ql1, w1_2, ql2, wqls(k)); diff --git a/components/eamxx/src/physics/shoc/impl/shoc_compute_diag_third_shoc_moment_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_compute_diag_third_shoc_moment_impl.hpp index acd2922d05b1..7fdd402e4486 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_compute_diag_third_shoc_moment_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_compute_diag_third_shoc_moment_impl.hpp @@ -14,6 +14,7 @@ ::compute_diag_third_shoc_moment( const Int& nlev, const Int& nlevi, const Scalar& c_diag_3rd_mom, + const bool& shoc_1p5tke, const uview_1d& w_sec, const uview_1d& thl_sec, const uview_1d& wthl_sec, @@ -78,46 +79,55 @@ ::compute_diag_third_shoc_moment( const auto active_range = range_pack > 0 && range_pack < nlev; if (active_range.any()) { - // Compute inputs for computing f0 to f5 terms - const auto thedz = 1/dz_zi(k); - const auto thedz2 = 1/(dz_zt_k+dz_zt_km1); - - const auto iso = isotropy_zi(k); - const auto isosqrd = ekat::square(iso); - const auto buoy_sgs2 = isosqrd*brunt_zi(k); - const auto bet2 = ggr/thetal_zi(k); - - // Compute f0 to f5 terms - const Spack thl_sec_diff = thl_sec_km1 - thl_sec_kp1; - const Spack wthl_sec_diff = wthl_sec_km1 - wthl_sec_kp1; - const Spack wsec_diff = w_sec_km1 - w_sec(k); - const Spack tke_diff = tke_km1 - tke(k); - - const auto f0 = thedz2*ekat::cube(bet2)*((iso*iso)*(iso*iso))*wthl_sec_k*thl_sec_diff; - const auto f1 = thedz2*ekat::square(bet2)*ekat::cube(iso)*(wthl_sec_k*wthl_sec_diff+sp(0.5)*w_sec_zi(k)*thl_sec_diff); - const auto f2 = thedz*bet2*isosqrd*wthl_sec_k*wsec_diff+2*thedz2*bet2*isosqrd*w_sec_zi(k)*wthl_sec_diff; - const auto f3 = thedz2*bet2*isosqrd*w_sec_zi(k)*wthl_sec_diff+thedz*bet2*isosqrd*(wthl_sec_k*tke_diff); - const auto f4 = thedz*iso*w_sec_zi(k)*(wsec_diff+tke_diff); - const auto f5 = thedz*iso*w_sec_zi(k)*wsec_diff; - - // Compute omega terms - const auto omega0 = a4/Spack(1-a5*buoy_sgs2); - const auto omega1 = omega0/(2*c_diag_3rd_mom); - const auto omega2 = omega1*f3+sp(5.0/4.0)*omega0*f4; - - // Compute the x0, y0, x1, y1 terms - const auto x0 = (a2*buoy_sgs2*(Spack(1)-a3*buoy_sgs2))/(Spack(1)-(a1+a3)*buoy_sgs2); - const auto y0 = (2*a2*buoy_sgs2*x0)/(Spack(1)-a3*buoy_sgs2); - const auto x1 = (a0*f0+a1*f1+a2*(Spack(1)-a3*buoy_sgs2)*f2)/(Spack(1)-(a1+a3)*buoy_sgs2); - const auto y1 = (2*a2*(buoy_sgs2*x1+(a0/a1)*f0+f1))/(Spack(1)-a3*buoy_sgs2); - - // Compute the aa0, aa1 terms - const auto aa0 = omega0*x0+omega1*y0; - const auto aa1 = omega0*x1+omega1*y1+omega2; - - // Finally, compute the third moment of w - w3(k).set(active_range, + + // If no SGS variability then set to zero everywhere, otherwise compute w3 + if (shoc_1p5tke){ + w3(k).set(active_range,0); + } + else{ + + // Compute inputs for computing f0 to f5 terms + const auto thedz = 1/dz_zi(k); + const auto thedz2 = 1/(dz_zt_k+dz_zt_km1); + + const auto iso = isotropy_zi(k); + const auto isosqrd = ekat::square(iso); + const auto buoy_sgs2 = isosqrd*brunt_zi(k); + const auto bet2 = ggr/thetal_zi(k); + + // Compute f0 to f5 terms + const Spack thl_sec_diff = thl_sec_km1 - thl_sec_kp1; + const Spack wthl_sec_diff = wthl_sec_km1 - wthl_sec_kp1; + const Spack wsec_diff = w_sec_km1 - w_sec(k); + const Spack tke_diff = tke_km1 - tke(k); + + const auto f0 = thedz2*ekat::cube(bet2)*((iso*iso)*(iso*iso))*wthl_sec_k*thl_sec_diff; + const auto f1 = thedz2*ekat::square(bet2)*ekat::cube(iso)*(wthl_sec_k*wthl_sec_diff+sp(0.5)*w_sec_zi(k)*thl_sec_diff); + const auto f2 = thedz*bet2*isosqrd*wthl_sec_k*wsec_diff+2*thedz2*bet2*isosqrd*w_sec_zi(k)*wthl_sec_diff; + const auto f3 = thedz2*bet2*isosqrd*w_sec_zi(k)*wthl_sec_diff+thedz*bet2*isosqrd*(wthl_sec_k*tke_diff); + const auto f4 = thedz*iso*w_sec_zi(k)*(wsec_diff+tke_diff); + const auto f5 = thedz*iso*w_sec_zi(k)*wsec_diff; + + // Compute omega terms + const auto omega0 = a4/Spack(1-a5*buoy_sgs2); + const auto omega1 = omega0/(2*c_diag_3rd_mom); + const auto omega2 = omega1*f3+sp(5.0/4.0)*omega0*f4; + + // Compute the x0, y0, x1, y1 terms + const auto x0 = (a2*buoy_sgs2*(Spack(1)-a3*buoy_sgs2))/(Spack(1)-(a1+a3)*buoy_sgs2); + const auto y0 = (2*a2*buoy_sgs2*x0)/(Spack(1)-a3*buoy_sgs2); + const auto x1 = (a0*f0+a1*f1+a2*(Spack(1)-a3*buoy_sgs2)*f2)/(Spack(1)-(a1+a3)*buoy_sgs2); + const auto y1 = (2*a2*(buoy_sgs2*x1+(a0/a1)*f0+f1))/(Spack(1)-a3*buoy_sgs2); + + // Compute the aa0, aa1 terms + const auto aa0 = omega0*x0+omega1*y0; + const auto aa1 = omega0*x1+omega1*y1+omega2; + + // Finally, compute the third moment of w + w3(k).set(active_range, (aa1-sp(1.2)*x1-sp(1.5)*f5)/(Spack(c_diag_3rd_mom)-sp(1.2)*x0+aa0)); + + } } }); diff --git a/components/eamxx/src/physics/shoc/impl/shoc_compute_shoc_mix_shoc_length_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_compute_shoc_mix_shoc_length_impl.hpp index 76ced9f901b8..be6ae75b50a8 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_compute_shoc_mix_shoc_length_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_compute_shoc_mix_shoc_length_impl.hpp @@ -13,16 +13,19 @@ ::compute_shoc_mix_shoc_length( const MemberType& team, const Int& nlev, const Scalar& length_fac, + const bool& shoc_1p5tke, const uview_1d& tke, const uview_1d& brunt, const uview_1d& zt_grid, + const uview_1d& dz_zt, + const uview_1d& tk, const Scalar& l_inf, const uview_1d& shoc_mix) { const Int nlev_pack = ekat::npack(nlev); const auto maxlen = scream::shoc::Constants::maxlen; const auto vk = C::Karman; - + // Eddy turnover timescale const Scalar tscale = 400; @@ -30,10 +33,31 @@ ::compute_shoc_mix_shoc_length( const Spack tkes = ekat::sqrt(tke(k)); const Spack brunt2 = ekat::max(0, brunt(k)); - shoc_mix(k) = ekat::min(maxlen, - sp(2.8284)*(ekat::sqrt(1/((1/(tscale*tkes*vk*zt_grid(k))) - + (1/(tscale*tkes*l_inf)) - + sp(0.01)*(brunt2/tke(k)))))/length_fac); + if (shoc_1p5tke){ + // If 1.5 TKE closure then set length scale to vertical grid spacing for + // cells with unstable brunt vaisalla frequency. Otherwise, overwrite the length + // scale in stable cells with the new definition. + + // Search for stable cells + const auto stable_mask = brunt(k) > 0; + + // To avoid FPE when calculating sqrt(brunt), set brunt_tmp=0 in the case brunt<1. + Spack brunt_tmp(stable_mask, brunt(k)); + + // Define length scale for stable cells + const auto length_tmp = ekat::sqrt(0.76*tk(k)/0.1/ekat::sqrt(brunt_tmp + 1.e-10)); + // Limit the stability corrected length scale between 0.1*dz and dz + const auto limited_len = ekat::min(dz_zt(k),ekat::max(0.1*dz_zt(k),length_tmp)); + + // Set length scale to vertical grid if unstable, otherwise the stability adjusted value. + shoc_mix(k).set(stable_mask, limited_len, dz_zt(k)); + } else{ + shoc_mix(k) = ekat::min(maxlen, + sp(2.8284)*(ekat::sqrt(1/((1/(tscale*tkes*vk*zt_grid(k))) + + (1/(tscale*tkes*l_inf)) + + sp(0.01)*(brunt2/tke(k)))))/length_fac); + + } }); } diff --git a/components/eamxx/src/physics/shoc/impl/shoc_diag_second_moments_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_diag_second_moments_impl.hpp index 660f5dfc2331..bc3e829b2824 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_diag_second_moments_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_diag_second_moments_impl.hpp @@ -15,7 +15,7 @@ template KOKKOS_FUNCTION void Functions::diag_second_moments( const MemberType& team, const Int& nlev, const Int& nlevi, - const Real& thl2tune, const Real& qw2tune, const Real& qwthl2tune, const Real& w2tune, + const Real& thl2tune, const Real& qw2tune, const Real& qwthl2tune, const Real& w2tune, const bool& shoc_1p5tke, const uview_1d& thetal, const uview_1d& qw, const uview_1d& u_wind, const uview_1d& v_wind, const uview_1d& tke, const uview_1d& isotropy, const uview_1d& tkh, const uview_1d& tk, const uview_1d& dz_zi, @@ -38,20 +38,34 @@ void Functions::diag_second_moments( linear_interp(team, zt_grid, zi_grid, tk, tk_zi, nlev, nlevi, 0); team.team_barrier(); - // Vertical velocity variance is assumed to be propotional to the TKE + // Vertical velocity variance is assumed to be propotional to the TKE. + // If 1.5 TKE closure is activated then set to zero. const Int nlev_pack = ekat::npack(nlev); Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_pack), [&] (const Int& k) { - w_sec(k) = w2tune*(sp(2.)/sp(3.))*tke(k); + w_sec(k) = shoc_1p5tke ? 0 : w2tune*(sp(2.)/sp(3.))*tke(k); }); - // Calculate the temperature variance - calc_shoc_varorcovar(team, nlev, thl2tune, isotropy_zi, tkh_zi, dz_zi, thetal, thetal, thl_sec); - - // Calculate the moisture variance - calc_shoc_varorcovar(team, nlev ,qw2tune, isotropy_zi, tkh_zi, dz_zi, qw, qw, qw_sec); - - // Calculate the temperature and moisture covariance - calc_shoc_varorcovar(team, nlev, qwthl2tune, isotropy_zi, tkh_zi, dz_zi, thetal, qw, qwthl_sec); + // For the following variances and covariance, if no SGS variability is desired then + // set these to zero. Doing so, in conjuction with setting w3 and w2 (above) to zero + // will ensure that SHOC condensation reduces to an all-or-nothing scheme. + if (shoc_1p5tke){ + const Int nlevi_pack = ekat::npack(nlevi); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlevi_pack), [&] (const Int& k) { + thl_sec(k) = 0; + qw_sec(k) = 0; + qwthl_sec(k) = 0; + }); + } + else{ + // Calculate the temperature variance + calc_shoc_varorcovar(team, nlev, thl2tune, isotropy_zi, tkh_zi, dz_zi, thetal, thetal, thl_sec); + + // Calculate the moisture variance + calc_shoc_varorcovar(team, nlev ,qw2tune, isotropy_zi, tkh_zi, dz_zi, qw, qw, qw_sec); + + // Calculate the temperature and moisture covariance + calc_shoc_varorcovar(team, nlev, qwthl2tune, isotropy_zi, tkh_zi, dz_zi, thetal, qw, qwthl_sec); + } // Calculate vertical flux for heat calc_shoc_vertflux(team, nlev, tkh_zi, dz_zi, thetal, wthl_sec); @@ -67,6 +81,7 @@ void Functions::diag_second_moments( // Calculate vertical flux for momentum (meridional wind) calc_shoc_vertflux(team, nlev, tk_zi, dz_zi, v_wind, vw_sec); + } } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/impl/shoc_diag_second_shoc_moments_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_diag_second_shoc_moments_impl.hpp index 393564b238ea..915a5e4051c1 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_diag_second_shoc_moments_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_diag_second_shoc_moments_impl.hpp @@ -14,7 +14,7 @@ namespace shoc { template KOKKOS_FUNCTION void Functions::diag_second_shoc_moments(const MemberType& team, const Int& nlev, const Int& nlevi, - const Scalar& thl2tune, const Scalar& qw2tune, const Scalar& qwthl2tune, const Scalar& w2tune, + const Scalar& thl2tune, const Scalar& qw2tune, const Scalar& qwthl2tune, const Scalar& w2tune, const bool& shoc_1p5tke, const uview_1d& thetal, const uview_1d& qw, const uview_1d& u_wind, const uview_1d& v_wind, const uview_1d& tke, const uview_1d& isotropy, const uview_1d& tkh, const uview_1d& tk, const uview_1d& dz_zi, @@ -59,7 +59,7 @@ void Functions::diag_second_shoc_moments(const MemberType& team, const Int& // Diagnose the second order moments, for points away from boundaries. this is // the main computation for the second moments diag_second_moments(team, nlev, nlevi, - thl2tune, qw2tune, qwthl2tune, w2tune, + thl2tune, qw2tune, qwthl2tune, w2tune, shoc_1p5tke, thetal, qw, u_wind,v_wind, tke, isotropy,tkh, tk, dz_zi, zt_grid, zi_grid, shoc_mix, isotropy_zi, tkh_zi, tk_zi, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec); diff --git a/components/eamxx/src/physics/shoc/impl/shoc_diag_third_shoc_moments_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_diag_third_shoc_moments_impl.hpp index ecdee4f64661..7ecd1a0e2cdc 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_diag_third_shoc_moments_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_diag_third_shoc_moments_impl.hpp @@ -18,6 +18,7 @@ void Functions::diag_third_shoc_moments( const Int& nlev, const Int& nlevi, const Scalar& c_diag_3rd_mom, + const bool& shoc_1p5tke, const uview_1d& w_sec, const uview_1d& thl_sec, const uview_1d& wthl_sec, @@ -50,7 +51,7 @@ void Functions::diag_third_shoc_moments( team.team_barrier(); // Diagnose the third moment of the vertical-velocity - compute_diag_third_shoc_moment(team,nlev,nlevi,c_diag_3rd_mom,w_sec,thl_sec,wthl_sec, + compute_diag_third_shoc_moment(team,nlev,nlevi,c_diag_3rd_mom,shoc_1p5tke,w_sec,thl_sec,wthl_sec, tke, dz_zt, dz_zi,isotropy_zi, brunt_zi, w_sec_zi,thetal_zi,w3); team.team_barrier(); diff --git a/components/eamxx/src/physics/shoc/impl/shoc_eddy_diffusivities_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_eddy_diffusivities_impl.hpp index 80244c22c234..30059217895d 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_eddy_diffusivities_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_eddy_diffusivities_impl.hpp @@ -16,6 +16,7 @@ KOKKOS_FUNCTION void Functions::eddy_diffusivities( const MemberType& team, const Int& nlev, + const bool& shoc_1p5tke, const Scalar& Ckh, const Scalar& Ckm, const Scalar& pblh, @@ -50,9 +51,16 @@ void Functions::eddy_diffusivities( tkh(k).set(condition, Ckh_s*ekat::square(shoc_mix(k))*ekat::sqrt(sterm_zt(k))); tk(k).set(condition, Ckm_s*ekat::square(shoc_mix(k))*ekat::sqrt(sterm_zt(k))); - // Default definition of eddy diffusivity for heat and momentum - tkh(k).set(!condition, Ckh*isotropy(k)*tke(k)); - tk(k).set(!condition, Ckm*isotropy(k)*tke(k)); + if (shoc_1p5tke){ + // Revert to a standard 1.5 TKE closure for eddy diffusivities + tkh(k).set(!condition, Ckh*shoc_mix(k)*ekat::sqrt(tke(k))); + tk(k).set(!condition, Ckm*shoc_mix(k)*ekat::sqrt(tke(k))); + } + else{ + // Default SHOC definition of eddy diffusivity for heat and momentum + tkh(k).set(!condition, Ckh*isotropy(k)*tke(k)); + tk(k).set(!condition, Ckm*isotropy(k)*tke(k)); + } }); } diff --git a/components/eamxx/src/physics/shoc/impl/shoc_length_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_length_impl.hpp index e52554383fe7..38b5e8fe9c94 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_length_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_length_impl.hpp @@ -14,6 +14,7 @@ ::shoc_length( const Int& nlev, const Int& nlevi, const Scalar& length_fac, + const bool& shoc_1p5tke, const Scalar& dx, const Scalar& dy, const uview_1d& zt_grid, @@ -21,6 +22,7 @@ ::shoc_length( const uview_1d& dz_zt, const uview_1d& tke, const uview_1d& thv, + const uview_1d& tk, const Workspace& workspace, const uview_1d& brunt, const uview_1d& shoc_mix) @@ -37,7 +39,7 @@ ::shoc_length( Scalar l_inf = 0; compute_l_inf_shoc_length(team,nlev,zt_grid,dz_zt,tke,l_inf); - compute_shoc_mix_shoc_length(team,nlev,length_fac, tke,brunt,zt_grid,l_inf,shoc_mix); + compute_shoc_mix_shoc_length(team,nlev,length_fac,shoc_1p5tke,tke,brunt,zt_grid,dz_zt,tk,l_inf,shoc_mix); team.team_barrier(); check_length_scale_shoc_length(team,nlev,dx,dy,shoc_mix); diff --git a/components/eamxx/src/physics/shoc/impl/shoc_main_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_main_impl.hpp index 5815efaca203..c00ac82fded6 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_main_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_main_impl.hpp @@ -85,6 +85,8 @@ void Functions::shoc_main_internal( const Scalar& c_diag_3rd_mom, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, + const bool& extra_diags, // Input Variables const Scalar& dx, const Scalar& dy, @@ -123,6 +125,8 @@ void Functions::shoc_main_internal( const uview_1d& shoc_ql2, const uview_1d& tkh, // Diagnostic Output Variables + const uview_1d& shoc_cond, + const uview_1d& shoc_evap, const uview_1d& shoc_mix, const uview_1d& w_sec, const uview_1d& thl_sec, @@ -206,24 +210,24 @@ void Functions::shoc_main_internal( // Update the turbulent length scale shoc_length(team,nlev,nlevi, // Input - length_fac, // Runtime Options + length_fac,shoc_1p5tke,// Runtime Options dx,dy, // Input zt_grid,zi_grid,dz_zt, // Input - tke,thv, // Input + tke,thv,tk, // Input workspace, // Workspace brunt,shoc_mix); // Output // Advance the SGS TKE equation - shoc_tke(team,nlev,nlevi,dtime, // Input + shoc_tke(team,nlev,nlevi,dtime, // Input lambda_low,lambda_high,lambda_slope, // Runtime options - lambda_thresh,Ckh,Ckm, // Runtime options - wthv_sec, // Input - shoc_mix,dz_zi,dz_zt,pres,shoc_tabs,// Input - u_wind,v_wind,brunt,zt_grid, // Input - zi_grid,pblh, // Input - workspace, // Workspace - tke,tk,tkh, // Input/Output - isotropy); // Output + lambda_thresh,Ckh,Ckm,shoc_1p5tke, // Runtime options + wthv_sec, // Input + shoc_mix,dz_zi,dz_zt,pres,shoc_tabs, // Input + u_wind,v_wind,brunt,zt_grid, // Input + zi_grid,pblh, // Input + workspace, // Workspace + tke,tk,tkh, // Input/Output + isotropy); // Output // Update SHOC prognostic variables here // via implicit diffusion solver @@ -237,6 +241,7 @@ void Functions::shoc_main_internal( // Diagnose the second order moments diag_second_shoc_moments(team,nlev,nlevi, thl2tune, qw2tune, qwthl2tune, w2tune, // Runtime options + shoc_1p5tke, // Runtime options thetal,qw,u_wind,v_wind, // Input tke,isotropy,tkh,tk,dz_zi,zt_grid,zi_grid, // Input shoc_mix,wthl_sfc,wqw_sfc,uw_sfc,vw_sfc, // Input @@ -248,7 +253,7 @@ void Functions::shoc_main_internal( // Diagnose the third moment of vertical velocity, // needed for the PDF closure diag_third_shoc_moments(team,nlev,nlevi, - c_diag_3rd_mom, // Runtime options + c_diag_3rd_mom,shoc_1p5tke, // Runtime options w_sec,thl_sec,wthl_sec, // Input isotropy,brunt,thetal,tke,dz_zt,dz_zi, // Input zt_grid,zi_grid, // Input @@ -258,9 +263,11 @@ void Functions::shoc_main_internal( // Call the PDF to close on SGS cloud and turbulence team.team_barrier(); shoc_assumed_pdf(team,nlev,nlevi,thetal,qw,w_field,thl_sec,qw_sec, // Input + dtime,extra_diags, // wthl_sec,w_sec,wqw_sec,qwthl_sec,w3,pres, // Input zt_grid, zi_grid, // Input workspace, // Workspace + shoc_cond,shoc_evap, // Output shoc_cldfrac,shoc_ql,wqls_sec,wthv_sec,shoc_ql2); // Ouptut // Check TKE to make sure values lie within acceptable @@ -340,6 +347,8 @@ void Functions::shoc_main_internal( const Scalar& c_diag_3rd_mom, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, + const bool& extra_diags, // Input Variables const view_1d& dx, const view_1d& dy, @@ -378,6 +387,8 @@ void Functions::shoc_main_internal( const view_2d& shoc_ql2, const view_2d& tkh, // Diagnostic Output Variables + const view_2d& shoc_cond, + const view_2d& shoc_evap, const view_2d& shoc_mix, const view_2d& w_sec, const view_2d& thl_sec, @@ -466,24 +477,24 @@ void Functions::shoc_main_internal( // Update the turbulent length scale shoc_length_disp(shcol,nlev,nlevi, // Input - length_fac, // Runtime Options + length_fac,shoc_1p5tke,// Runtime Options dx,dy, // Input zt_grid,zi_grid,dz_zt, // Input - tke,thv, // Input + tke,thv,tk, // Input workspace_mgr, // Workspace mgr brunt,shoc_mix); // Output // Advance the SGS TKE equation - shoc_tke_disp(shcol,nlev,nlevi,dtime, // Input - lambda_low,lambda_high,lambda_slope, // Runtime options - lambda_thresh,Ckh,Ckm, // Runtime options - wthv_sec, // Input - shoc_mix,dz_zi,dz_zt,pres,shoc_tabs,// Input - u_wind,v_wind,brunt,zt_grid, // Input - zi_grid,pblh, // Input - workspace_mgr, // Workspace mgr - tke,tk,tkh, // Input/Output - isotropy); // Output + shoc_tke_disp(shcol,nlev,nlevi,dtime, // Input + lambda_low,lambda_high,lambda_slope, // Runtime options + lambda_thresh,Ckh,Ckm,shoc_1p5tke, // Runtime options + wthv_sec, // Input + shoc_mix,dz_zi,dz_zt,pres,shoc_tabs, // Input + u_wind,v_wind,brunt,zt_grid, // Input + zi_grid,pblh, // Input + workspace_mgr, // Workspace mgr + tke,tk,tkh, // Input/Output + isotropy); // Output // Update SHOC prognostic variables here // via implicit diffusion solver @@ -496,6 +507,7 @@ void Functions::shoc_main_internal( // Diagnose the second order moments diag_second_shoc_moments_disp(shcol,nlev,nlevi, thl2tune, qw2tune, qwthl2tune, w2tune, // Runtime options + shoc_1p5tke, // Runtime options thetal,qw,u_wind,v_wind, // Input tke,isotropy,tkh,tk,dz_zi,zt_grid,zi_grid, // Input shoc_mix,wthl_sfc,wqw_sfc,uw_sfc,vw_sfc, // Input @@ -507,7 +519,7 @@ void Functions::shoc_main_internal( // Diagnose the third moment of vertical velocity, // needed for the PDF closure diag_third_shoc_moments_disp(shcol,nlev,nlevi, - c_diag_3rd_mom, // Runtime options + c_diag_3rd_mom,shoc_1p5tke, // Runtime options w_sec,thl_sec,wthl_sec, // Input isotropy,brunt,thetal,tke,dz_zt,dz_zi, // Input zt_grid,zi_grid, // Input @@ -516,9 +528,11 @@ void Functions::shoc_main_internal( // Call the PDF to close on SGS cloud and turbulence shoc_assumed_pdf_disp(shcol,nlev,nlevi,thetal,qw,w_field,thl_sec,qw_sec, // Input + dtime,extra_diags, // Runtime options wthl_sec,w_sec,wqw_sec,qwthl_sec,w3,pres, // Input zt_grid, zi_grid, // Input workspace_mgr, // Workspace mgr + shoc_cond,shoc_evap, // Output shoc_cldfrac,shoc_ql,wqls_sec,wthv_sec,shoc_ql2); // Ouptut // Check TKE to make sure values lie within acceptable @@ -607,6 +621,8 @@ Int Functions::shoc_main( const Scalar c_diag_3rd_mom = shoc_runtime.c_diag_3rd_mom; const Scalar Ckh = shoc_runtime.Ckh; const Scalar Ckm = shoc_runtime.Ckm; + const bool shoc_1p5tke = shoc_runtime.shoc_1p5tke; + const bool extra_diags = shoc_runtime.extra_diags; #ifndef SCREAM_SHOC_SMALL_KERNELS using ExeSpace = typename KT::ExeSpace; @@ -649,6 +665,8 @@ Int Functions::shoc_main( const auto shoc_ql_s = ekat::subview(shoc_input_output.shoc_ql, i); const auto shoc_ql2_s = ekat::subview(shoc_output.shoc_ql2, i); const auto tkh_s = ekat::subview(shoc_output.tkh, i); + const auto shoc_cond_s = ekat::subview(shoc_history_output.shoc_cond, i); + const auto shoc_evap_s = ekat::subview(shoc_history_output.shoc_evap, i); const auto shoc_mix_s = ekat::subview(shoc_history_output.shoc_mix, i); const auto w_sec_s = ekat::subview(shoc_history_output.w_sec, i); const auto thl_sec_s = ekat::subview(shoc_history_output.thl_sec, i); @@ -671,7 +689,7 @@ Int Functions::shoc_main( shoc_main_internal(team, nlev, nlevi, npbl, nadv, num_qtracers, dtime, lambda_low, lambda_high, lambda_slope, lambda_thresh, // Runtime options thl2tune, qw2tune, qwthl2tune, w2tune, length_fac, // Runtime options - c_diag_3rd_mom, Ckh, Ckm, // Runtime options + c_diag_3rd_mom, Ckh, Ckm, shoc_1p5tke, extra_diags, // Runtime options dx_s, dy_s, zt_grid_s, zi_grid_s, // Input pres_s, presi_s, pdel_s, thv_s, w_field_s, // Input wthl_sfc_s, wqw_sfc_s, uw_sfc_s, vw_sfc_s, // Input @@ -681,6 +699,7 @@ Int Functions::shoc_main( wthv_sec_s, qtracers_s, tk_s, shoc_cldfrac_s, // Input/Output shoc_ql_s, // Input/Output pblh_s, ustar_s, obklen_s, shoc_ql2_s, tkh_s, // Output + shoc_cond_s, shoc_evap_s, // Diagnostic Output Variables shoc_mix_s, w_sec_s, thl_sec_s, qw_sec_s, qwthl_sec_s, // Diagnostic Output Variables wthl_sec_s, wqw_sec_s, wtke_sec_s, uw_sec_s, vw_sec_s, // Diagnostic Output Variables w3_s, wqls_sec_s, brunt_s, isotropy_s); // Diagnostic Output Variables @@ -697,7 +716,7 @@ Int Functions::shoc_main( shoc_main_internal(shcol, nlev, nlevi, npbl, nadv, num_qtracers, dtime, lambda_low, lambda_high, lambda_slope, lambda_thresh, // Runtime options thl2tune, qw2tune, qwthl2tune, w2tune, length_fac, // Runtime options - c_diag_3rd_mom, Ckh, Ckm, // Runtime options + c_diag_3rd_mom, Ckh, Ckm, shoc_1p5tke, extra_diags, // Runtime options shoc_input.dx, shoc_input.dy, shoc_input.zt_grid, shoc_input.zi_grid, // Input shoc_input.pres, shoc_input.presi, shoc_input.pdel, shoc_input.thv, shoc_input.w_field, // Input shoc_input.wthl_sfc, shoc_input.wqw_sfc, shoc_input.uw_sfc, shoc_input.vw_sfc, // Input @@ -707,6 +726,7 @@ Int Functions::shoc_main( shoc_input_output.wthv_sec, shoc_input_output.qtracers, shoc_input_output.tk, shoc_input_output.shoc_cldfrac, // Input/Output shoc_input_output.shoc_ql, // Input/Output shoc_output.pblh, shoc_output.ustar, shoc_output.obklen, shoc_output.shoc_ql2, shoc_output.tkh, // Output + shoc_history_output.shoc_cond, shoc_history_output.shoc_evap, shoc_history_output.shoc_mix, shoc_history_output.w_sec, shoc_history_output.thl_sec, shoc_history_output.qw_sec, shoc_history_output.qwthl_sec, // Diagnostic Output Variables shoc_history_output.wthl_sec, shoc_history_output.wqw_sec, shoc_history_output.wtke_sec, shoc_history_output.uw_sec, shoc_history_output.vw_sec, // Diagnostic Output Variables shoc_history_output.w3, shoc_history_output.wqls_sec, shoc_history_output.brunt, shoc_history_output.isotropy, // Diagnostic Output Variables diff --git a/components/eamxx/src/physics/shoc/impl/shoc_tke_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_tke_impl.hpp index 1b87a08efa15..d9f65f4ca179 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_tke_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_tke_impl.hpp @@ -30,6 +30,7 @@ void Functions::shoc_tke( const Scalar& lambda_thresh, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, const uview_1d& wthv_sec, const uview_1d& shoc_mix, const uview_1d& dz_zi, @@ -67,13 +68,13 @@ void Functions::shoc_tke( linear_interp(team,zi_grid,zt_grid,sterm,sterm_zt,nlevi,nlev,0); // Advance sgs TKE - adv_sgs_tke(team,nlev,dtime,shoc_mix,wthv_sec,sterm_zt,tk,tke,a_diss); + adv_sgs_tke(team,nlev,dtime,shoc_1p5tke,shoc_mix,wthv_sec,sterm_zt,tk,brunt,tke,a_diss); // Compute isotropic time scale [s] isotropic_ts(team,nlev,lambda_low,lambda_high,lambda_slope,lambda_thresh,brunt_int,tke,a_diss,brunt,isotropy); // Compute eddy diffusivity for heat and momentum - eddy_diffusivities(team,nlev,Ckh,Ckm,pblh,zt_grid,tabs,shoc_mix,sterm_zt,isotropy,tke,tkh,tk); + eddy_diffusivities(team,nlev,shoc_1p5tke,Ckh,Ckm,pblh,zt_grid,tabs,shoc_mix,sterm_zt,isotropy,tke,tkh,tk); // Release temporary variables from the workspace workspace.template release_many_contiguous<3>( diff --git a/components/eamxx/src/physics/shoc/shoc_functions.hpp b/components/eamxx/src/physics/shoc/shoc_functions.hpp index 300d1569907f..77abf3ceaf23 100644 --- a/components/eamxx/src/physics/shoc/shoc_functions.hpp +++ b/components/eamxx/src/physics/shoc/shoc_functions.hpp @@ -93,6 +93,8 @@ struct Functions Scalar c_diag_3rd_mom; Scalar Ckh; Scalar Ckm; + bool shoc_1p5tke; + bool extra_diags; }; // This struct stores input views for shoc_main. @@ -209,6 +211,10 @@ struct Functions view_2d brunt; // return to isotropic timescale [s] view_2d isotropy; + // shoc condensation kg/kg/s + view_2d shoc_cond; + // shoc evaporation kg/kg/s + view_2d shoc_evap; }; #ifdef SCREAM_SHOC_SMALL_KERNELS @@ -298,6 +304,7 @@ struct Functions const Int& nlev, const Int& nlevi, const Scalar& c_diag_3rd_mom, + const bool& shoc_1p5tke, const uview_1d& w_sec, const uview_1d& thl_sec, const uview_1d& wthl_sec, @@ -321,9 +328,12 @@ struct Functions const MemberType& team, const Int& nlev, const Scalar& length_fac, + const bool& shoc_1p5tke, const uview_1d& tke, const uview_1d& brunt, const uview_1d& zt_grid, + const uview_1d& dz_zt, + const uview_1d& tk, const Scalar& l_inf, const uview_1d& shoc_mix); @@ -396,7 +406,7 @@ struct Functions KOKKOS_FUNCTION static void diag_second_moments(const MemberType& team, const Int& nlev, const Int& nlevi, - const Real& thl2tune, const Real& qw2tune, const Real& qwthl2tune, const Real& w2tune, + const Real& thl2tune, const Real& qw2tune, const Real& qwthl2tune, const Real& w2tune, const bool& shoc_1p5tke, const uview_1d& thetal, const uview_1d& qw, const uview_1d& u_wind, const uview_1d& v_wind, const uview_1d& tke, const uview_1d& isotropy, const uview_1d& tkh, const uview_1d& tk, const uview_1d& dz_zi, @@ -408,7 +418,7 @@ struct Functions KOKKOS_FUNCTION static void diag_second_shoc_moments(const MemberType& team, const Int& nlev, const Int& nlevi, - const Scalar& thl2tune, const Scalar& qw2tune, const Scalar& qwthl2tune, const Scalar& w2tune, + const Scalar& thl2tune, const Scalar& qw2tune, const Scalar& qwthl2tune, const Scalar& w2tune, const bool& shoc_1p5tke, const uview_1d& thetal, const uview_1d& qw, const uview_1d& u_wind, const uview_1d& v_wind, const uview_1d& tke, const uview_1d& isotropy, const uview_1d& tkh, const uview_1d& tk, const uview_1d& dz_zi, @@ -424,6 +434,7 @@ struct Functions const Scalar& qw2tune, const Scalar& qwthl2tune, const Scalar& w2tune, + const bool& shoc_1p5tke, const view_2d& thetal, const view_2d& qw, const view_2d& u_wind, @@ -520,6 +531,7 @@ struct Functions const Int& nlev, const Int& nlevi, const Scalar& length_fac, + const bool& shoc_1p5tke, const Scalar& dx, const Scalar& dy, const uview_1d& zt_grid, @@ -527,6 +539,7 @@ struct Functions const uview_1d& dz_zt, const uview_1d& tke, const uview_1d& thv, + const uview_1d& tk, const Workspace& workspace, const uview_1d& brunt, const uview_1d& shoc_mix); @@ -536,6 +549,7 @@ struct Functions const Int& nlev, const Int& nlevi, const Scalar& length_fac, + const bool& tke_1p5_closure, const view_1d& dx, const view_1d& dy, const view_2d& zt_grid, @@ -543,6 +557,7 @@ struct Functions const view_2d& dz_zt, const view_2d& tke, const view_2d& thv, + const view_2d& tk, const WorkspaceMgr& workspace_mgr, const view_2d& brunt, const view_2d& shoc_mix); @@ -692,6 +707,7 @@ struct Functions const Int& nlev, const Int& nlevi, const Scalar& c_diag_3rd_mom, + const bool& shoc_1p5tke, const uview_1d& w_sec, const uview_1d& thl_sec, const uview_1d& wthl_sec, @@ -711,6 +727,7 @@ struct Functions const Int& nlev, const Int& nlevi, const Scalar& c_diag_3rd_mom, + const bool& shoc_1p5tke, const view_2d& w_sec, const view_2d& thl_sec, const view_2d& wthl_sec, @@ -731,10 +748,12 @@ struct Functions const MemberType& team, const Int& nlev, const Real& dtime, + const bool& shoc_1p5tke, const uview_1d& shoc_mix, const uview_1d& wthv_sec, const uview_1d& sterm_zt, const uview_1d& tk, + const uview_1d& brunt, const uview_1d& tke, const uview_1d& a_diss); @@ -748,6 +767,8 @@ struct Functions const uview_1d& w_field, const uview_1d& thl_sec, const uview_1d& qw_sec, + const Scalar& dtime, + const bool& extra_diags, const uview_1d& wthl_sec, const uview_1d& w_sec, const uview_1d& wqw_sec, @@ -757,6 +778,8 @@ struct Functions const uview_1d& zt_grid, const uview_1d& zi_grid, const Workspace& workspace, + const uview_1d& shoc_cond, + const uview_1d& shoc_evap, const uview_1d& shoc_cldfrac, const uview_1d& shoc_ql, const uview_1d& wqls, @@ -772,6 +795,8 @@ struct Functions const view_2d& w_field, const view_2d& thl_sec, const view_2d& qw_sec, + const Scalar& dtime, + const bool& extra_diags, const view_2d& wthl_sec, const view_2d& w_sec, const view_2d& wqw_sec, @@ -781,6 +806,8 @@ struct Functions const view_2d& zt_grid, const view_2d& zi_grid, const WorkspaceMgr& workspace_mgr, + const view_2d& shoc_cond, + const view_2d& shoc_evap, const view_2d& shoc_cldfrac, const view_2d& shoc_ql, const view_2d& wqls, @@ -1014,6 +1041,8 @@ struct Functions const Scalar& c_diag_3rd_mom, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, + const bool& extra_diags, // Input Variables const Scalar& host_dx, const Scalar& host_dy, @@ -1052,6 +1081,8 @@ struct Functions const uview_1d& shoc_ql2, const uview_1d& tkh, // Diagnostic Output Variables + const uview_1d& shoc_cond, + const uview_1d& shoc_evap, const uview_1d& shoc_mix, const uview_1d& w_sec, const uview_1d& thl_sec, @@ -1088,6 +1119,8 @@ struct Functions const Scalar& c_diag_3rd_mom, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, + const bool& extra_diags, // Input Variables const view_1d& host_dx, const view_1d& host_dy, @@ -1126,6 +1159,8 @@ struct Functions const view_2d& shoc_ql2, const view_2d& tkh, // Diagnostic Output Variables + const view_2d& shoc_evap, + const view_2d& shoc_cond, const view_2d& shoc_mix, const view_2d& w_sec, const view_2d& thl_sec, @@ -1294,6 +1329,7 @@ struct Functions static void eddy_diffusivities( const MemberType& team, const Int& nlev, + const bool& shoc_1p5tke, const Scalar& Ckh, const Scalar& Ckm, const Scalar& pblh, @@ -1318,6 +1354,7 @@ struct Functions const Scalar& lambda_thresh, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, const uview_1d& wthv_sec, const uview_1d& shoc_mix, const uview_1d& dz_zi, @@ -1347,6 +1384,7 @@ struct Functions const Scalar& lambda_thresh, const Scalar& Ckh, const Scalar& Ckm, + const bool& shoc_1p5tke, const view_2d& wthv_sec, const view_2d& shoc_mix, const view_2d& dz_zi, diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index d7588ffe6cee..b0089997aa53 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -80,7 +80,7 @@ void check_tke(CheckTkeData& d) void shoc_tke(ShocTkeData& d) { - shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); + shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.shoc_1p5tke, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); } void compute_shr_prod(ComputeShrProdData& d) @@ -95,17 +95,17 @@ void isotropic_ts(IsotropicTsData& d) void adv_sgs_tke(AdvSgsTkeData& d) { - adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); + adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_1p5tke, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.brunt, d.tke, d.a_diss); } void eddy_diffusivities(EddyDiffusivitiesData& d) { - eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); + eddy_diffusivities_host(d.nlev, d.shcol, d.shoc_1p5tke, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); } void shoc_length(ShocLengthData& d) { - shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); + shoc_length_host(d.shcol, d.nlev, d.nlevi, d.shoc_1p5tke, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.tk, d.brunt, d.shoc_mix); } void compute_brunt_shoc_length(ComputeBruntShocLengthData& d) @@ -120,7 +120,7 @@ void compute_l_inf_shoc_length(ComputeLInfShocLengthData& d) void compute_shoc_mix_shoc_length(ComputeShocMixShocLengthData& d) { - compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); + compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.shoc_1p5tke, d.tke, d.brunt, d.zt_grid, d.dz_zt, d.tk, d.l_inf, d.shoc_mix); } void check_length_scale_shoc_length(CheckLengthScaleShocLengthData& d) @@ -145,12 +145,12 @@ void linear_interp(LinearInterpData& d) void diag_third_shoc_moments(DiagThirdShocMomentsData& d) { - diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); + diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.shoc_1p5tke, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); } void compute_diag_third_shoc_moment(ComputeDiagThirdShocMomentData& d) { - compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); + compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.shoc_1p5tke, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); } void shoc_assumed_pdf(ShocAssumedPdfData& d) @@ -240,14 +240,14 @@ void diag_second_moments_lbycond(DiagSecondMomentsLbycondData& d) void diag_second_moments(DiagSecondMomentsData& d) { - diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, + diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.shoc_1p5tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); } void diag_second_shoc_moments(DiagSecondShocMomentsData& d) { - diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, + diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.shoc_1p5tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); } @@ -541,7 +541,7 @@ void update_host_dse_host(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* ekat::device_to_host({host_dse}, shcol, nlev, inout_views); } -void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, +void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* tke, Real* dz_zt, Real* dz_zi, Real* isotropy_zi, Real* brunt_zi, Real* w_sec_zi, Real* thetal_zi, @@ -605,7 +605,7 @@ void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w // Hardcode runtime options for F90 testing const Real c_diag_3rd_mom = 7.0; - SHF::compute_diag_third_shoc_moment(team, nlev, nlevi, c_diag_3rd_mom, w_sec_s, thl_sec_s, + SHF::compute_diag_third_shoc_moment(team, nlev, nlevi, c_diag_3rd_mom, shoc_1p5tke, w_sec_s, thl_sec_s, wthl_sec_s, tke_s, dz_zt_s, dz_zi_s, isotropy_zi_s, brunt_zi_s, w_sec_zi_s, thetal_zi_s, w3_s); }); @@ -653,8 +653,8 @@ void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real *thl, Real* ql, Real* ekat::device_to_host({thv}, shcol, nlev, inout_views); } -void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* brunt, - Real* zt_grid, Real* l_inf, Real* shoc_mix) +void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, bool shoc_1p5tke, Real* tke, Real* brunt, + Real* zt_grid, Real* dz_zt, Real* tk, Real* l_inf, Real* shoc_mix) { using SHF = Functions; @@ -667,8 +667,8 @@ void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* bru using MemberType = typename SHF::MemberType; std::vector temp_1d_d(1); - std::vector temp_2d_d(4); - std::vector ptr_array = {tke, brunt, zt_grid, shoc_mix}; + std::vector temp_2d_d(6); + std::vector ptr_array = {tke, brunt, zt_grid, dz_zt, tk, shoc_mix}; // Sync to device ScreamDeepCopy::copy_to_device({l_inf}, shcol, temp_1d_d); @@ -681,7 +681,9 @@ void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* bru tke_d (temp_2d_d[0]), brunt_d (temp_2d_d[1]), zt_grid_d (temp_2d_d[2]), - shoc_mix_d (temp_2d_d[3]); + dz_zt_d (temp_2d_d[3]), + tk_d (temp_2d_d[4]), + shoc_mix_d (temp_2d_d[5]); const Int nk_pack = ekat::npack(nlev); const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(shcol, nk_pack); @@ -694,10 +696,12 @@ void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* bru const auto brunt_s = ekat::subview(brunt_d, i); const auto zt_grid_s = ekat::subview(zt_grid_d, i); const auto shoc_mix_s = ekat::subview(shoc_mix_d, i); + const auto dz_zt_s = ekat::subview(dz_zt_d, i); + const auto tk_s = ekat::subview(tk_d, i); const Real length_fac = 0.5; - SHF::compute_shoc_mix_shoc_length(team, nlev, length_fac, tke_s, brunt_s, zt_grid_s, l_inf_s, - shoc_mix_s); + SHF::compute_shoc_mix_shoc_length(team, nlev, length_fac, shoc_1p5tke, tke_s, brunt_s, zt_grid_s, + dz_zt_s, tk_s, l_inf_s, shoc_mix_s); }); // Sync back to host @@ -944,7 +948,7 @@ void diag_second_moments_lbycond_host(Int shcol, Real* wthl_sfc, Real* wqw_sfc, ScreamDeepCopy::copy_to_host({wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec}, shcol, host_views); } -void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, +void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec) @@ -1030,7 +1034,7 @@ void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real const auto tkh_zi_1d = ekat::subview(tkh_zi_2d, i); const auto tk_zi_1d = ekat::subview(tk_zi_2d, i); - SHOC::diag_second_moments(team, nlev, nlevi, thl2tune, qw2tune, qwthl2tune, w2tune, + SHOC::diag_second_moments(team, nlev, nlevi, thl2tune, qw2tune, qwthl2tune, w2tune, shoc_1p5tke, thetal_1d, qw_1d, u_wind_1d, v_wind_1d, tke_1d, isotropy_1d, tkh_1d, tk_1d, dz_zi_1d, zt_grid_1d, zi_grid_1d, shoc_mix_1d, isotropy_zi_1d, tkh_zi_1d, tk_zi_1d, thl_sec_1d, qw_sec_1d, wthl_sec_1d, wqw_sec_1d, @@ -1045,7 +1049,7 @@ void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_views); } -void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, +void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec) @@ -1150,7 +1154,7 @@ void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Scalar wstar_s = wstar_1d(i); SHOC::diag_second_shoc_moments(team, nlev, nlevi, - thl2tune, qw2tune, qwthl2tune, w2tune, + thl2tune, qw2tune, qwthl2tune, w2tune, shoc_1p5tke, thetal_1d, qw_1d, u_wind_1d, v_wind_1d, tke_1d, isotropy_1d, tkh_1d, tk_1d, dz_zi_1d, zt_grid_1d, zi_grid_1d, shoc_mix_1d, wthl_s, wqw_s, uw_s, vw_s, ustar2_s, wstar_s, workspace, thl_sec_1d, qw_sec_1d, wthl_sec_1d, wqw_sec_1d, qwthl_sec_1d, @@ -1390,9 +1394,9 @@ void shoc_pblintd_cldcheck_host(Int shcol, Int nlev, Int nlevi, Real* zi, Real* ScreamDeepCopy::copy_to_host({pblh}, shcol, inout_views); } -void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, +void shoc_length_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* host_dx, Real* host_dy, Real* zt_grid, Real* zi_grid, Real*dz_zt, Real* tke, - Real* thv, Real*brunt, Real* shoc_mix) + Real* thv, Real* tk, Real*brunt, Real* shoc_mix) { using SHF = Functions; @@ -1405,12 +1409,12 @@ void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_ using MemberType = typename SHF::MemberType; std::vector temp_1d_d(2); - std::vector temp_2d_d(7); - std::vector dim1_sizes(7, shcol); + std::vector temp_2d_d(8); + std::vector dim1_sizes(8, shcol); std::vector dim2_sizes = {nlev, nlevi, nlev, nlev, - nlev, nlev, nlev}; + nlev, nlev, nlev, nlev}; std::vector ptr_array = {zt_grid, zi_grid, dz_zt, tke, - thv, brunt, shoc_mix}; + thv, tk, brunt, shoc_mix}; // Sync to device ScreamDeepCopy::copy_to_device({host_dx, host_dy}, shcol, temp_1d_d); ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); @@ -1426,8 +1430,9 @@ void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_ dz_zt_d(temp_2d_d[2]), tke_d(temp_2d_d[3]), thv_d(temp_2d_d[4]), - brunt_d(temp_2d_d[5]), - shoc_mix_d(temp_2d_d[6]); + tk_d(temp_2d_d[5]), + brunt_d(temp_2d_d[6]), + shoc_mix_d(temp_2d_d[7]); const Int nlev_packs = ekat::npack(nlev); const Int nlevi_packs = ekat::npack(nlevi); @@ -1450,14 +1455,16 @@ void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_ const auto dz_zt_s = ekat::subview(dz_zt_d, i); const auto tke_s = ekat::subview(tke_d, i); const auto thv_s = ekat::subview(thv_d, i); + const auto tk_s = ekat::subview(tk_d, i); const auto brunt_s = ekat::subview(brunt_d, i); const auto shoc_mix_s = ekat::subview(shoc_mix_d, i); // Hardcode runtime option for F90 tests. const Scalar length_fac = 0.5; - SHF::shoc_length(team,nlev,nlevi,length_fac,host_dx_s,host_dy_s, + SHF::shoc_length(team,nlev,nlevi,length_fac,shoc_1p5tke, + host_dx_s,host_dy_s, zt_grid_s,zi_grid_s,dz_zt_s,tke_s, - thv_s,workspace,brunt_s,shoc_mix_s); + thv_s,tk_s,workspace,brunt_s,shoc_mix_s); }); // Sync back to host @@ -1733,7 +1740,7 @@ void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tr ekat::device_to_host({tracer}, shcol, nlev, num_tracer, inout_views); } -void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, +void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* isotropy, Real* brunt, Real* thetal, Real* tke, Real* dz_zt, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* w3) @@ -1800,7 +1807,7 @@ void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, R // Hardcode for F90 testing const Real c_diag_3rd_mom = 7.0; - SHF::diag_third_shoc_moments(team, nlev, nlevi, c_diag_3rd_mom, wsec_s, thl_sec_s, + SHF::diag_third_shoc_moments(team, nlev, nlevi, c_diag_3rd_mom, shoc_1p5tke, wsec_s, thl_sec_s, wthl_sec_s, isotropy_s, brunt_s, thetal_s, tke_s, dz_zt_s, dz_zi_s, zt_grid_s, zi_grid_s, workspace, @@ -1812,8 +1819,8 @@ void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, R ekat::device_to_host({w3}, shcol, nlevi, inout_views); } -void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, - Real* sterm_zt, Real* tk, Real* tke, Real* a_diss) +void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, bool shoc_1p5tke, Real* shoc_mix, Real* wthv_sec, + Real* sterm_zt, Real* tk, Real* brunt, Real* tke, Real* a_diss) { using SHF = Functions; @@ -1823,10 +1830,10 @@ void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wth using ExeSpace = typename KT::ExeSpace; using MemberType = typename SHF::MemberType; - static constexpr Int num_arrays = 6; + static constexpr Int num_arrays = 7; std::vector temp_d(num_arrays); - std::vector ptr_array = {shoc_mix, wthv_sec, sterm_zt, tk, tke, a_diss}; + std::vector ptr_array = {shoc_mix, wthv_sec, sterm_zt, tk, brunt, tke, a_diss}; // Sync to device ekat::host_to_device(ptr_array, shcol, nlev, temp_d); @@ -1837,6 +1844,7 @@ void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wth wthv_sec_d (temp_d[1]), sterm_zt_d (temp_d[2]), tk_d (temp_d[3]), + brunt_d (temp_d[4]), //output tke_d (temp_d[4]), //inout a_diss_d (temp_d[5]); //out @@ -1852,10 +1860,11 @@ void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wth const auto wthv_sec_s = ekat::subview(wthv_sec_d ,i); const auto sterm_zt_s = ekat::subview(sterm_zt_d ,i); const auto tk_s = ekat::subview(tk_d ,i); + const auto brunt_s = ekat::subview(brunt_d, i); const auto tke_s = ekat::subview(tke_d ,i); const auto a_diss_s = ekat::subview(a_diss_d ,i); - SHF::adv_sgs_tke(team, nlev, dtime, shoc_mix_s, wthv_sec_s, sterm_zt_s, tk_s, tke_s, a_diss_s); + SHF::adv_sgs_tke(team, nlev, dtime, shoc_1p5tke, shoc_mix_s, wthv_sec_s, sterm_zt_s, tk_s, brunt_s, tke_s, a_diss_s); }); // Sync back to host @@ -1939,10 +1948,19 @@ void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* q const auto wqls_s = ekat::subview(wqls_d, i); const auto wthv_sec_s = ekat::subview(wthv_sec_d, i); const auto shoc_ql2_s = ekat::subview(shoc_ql2_d, i); - - SHF::shoc_assumed_pdf(team, nlev, nlevi, thetal_s, qw_s, w_field_s, thl_sec_s, qw_sec_s, wthl_sec_s, w_sec_s, + // TODO: properly test additional diagnostics later + // TODO: since extra diags is false, shoc_cond and shoc_evap shouldn't be touched + const Real dtime = 1.0; + const bool extra_diags = false; + // TODO: HACK: just pretend they're the same as shoc_cld_s for now + const auto shoc_cond_s = shoc_cldfrac_s; + const auto shoc_evap_s = shoc_cldfrac_s; + + SHF::shoc_assumed_pdf(team, nlev, nlevi, thetal_s, qw_s, w_field_s, thl_sec_s, qw_sec_s, dtime, extra_diags, + wthl_sec_s, w_sec_s, wqw_sec_s, qwthl_sec_s, w3_s, pres_s, zt_grid_s, zi_grid_s, workspace, + shoc_cond_s, shoc_evap_s, shoc_cldfrac_s, shoc_ql_s, wqls_s, wthv_sec_s, shoc_ql2_s); }); @@ -2352,10 +2370,15 @@ Int shoc_main_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npb horiz_wind_d, wthv_sec_d, qtracers_cxx_d, tk_d, shoc_cldfrac_d, shoc_ql_d}; SHF::SHOCOutput shoc_output{pblh_d, ustar_d, obklen_d, shoc_ql2_d, tkh_d}; + // TODO: HACK: for now, pretend shoc_cond_d and shoc_evap_d are just isotropy_d + // TODO: this is ok for now as shoc_cond_d and shoc_evap_d aren't edited in testing + // TODO: because we are setting the extra_diags to false by default and above + auto shoc_cond_d = isotropy_d; + auto shoc_evap_d = isotropy_d; SHF::SHOCHistoryOutput shoc_history_output{shoc_mix_d, w_sec_d, thl_sec_d, qw_sec_d, qwthl_sec_d, wthl_sec_d, wqw_sec_d, wtke_sec_d, uw_sec_d, vw_sec_d, w3_d, wqls_sec_d, - brunt_d, isotropy_d}; + brunt_d, isotropy_d, shoc_cond_d, shoc_evap_d}; SHF::SHOCRuntime shoc_runtime_options{0.001,0.04,2.65,0.02,1.0,1.0,1.0,1.0,0.5,7.0,0.1,0.1}; const auto nlevi_packs = ekat::npack(nlevi); @@ -2631,7 +2654,7 @@ void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid ekat::device_to_host({dz_zt, dz_zi, rho_zt}, {shcol, shcol, shcol}, {nlev, nlevi, nlev}, inout_views); } -void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, +void eddy_diffusivities_host(Int nlev, Int shcol, bool shoc_1p5tke, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, Real* isotropy, Real* tke, Real* tkh, Real* tk) { using SHF = Functions; @@ -2688,7 +2711,8 @@ void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Rea // Hardcode runtime options for F90 testing const Real Ckh = 0.1; const Real Ckm = 0.1; - SHF::eddy_diffusivities(team, nlev, Ckh, Ckm, pblh_s, zt_grid_s, tabs_s, shoc_mix_s, sterm_zt_s, isotropy_s, tke_s, tkh_s, tk_s); + + SHF::eddy_diffusivities(team, nlev, shoc_1p5tke, Ckh, Ckm, pblh_s, zt_grid_s, tabs_s, shoc_mix_s, sterm_zt_s, isotropy_s, tke_s, tkh_s, tk_s); }); // Sync back to host @@ -2869,7 +2893,7 @@ void pblintd_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, R ScreamDeepCopy::copy_to_host({pblh}, shcol, out_views); } -void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, +void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, bool shoc_1p5tke, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, Real* tabs, Real* u_wind, Real* v_wind, Real* brunt, Real* zt_grid, Real* zi_grid, Real* pblh, Real* tke, Real* tk, Real* tkh, Real* isotropy) { @@ -2955,9 +2979,9 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R const Real lambda_thresh = 0.02; const Real Ckh = 0.1; const Real Ckm = 0.1; - + SHF::shoc_tke(team,nlev,nlevi,dtime,lambda_low,lambda_high,lambda_slope,lambda_thresh, - Ckh, Ckm, + Ckh, Ckm, shoc_1p5tke, wthv_sec_s,shoc_mix_s,dz_zi_s,dz_zt_s,pres_s, tabs_s,u_wind_s,v_wind_s,brunt_s,zt_grid_s,zi_grid_s,pblh_s, workspace, diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 9676dd287699..e0208fe1eeb9 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -226,6 +226,7 @@ struct ShocTkeData : public ShocTestGridDataBase { // Inputs Int shcol, nlev, nlevi; Real dtime; + bool shoc_1p5tke; Real *wthv_sec, *shoc_mix, *dz_zi, *dz_zt, *pres, *tabs, *u_wind, *v_wind, *brunt, *pblh; // Inputs/Outputs @@ -234,14 +235,14 @@ struct ShocTkeData : public ShocTestGridDataBase { // Outputs Real *isotropy; - ShocTkeData(Int shcol_, Int nlev_, Int nlevi_, Real dtime_) : + ShocTkeData(Int shcol_, Int nlev_, Int nlevi_, Real dtime_, bool shoc_1p5tke_) : ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }, { shcol_ }}, {{ &wthv_sec, &shoc_mix, &dz_zt, &pres, &tabs, &u_wind, &v_wind, &brunt, &zt_grid, &tke, &tk, &tkh, &isotropy }, { &dz_zi, &zi_grid }, { &pblh }}), - shcol(shcol_), nlev(nlev_), nlevi(nlevi_), dtime(dtime_) {} + shcol(shcol_), nlev(nlev_), nlevi(nlevi_), dtime(dtime_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(ShocTkeData, 4, shcol, nlev, nlevi, dtime); + PTD_STD_DEF(ShocTkeData, 5, shcol, nlev, nlevi, dtime, shoc_1p5tke); }; struct ComputeShrProdData : public PhysicsTestData { @@ -276,7 +277,8 @@ struct AdvSgsTkeData : public PhysicsTestData { // Inputs Int shcol, nlev; Real dtime; - Real *shoc_mix, *wthv_sec, *sterm_zt, *tk; + bool shoc_1p5tke; + Real *shoc_mix, *wthv_sec, *sterm_zt, *tk, *brunt; // Inputs/Outputs Real *tke; @@ -284,38 +286,40 @@ struct AdvSgsTkeData : public PhysicsTestData { // Outputs Real *a_diss; - AdvSgsTkeData(Int shcol_, Int nlev_, Real dtime_) : - PhysicsTestData({{ shcol_, nlev_ }}, {{ &shoc_mix, &wthv_sec, &sterm_zt, &tk, &tke, &a_diss }}), shcol(shcol_), nlev(nlev_), dtime(dtime_) {} + AdvSgsTkeData(Int shcol_, Int nlev_, Real dtime_, bool shoc_1p5tke_) : + PhysicsTestData({{ shcol_, nlev_ }}, {{ &shoc_mix, &wthv_sec, &sterm_zt, &tk, & brunt, &tke, &a_diss }}), shcol(shcol_), nlev(nlev_), dtime(dtime_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(AdvSgsTkeData, 3, shcol, nlev, dtime); + PTD_STD_DEF(AdvSgsTkeData, 4, shcol, nlev, dtime, shoc_1p5tke); }; struct EddyDiffusivitiesData : public PhysicsTestData { // Inputs Int shcol, nlev; + bool shoc_1p5tke; Real *pblh, *zt_grid, *tabs, *shoc_mix, *sterm_zt, *isotropy, *tke; // Outputs Real *tkh, *tk; - EddyDiffusivitiesData(Int shcol_, Int nlev_) : - PhysicsTestData({{ shcol_ }, { shcol_, nlev_ }}, {{ &pblh }, { &zt_grid, &tabs, &shoc_mix, &sterm_zt, &isotropy, &tke, &tkh, &tk }}), shcol(shcol_), nlev(nlev_) {} + EddyDiffusivitiesData(Int shcol_, Int nlev_, bool shoc_1p5tke_) : + PhysicsTestData({{ shcol_ }, { shcol_, nlev_ }}, {{ &pblh }, { &zt_grid, &tabs, &shoc_mix, &sterm_zt, &isotropy, &tke, &tkh, &tk }}), shcol(shcol_), nlev(nlev_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(EddyDiffusivitiesData, 2, shcol, nlev); + PTD_STD_DEF(EddyDiffusivitiesData, 3, shcol, nlev, shoc_1p5tke); }; struct ShocLengthData : public ShocTestGridDataBase { // Inputs Int shcol, nlev, nlevi; - Real *host_dx, *host_dy, *tke, *dz_zt, *thv; + bool shoc_1p5tke; + Real *host_dx, *host_dy, *tke, *dz_zt, *thv, *tk; // Outputs Real *brunt, *shoc_mix; - ShocLengthData(Int shcol_, Int nlev_, Int nlevi_) : - ShocTestGridDataBase({{ shcol_ }, { shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &host_dx, &host_dy }, { &zt_grid, &dz_zt, &tke, &thv, &brunt, &shoc_mix }, { &zi_grid }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_) {} + ShocLengthData(Int shcol_, Int nlev_, Int nlevi_, bool shoc_1p5tke_) : + ShocTestGridDataBase({{ shcol_ }, { shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &host_dx, &host_dy }, { &zt_grid, &dz_zt, &tke, &thv, &tk, &brunt, &shoc_mix }, { &zi_grid }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(ShocLengthData, 3, shcol, nlev, nlevi); + PTD_STD_DEF(ShocLengthData, 4, shcol, nlev, nlevi, shoc_1p5tke); }; struct ComputeBruntShocLengthData : public PhysicsTestData { @@ -363,15 +367,16 @@ struct ComputeConvTimeShocLengthData : public PhysicsTestData { struct ComputeShocMixShocLengthData : public PhysicsTestData { // Inputs Int shcol, nlev; - Real *tke, *brunt, *tscale, *zt_grid, *l_inf; + bool shoc_1p5tke; + Real *tke, *brunt, *zt_grid, *dz_zt, *tk, *l_inf; // Outputs Real *shoc_mix; - ComputeShocMixShocLengthData(Int shcol_, Int nlev_) : - PhysicsTestData({{ shcol_, nlev_ }, { shcol_ }}, {{ &tke, &brunt, &zt_grid, &shoc_mix }, { &tscale, &l_inf }}), shcol(shcol_), nlev(nlev_) {} + ComputeShocMixShocLengthData(Int shcol_, Int nlev_, bool shoc_1p5tke_) : + PhysicsTestData({{ shcol_, nlev_ }, { shcol_ }}, {{ &tke, &brunt, &zt_grid, &dz_zt, &tk, &shoc_mix }, { &l_inf }}), shcol(shcol_), nlev(nlev_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(ComputeShocMixShocLengthData, 2, shcol, nlev); + PTD_STD_DEF(ComputeShocMixShocLengthData, 3, shcol, nlev, shoc_1p5tke); }; struct CheckLengthScaleShocLengthData : public PhysicsTestData { @@ -434,29 +439,31 @@ struct LinearInterpData : public PhysicsTestData { struct DiagThirdShocMomentsData : public ShocTestGridDataBase { // Inputs Int shcol, nlev, nlevi; + bool shoc_1p5tke; Real *w_sec, *thl_sec, *wthl_sec, *isotropy, *brunt, *thetal, *tke, *dz_zt, *dz_zi; // Outputs Real *w3; - DiagThirdShocMomentsData(Int shcol_, Int nlev_, Int nlevi_) : - ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &w_sec, &isotropy, &brunt, &thetal, &tke, &dz_zt, &zt_grid }, { &thl_sec, &wthl_sec, &dz_zi, &zi_grid, &w3 }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_) {} + DiagThirdShocMomentsData(Int shcol_, Int nlev_, Int nlevi_, bool shoc_1p5tke_) : + ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &w_sec, &isotropy, &brunt, &thetal, &tke, &dz_zt, &zt_grid }, { &thl_sec, &wthl_sec, &dz_zi, &zi_grid, &w3 }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(DiagThirdShocMomentsData, 3, shcol, nlev, nlevi); + PTD_STD_DEF(DiagThirdShocMomentsData, 4, shcol, nlev, nlevi, shoc_1p5tke); }; struct ComputeDiagThirdShocMomentData : public PhysicsTestData { // Inputs Int shcol, nlev, nlevi; + bool shoc_1p5tke; Real *w_sec, *thl_sec, *wthl_sec, *tke, *dz_zt, *dz_zi, *isotropy_zi, *brunt_zi, *w_sec_zi, *thetal_zi; // Outputs Real *w3; - ComputeDiagThirdShocMomentData(Int shcol_, Int nlev_, Int nlevi_) : - PhysicsTestData({{ shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &w_sec, &tke, &dz_zt }, { &thl_sec, &wthl_sec, &dz_zi, &isotropy_zi, &brunt_zi, &w_sec_zi, &thetal_zi, &w3 }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_) {} + ComputeDiagThirdShocMomentData(Int shcol_, Int nlev_, Int nlevi_, bool shoc_1p5tke_) : + PhysicsTestData({{ shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &w_sec, &tke, &dz_zt }, { &thl_sec, &wthl_sec, &dz_zi, &isotropy_zi, &brunt_zi, &w_sec_zi, &thetal_zi, &w3 }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(ComputeDiagThirdShocMomentData, 3, shcol, nlev, nlevi); + PTD_STD_DEF(ComputeDiagThirdShocMomentData, 4, shcol, nlev, nlevi, shoc_1p5tke); }; struct ShocAssumedPdfData : public ShocTestGridDataBase { @@ -627,6 +634,7 @@ struct DiagSecondMomentsLbycondData : public PhysicsTestData { struct DiagSecondMomentsData : public ShocTestGridDataBase { // Inputs Int shcol, nlev, nlevi; + bool shoc_1p5tke; Real *thetal, *qw, *u_wind, *v_wind, *tke, *isotropy, *tkh, *tk, *dz_zi, *shoc_mix; // Inputs/Outputs @@ -635,24 +643,25 @@ struct DiagSecondMomentsData : public ShocTestGridDataBase { // Outputs Real *w_sec; - DiagSecondMomentsData(Int shcol_, Int nlev_, Int nlevi_) : - ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &thetal, &qw, &u_wind, &v_wind, &tke, &isotropy, &tkh, &tk, &zt_grid, &shoc_mix, &w_sec }, { &dz_zi, &zi_grid, &thl_sec, &qw_sec, &wthl_sec, &wqw_sec, &qwthl_sec, &uw_sec, &vw_sec, &wtke_sec }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_) {} + DiagSecondMomentsData(Int shcol_, Int nlev_, Int nlevi_, bool shoc_1p5tke_) : + ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }}, {{ &thetal, &qw, &u_wind, &v_wind, &tke, &isotropy, &tkh, &tk, &zt_grid, &shoc_mix, &w_sec }, { &dz_zi, &zi_grid, &thl_sec, &qw_sec, &wthl_sec, &wqw_sec, &qwthl_sec, &uw_sec, &vw_sec, &wtke_sec }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(DiagSecondMomentsData, 3, shcol, nlev, nlevi); + PTD_STD_DEF(DiagSecondMomentsData, 4, shcol, nlev, nlevi, shoc_1p5tke); }; struct DiagSecondShocMomentsData : public ShocTestGridDataBase { // Inputs Int shcol, nlev, nlevi; + bool shoc_1p5tke; Real *thetal, *qw, *u_wind, *v_wind, *tke, *isotropy, *tkh, *tk, *dz_zi, *shoc_mix, *wthl_sfc, *wqw_sfc, *uw_sfc, *vw_sfc; // Outputs Real *thl_sec, *qw_sec, *wthl_sec, *wqw_sec, *qwthl_sec, *uw_sec, *vw_sec, *wtke_sec, *w_sec; - DiagSecondShocMomentsData(Int shcol_, Int nlev_, Int nlevi_) : - ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }, { shcol_ }}, {{ &thetal, &qw, &u_wind, &v_wind, &tke, &isotropy, &tkh, &tk, &zt_grid, &shoc_mix, &w_sec }, { &dz_zi, &zi_grid, &thl_sec, &qw_sec, &wthl_sec, &wqw_sec, &qwthl_sec, &uw_sec, &vw_sec, &wtke_sec }, { &wthl_sfc, &wqw_sfc, &uw_sfc, &vw_sfc }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_) {} + DiagSecondShocMomentsData(Int shcol_, Int nlev_, Int nlevi_, bool shoc_1p5tke_) : + ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }, { shcol_ }}, {{ &thetal, &qw, &u_wind, &v_wind, &tke, &isotropy, &tkh, &tk, &zt_grid, &shoc_mix, &w_sec }, { &dz_zi, &zi_grid, &thl_sec, &qw_sec, &wthl_sec, &wqw_sec, &qwthl_sec, &uw_sec, &vw_sec, &wtke_sec }, { &wthl_sfc, &wqw_sfc, &uw_sfc, &vw_sfc }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), shoc_1p5tke(shoc_1p5tke_) {} - PTD_STD_DEF(DiagSecondShocMomentsData, 3, shcol, nlev, nlevi); + PTD_STD_DEF(DiagSecondShocMomentsData, 4, shcol, nlev, nlevi, shoc_1p5tke); }; struct ComputeShocVaporData : public PhysicsTestData { @@ -1001,14 +1010,14 @@ void shoc_diag_second_moments_ubycond_host(Int shcol, Real* thl, Real* qw, Real* Real* wqw, Real* qwthl, Real* uw, Real* vw, Real* wtke); void update_host_dse_host(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* inv_exner, Real* zt_grid, Real* phis, Real* host_dse); -void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, +void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* tke, Real* dz_zt, Real* dz_zi, Real* isotropy_zi, Real* brunt_zi, Real* w_sec_zi, Real* thetal_zi, Real* w3); void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real* thl, Real* ql, Real* q, Real* thv); -void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* brunt, - Real* zt_grid, Real* l_inf, Real* shoc_mix); +void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, bool shoc_1p5tke, Real* tke, Real* brunt, + Real* zt_grid, Real* dz_zt, Real* tk, Real* l_inf, Real* shoc_mix); void check_tke_host(Int shcol, Int nlev, Real* tke); void linear_interp_host(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh); void clipping_diag_third_shoc_moments_host(Int nlevi, Int shcol, Real *w_sec_zi, @@ -1025,10 +1034,10 @@ void check_length_scale_shoc_length_host(Int nlev, Int shcol, Real* host_dx, Rea void diag_second_moments_lbycond_host(Int shcol, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar, Real* wthl_sec, Real* wqw_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* thl_sec, Real* qw_sec, Real* qwthl_sec); -void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, +void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec); -void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, +void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec); @@ -1036,9 +1045,9 @@ void shoc_diag_obklen_host(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc Real* thl_sfc, Real* cldliq_sfc, Real* qv_sfc, Real* ustar, Real* kbfs, Real* obklen); void shoc_pblintd_cldcheck_host(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cldn, Real* pblh); void compute_shr_prod_host(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_wind, Real* v_wind, Real* sterm); -void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, +void shoc_length_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* host_dx, Real* host_dy, Real* zt_grid, Real* zi_grid, Real*dz_zt, Real* tke, - Real* thv, Real*brunt, Real* shoc_mix); + Real* thv, Real* tk, Real*brunt, Real* shoc_mix); void shoc_energy_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, Real* zi_grid, Real* se_b, Real* ke_b, Real* wv_b, Real* wl_b, Real* se_a, Real* ke_a, Real* wv_a, Real* wl_a, Real* wthl_sfc, @@ -1050,12 +1059,12 @@ void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tr Real* zi_grid, Real* tk, Real* tkh, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* wtracer_sfc, Real* thetal, Real* qw, Real* tracer, Real* tke, Real* u_wind, Real* v_wind); -void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, +void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, bool shoc_1p5tke, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* isotropy, Real* brunt, Real* thetal, Real* tke, Real* dz_zt, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* w3); -void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, Real* sterm_zt, - Real* tk, Real* tke, Real* a_diss); +void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, bool shoc_1p5tke, Real* shoc_mix, Real* wthv_sec, Real* sterm_zt, + Real* tk, Real* brunt, Real* tke, Real* a_diss); void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* w_field, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* w_sec, Real* wqw_sec, Real* qwthl_sec, Real* w3, Real* pres, Real* zt_grid, Real* zi_grid, @@ -1088,9 +1097,9 @@ void pblintd_check_pblh_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, void pblintd_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, Real* thl, Real* ql, Real* q, Real* u, Real* v, Real* ustar, Real* obklen, Real* kbfs, Real* cldn, Real* pblh); void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, Real* pdel, Real* dz_zt, Real* dz_zi, Real* rho_zt); -void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, Real* isotropy, +void eddy_diffusivities_host(Int nlev, Int shcol, bool shoc_1p5tke, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, Real* isotropy, Real* tke, Real* tkh, Real* tk); -void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, +void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, bool shoc_1p5tke, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, Real* u_wind, Real* v_wind, Real* brunt, Real* obklen, Real* zt_grid, Real* zi_grid, Real* pblh, Real* tke, Real* tk, Real* tkh, Real* isotropy); void compute_shoc_temperature_host(Int shcol, Int nlev, Real* thetal, Real* ql, Real* inv_exner, Real* tabs); diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp index aee2c9e604d6..dff46172c16b 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp @@ -7,6 +7,7 @@ #include "share/util/eamxx_setup_random_test.hpp" #include "ekat/util/ekat_file_utils.hpp" #include "ekat/util/ekat_test_utils.hpp" +#include "physics/share/physics_test_data.hpp" namespace scream { namespace shoc { @@ -24,12 +25,6 @@ namespace unit_test { struct UnitWrap { - enum BASELINE_ACTION { - NONE, - COMPARE, - GENERATE - }; - template struct UnitTest : public KokkosTypes { @@ -57,67 +52,15 @@ struct UnitWrap { using Smask = typename Functions::Smask; using C = typename Functions::C; - struct Base { - std::string m_baseline_path; - std::string m_test_name; - BASELINE_ACTION m_baseline_action; - ekat::FILEPtr m_fid; + struct Base : public UnitBase { Base() : - m_baseline_path(""), - m_test_name(Catch::getResultCapture().getCurrentTestName()), - m_baseline_action(NONE), - m_fid() + UnitBase() { //Functions::shoc_init(); // just in case there is ever global shoc data - auto& ts = ekat::TestSession::get(); - if (ts.flags["c"]) { - m_baseline_action = COMPARE; - } - else if (ts.flags["g"]) { - m_baseline_action = GENERATE; - } - else if (ts.flags["n"]) { - m_baseline_action = NONE; - } - m_baseline_path = ts.params["b"]; - - - EKAT_REQUIRE_MSG( !(m_baseline_action != NONE && m_baseline_path == ""), - "SHOC unit test flags problem: baseline actions were requested but no baseline path was provided"); - - std::string baseline_name = m_baseline_path + "/" + m_test_name; - if (m_baseline_action == COMPARE) { - m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "r")); - } - else if (m_baseline_action == GENERATE) { - m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "w")); - } } - ~Base() - { - } - - std::mt19937_64 get_engine() - { - if (m_baseline_action != COMPARE) { - // We can use any seed - int seed; - auto engine = setup_random_test(nullptr, &seed); - if (m_baseline_action == GENERATE) { - // Write the seed - ekat::write(&seed, 1, m_fid); - } - return engine; - } - else { - // Read the seed - int seed; - ekat::read(&seed, 1, m_fid); - return setup_random_test(seed); - } - } + ~Base() = default; }; // Put struct decls here diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp index 5a03ab1d5798..42959c3ef2a4 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp @@ -85,8 +85,11 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< // set upper condition for dz_zi dz_zi[nlevi-1] = zt_grid[nlev-1]; + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridging to F90 - ComputeDiagThirdShocMomentData SDS(shcol, nlev, nlevi); + ComputeDiagThirdShocMomentData SDS(shcol, nlev, nlevi, shoc_1p5tke); // Test that the inputs are reasonable. // For this test shcol MUST be at least 2 @@ -184,6 +187,27 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< REQUIRE(is_skew == true); } + // SECOND TEST + // If SHOC is reverted to a 1.5 TKE closure then test to make sure that + // all values of w3 are zero everywhere. Will use the same input data + // as the previous test. + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // Call the C++ implementation + compute_diag_third_shoc_moment(SDS); + + // Check the result + + // Require that all values of w3 are ZERO + for (Int s = 0; s < shcol; ++s){ + for (Int n = 0; n < nlevi; ++n){ + const auto offset = n + s * nlevi; + REQUIRE(SDS.w3[offset] == 0); + } + } + } void run_bfb() @@ -192,10 +216,10 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< ComputeDiagThirdShocMomentData SDS_baseline[] = { // shcol, nlev, nlevi - ComputeDiagThirdShocMomentData(10, 71, 72), - ComputeDiagThirdShocMomentData(10, 12, 13), - ComputeDiagThirdShocMomentData(7, 16, 17), - ComputeDiagThirdShocMomentData(2, 7, 8) + ComputeDiagThirdShocMomentData(10, 71, 72, false), + ComputeDiagThirdShocMomentData(10, 12, 13, false), + ComputeDiagThirdShocMomentData(7, 16, 17, false), + ComputeDiagThirdShocMomentData(2, 7, 8, false) }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp index 99997f10c90a..62732a4b6310 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp @@ -77,8 +77,11 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments : public UnitWrap::UnitTest< // set upper condition for dz_zi dz_zi[nlevi-1] = zt_grid[nlev-1]; + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridging to F90 - DiagSecondMomentsData SDS(shcol, nlev, nlevi); + DiagSecondMomentsData SDS(shcol, nlev, nlevi, shoc_1p5tke); // Test that the inputs are reasonable. REQUIRE( (SDS.shcol == shcol && SDS.nlev == nlev && SDS.nlevi == nlevi) ); @@ -247,6 +250,33 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments : public UnitWrap::UnitTest< } } + // SECOND TEST + // If SHOC is reverted to a 1.5 TKE closure then test to make sure that + // all values of the scalar variances are zero everywhere. + // Will use the same input data as the previous test. + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // Call the C++ implementation + diag_second_moments(SDS); + + // Require that all values of w2 are ZERO + for (Int s = 0; s < shcol; ++s){ + // nlev checks + for (Int n = 0; n < nlev; ++n){ + const auto offset = n + s * nlev; + REQUIRE(SDS.w_sec[offset] == 0); + } + // nlevi checks + for (Int n = 0; n < nlevi; ++n){ + const auto offset = n + s * nlevi; + REQUIRE(SDS.thl_sec[offset] == 0); + REQUIRE(SDS.qw_sec[offset] == 0); + REQUIRE(SDS.qwthl_sec[offset] == 0); + } + } + } // run_property void run_bfb() @@ -254,10 +284,10 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments : public UnitWrap::UnitTest< auto engine = Base::get_engine(); DiagSecondMomentsData baseline_data[] = { - DiagSecondMomentsData(36, 72, 73), - DiagSecondMomentsData(72, 72, 73), - DiagSecondMomentsData(128, 72, 73), - DiagSecondMomentsData(256, 72, 73), + DiagSecondMomentsData(36, 72, 73, false), + DiagSecondMomentsData(72, 72, 73, false), + DiagSecondMomentsData(128, 72, 73, false), + DiagSecondMomentsData(256, 72, 73, false), }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp index 4e84b73a78b3..ba49cf1427b0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp @@ -85,7 +85,10 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments : public UnitWrap::UnitT // set upper condition for dz_zi dz_zi[nlevi-1] = zt_grid[nlev-1]; - DiagSecondShocMomentsData SDS(shcol, nlev, nlevi); + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + + DiagSecondShocMomentsData SDS(shcol, nlev, nlevi, shoc_1p5tke); // Test that the inputs are reasonable. REQUIRE( (SDS.shcol == shcol && SDS.nlev == nlev && SDS.nlevi == nlevi) ); @@ -260,6 +263,33 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments : public UnitWrap::UnitT } } + // SECOND TEST + // If SHOC is reverted to a 1.5 TKE closure then test to make sure that + // all values of the scalar variances are zero everywhere. + // Will use the same input data as the previous test. + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // Call the C++ implementation + diag_second_shoc_moments(SDS); + + // Require that all values of w2 are ZERO + for (Int s = 0; s < shcol; ++s){ + // nlev checks + for (Int n = 0; n < nlev; ++n){ + const auto offset = n + s * nlev; + REQUIRE(SDS.w_sec[offset] == 0); + } + // nlevi checks + for (Int n = 0; n < nlevi; ++n){ + const auto offset = n + s * nlevi; + REQUIRE(SDS.thl_sec[offset] == 0); + REQUIRE(SDS.qw_sec[offset] == 0); + REQUIRE(SDS.qwthl_sec[offset] == 0); + } + } + } // run_property void run_bfb() @@ -267,10 +297,10 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments : public UnitWrap::UnitT auto engine = Base::get_engine(); DiagSecondShocMomentsData baseline_data[] = { - DiagSecondShocMomentsData(36, 72, 73), - DiagSecondShocMomentsData(72, 72, 73), - DiagSecondShocMomentsData(128, 72, 73), - DiagSecondShocMomentsData(256, 72, 73), + DiagSecondShocMomentsData(36, 72, 73, false), + DiagSecondShocMomentsData(72, 72, 73, false), + DiagSecondShocMomentsData(128, 72, 73, false), + DiagSecondShocMomentsData(256, 72, 73, false), }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp index fba0261606c4..de128300c4df 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp @@ -79,8 +79,11 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: // set upper condition for dz_zi dz_zi[nlevi-1] = zt_grid[nlev-1]; + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridging to F90 - DiagThirdShocMomentsData SDS(shcol, nlev, nlevi); + DiagThirdShocMomentsData SDS(shcol, nlev, nlevi, shoc_1p5tke); // Test that the inputs are reasonable. // For this test shcol MUST be at least 2 @@ -200,6 +203,27 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: } } + // SECOND TEST + // If SHOC is reverted to a 1.5 TKE closure then test to make sure that + // all values of w3 are zero everywhere. Will use the same input data + // as the previous test. + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // Call the C++ implementation + diag_third_shoc_moments(SDS); + + // Check the result + + // Require that all values of w3 are ZERO + for (Int s = 0; s < shcol; ++s){ + for (Int n = 0; n < nlevi; ++n){ + const auto offset = n + s * nlevi; + REQUIRE(SDS.w3[offset] == 0); + } + } + } void run_bfb() @@ -208,10 +232,10 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: DiagThirdShocMomentsData SDS_baseline[] = { // shcol, nlev, nlevi - DiagThirdShocMomentsData(10, 71, 72), - DiagThirdShocMomentsData(10, 12, 13), - DiagThirdShocMomentsData(7, 16, 17), - DiagThirdShocMomentsData(2, 7, 8), + DiagThirdShocMomentsData(10, 71, 72, false), + DiagThirdShocMomentsData(10, 12, 13, false), + DiagThirdShocMomentsData(7, 16, 17, false), + DiagThirdShocMomentsData(2, 7, 8, false), }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp index 99ca097edbc0..85f19635b574 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp @@ -58,8 +58,11 @@ struct UnitWrap::UnitTest::TestShocEddyDiff : public UnitWrap::UnitTest::B // Turbulent kinetic energy [m2/s2] static constexpr Real tke_reg = 0.4; + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridging to F90 - EddyDiffusivitiesData SDS(shcol, nlev); + EddyDiffusivitiesData SDS(shcol, nlev, shoc_1p5tke); // Test that the inputs are reasonable. REQUIRE( (SDS.shcol == shcol && SDS.nlev == nlev) ); @@ -251,6 +254,102 @@ struct UnitWrap::UnitTest::TestShocEddyDiff : public UnitWrap::UnitTest::B } } } + + // 1.5 TKE test + // Verify that eddy diffusivities behave as expected if 1.5 TKE is activated. + // For this test we simply recycle the inputs from the previous test, with exception + // of the turbulent length scale and TKE. + + // SHOC Mixing length [m] + static constexpr Real shoc_mix_1p5_t1[shcol] = {100, 500}; + // Turbulent kinetic energy [m2/s2] + static constexpr Real tke_1p5_t1[shcol] = {0.4, 0.4}; + + // Verify that input length scale is increasing with column + // and TKE is the same for each column + for(Int s = 0; s < shcol-1; ++s) { + REQUIRE(shoc_mix_1p5_t1[s+1] > shoc_mix_1p5_t1[s]); + REQUIRE(tke_1p5_t1[s+1] == tke_1p5_t1[s]); + } + + // Fill in test data on zt_grid. + for(Int s = 0; s < shcol; ++s) { + // Column only input + SDS.tabs[s] = tabs_ustab[s]; + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.tke[offset] = tke_1p5_t1[s]; + SDS.shoc_mix[offset] = shoc_mix_1p5_t1[s]; + } + } + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // Call the C++ implementation + eddy_diffusivities(SDS); + + // Check to make sure the diffusivities are smaller + // in the columns where length scale is smaller + for(Int s = 0; s < shcol-1; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + // Get value corresponding to next column + const auto offsets = n + (s+1) * nlev; + if (SDS.tke[offset] == SDS.tke[offsets] & + SDS.shoc_mix[offset] < SDS.shoc_mix[offsets]){ + REQUIRE(SDS.tk[offset] < SDS.tk[offsets]); + REQUIRE(SDS.tkh[offset] < SDS.tkh[offsets]); + } + } + } + + // Now we are going to do a similar but opposite test, change TKE + // while keeping SHOC mix constant + + // SHOC Mixing length [m] + static constexpr Real shoc_mix_1p5_t2[shcol] = {500, 500}; + // Turbulent kinetic energy [m2/s2] + static constexpr Real tke_1p5_t2[shcol] = {0.1, 0.4}; + + // Verify that input length scale is increasing with column + // and TKE is the same for each column + for(Int s = 0; s < shcol-1; ++s) { + REQUIRE(shoc_mix_1p5_t2[s+1] == shoc_mix_1p5_t2[s]); + REQUIRE(tke_1p5_t2[s+1] > tke_1p5_t2[s]); + } + + // Fill in test data on zt_grid. + for(Int s = 0; s < shcol; ++s) { + // Column only input + SDS.tabs[s] = tabs_ustab[s]; + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.tke[offset] = tke_1p5_t2[s]; + SDS.shoc_mix[offset] = shoc_mix_1p5_t2[s]; + } + } + + // Call the C++ implementation + eddy_diffusivities(SDS); + + // Check to make sure the diffusivities are smaller + // in the columns where TKE is smaller + for(Int s = 0; s < shcol-1; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + // Get value corresponding to next column + const auto offsets = n + (s+1) * nlev; + if (SDS.tke[offset] < SDS.tke[offsets] & + SDS.shoc_mix[offset] == SDS.shoc_mix[offsets]){ + REQUIRE(SDS.tk[offset] < SDS.tk[offsets]); + REQUIRE(SDS.tkh[offset] < SDS.tkh[offsets]); + } + } + } + } @@ -259,10 +358,10 @@ struct UnitWrap::UnitTest::TestShocEddyDiff : public UnitWrap::UnitTest::B auto engine = Base::get_engine(); EddyDiffusivitiesData baseline_data[] = { - EddyDiffusivitiesData(10, 71), - EddyDiffusivitiesData(10, 12), - EddyDiffusivitiesData(7, 16), - EddyDiffusivitiesData(2, 7), + EddyDiffusivitiesData(10, 71, false), + EddyDiffusivitiesData(10, 12, false), + EddyDiffusivitiesData(7, 16, false), + EddyDiffusivitiesData(2, 7, false), }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp index ece2c5e3dad3..5a4a322ae818 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp @@ -51,6 +51,11 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas static constexpr Real thv[nlev] = {315, 310, 305, 300, 295}; // Turbulent kinetc energy [m2/s2] static constexpr Real tke[nlev] = {0.1, 0.15, 0.2, 0.25, 0.3}; + // Eddy viscosity [m2/s] + static constexpr Real tk[nlev] = {0.1, 10.0, 12.0, 15.0, 20.0}; + + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; // compute geometric grid mesh const auto grid_mesh = sqrt(host_dx*host_dy); @@ -65,7 +70,7 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas } // Initialize data structure for bridging to F90 - ShocLengthData SDS(shcol, nlev, nlevi); + ShocLengthData SDS(shcol, nlev, nlevi, shoc_1p5tke); // Load up input data for(Int s = 0; s < shcol; ++s) { @@ -81,6 +86,8 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas SDS.zt_grid[offset] = zt_grid[n]; SDS.thv[offset] = thv[n]; SDS.dz_zt[offset] = dz_zt[n]; + // eddy viscosity below not relevant for default SHOC + SDS.tk[offset] = 0; } // Fill in test data on zi_grid @@ -150,6 +157,50 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas } } + // Repeat this test but for 1.5 TKE closure option activated + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // We will use the same input data as above but with the SGS buoyancy + // flux set to zero, as will be the case with the 1.5 TKE option. + // Additionally, we will fill the value of the brunt vaisala frequency. + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.tk[offset] = tk[n]; + } + } + + // Call the C++ implementation + shoc_length(SDS); + + // Verify output + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + // Require mixing length is greater than zero and is + // less than geometric grid mesh length + 1 m + REQUIRE(SDS.shoc_mix[offset] >= minlen); + REQUIRE(SDS.shoc_mix[offset] <= maxlen); + REQUIRE(SDS.shoc_mix[offset] < 1.0+grid_mesh); + + // Be sure brunt vaisalla frequency is reasonable + REQUIRE(SDS.brunt[offset] < 1); + + // Ensure length scale is equal to dz if brunt =< 0, else + // length scale should be less then dz + if (SDS.brunt[offset] <= 0){ + REQUIRE(SDS.shoc_mix[offset] == SDS.dz_zt[offset]); + } + else{ + REQUIRE(SDS.shoc_mix[offset] < SDS.dz_zt[offset]); + } + + } + } + // TEST TWO // Small grid mesh test. Given a very small grid mesh, verify that // the length scale is confined to this value. Input from first @@ -160,6 +211,9 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas // Defin the host grid box size y-direction [m] static constexpr Real host_dy_small = 5; + // Call default SHOC closure assumptions + SDS.shoc_1p5tke = false; + // compute geometric grid mesh const auto grid_mesh_small = sqrt(host_dx_small*host_dy_small); @@ -184,6 +238,26 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas } } + // Repeat this test but for 1.5 TKE closure option activated + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // call C++ implementation + shoc_length(SDS); + + // Verify output + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + // Require mixing length is greater than zero and is + // less than geometric grid mesh length + 1 m + REQUIRE(SDS.shoc_mix[offset] > 0); + REQUIRE(SDS.shoc_mix[offset] <= maxlen); + REQUIRE(SDS.shoc_mix[offset] < 1.0+grid_mesh_small); + } + } + } void run_bfb() @@ -192,10 +266,10 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas ShocLengthData SDS_baseline[] = { // shcol, nlev, nlevi - ShocLengthData(12, 71, 72), - ShocLengthData(10, 12, 13), - ShocLengthData(7, 16, 17), - ShocLengthData(2, 7, 8), + ShocLengthData(12, 71, 72, false), + ShocLengthData(10, 12, 13, false), + ShocLengthData(7, 16, 17, false), + ShocLengthData(2, 7, 8, false), }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp index 0b5bb5d684ac..3f154dd93d88 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp @@ -45,8 +45,11 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< // Define the heights on the zt grid [m] static constexpr Real zt_grid[nlev] = {5000, 3000, 2000, 1000, 500}; + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridging to F90 - ComputeShocMixShocLengthData SDS(shcol, nlev); + ComputeShocMixShocLengthData SDS(shcol, nlev, shoc_1p5tke); // Test that the inputs are reasonable. // For this test shcol MUST be at least 2 @@ -64,6 +67,9 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< SDS.tke[offset] = (1.0+s)*tke_cons; SDS.brunt[offset] = brunt_cons; SDS.zt_grid[offset] = zt_grid[n]; + // do not consider below for default SHOC + SDS.tk[offset] = 0; + SDS.dz_zt[offset] = 0; } } @@ -112,6 +118,56 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< REQUIRE(SDS.shoc_mix[offset + 1] - SDS.shoc_mix[offset] < 0); } } + + // 1.5 TKE test + // Verify that length scale behaves as expected when 1.5 TKE closure + // assumptions are used. Will recycle all previous data, except we + // need to define dz, brunt vaisalla frequency, and tk. + + // Brunt Vaisalla frequency [s-1] + static constexpr Real brunt_1p5[nlev] = {0.01,-0.01,0.01,-0.01,0.01}; + // Define the heights on the zt grid [m] + static constexpr Real dz_zt_1p5[nlev] = {50, 100, 30, 20, 10}; + // Eddy viscocity [m2 s-1] + static constexpr Real tk_cons_1p5 = 0.1; + + // Activate 1.5 TKE closure + SDS.shoc_1p5tke = true; + + // Fill in test data on zt_grid. + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + // do not consider below for default SHOC + SDS.tk[offset] = tk_cons_1p5; + SDS.dz_zt[offset] = dz_zt_1p5[n]; + SDS.brunt[offset] = brunt_1p5[n]; + } + } + + // Call the C++ implementation + compute_shoc_mix_shoc_length(SDS); + + // Check the result + + // Verify that if Brunt Vaisalla frequency is unstable that mixing length + // is equal to vertical grid spacing. If brunt is stable, then verify that + // mixing length is less than the vertical grid spacing. + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + if (SDS.brunt[offset] <= 0){ + REQUIRE(SDS.shoc_mix[offset] == SDS.dz_zt[offset]); + } + else{ + REQUIRE(SDS.shoc_mix[offset] < SDS.dz_zt[offset]); + REQUIRE(SDS.shoc_mix[offset] >= 0.1*SDS.dz_zt[offset]); + } + + } + } + } void run_bfb() @@ -120,10 +176,10 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< ComputeShocMixShocLengthData SDS_baseline[] = { // shcol, nlev - ComputeShocMixShocLengthData(10, 71), - ComputeShocMixShocLengthData(10, 12), - ComputeShocMixShocLengthData(7, 16), - ComputeShocMixShocLengthData(2, 7) + ComputeShocMixShocLengthData(10, 71, false), + ComputeShocMixShocLengthData(10, 12, false), + ComputeShocMixShocLengthData(7, 16, false), + ComputeShocMixShocLengthData(2, 7, false) }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp index 6e7d9faab7c7..1769111b0073 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp @@ -56,14 +56,19 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: static constexpr Real wthv_sec_gr[shcol] = {0.5, -0.5}; // Shear production term [s-2] static constexpr Real sterm_gr[shcol] = {0.5, 0.0}; + // Brunt vaisalla frequency [s-1], only used for 1.5 closure + static constexpr Real brunt_gr[shcol] = {-0.04, 0.004}; // TKE initial value Real tke_init_gr[shcol] = {mintke, 0.4}; // Define upper bounds check for reasonable output Real adiss_upper_bound = 1; + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridgeing to F90 - AdvSgsTkeData SDS(shcol, nlev, dtime); + AdvSgsTkeData SDS(shcol, nlev, dtime, shoc_1p5tke); // Test that the inputs are reasonable. REQUIRE( (SDS.shcol == shcol && SDS.nlev == nlev && SDS.dtime == dtime) ); @@ -78,6 +83,10 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: SDS.wthv_sec[offset] = wthv_sec_gr[s]; SDS.sterm_zt[offset] = sterm_gr[s]; SDS.tke[offset] = tke_init_gr[s]; + // Set eddy viscosity below to a constant for all tests + SDS.tk[offset] = 1.0; + // for 1.5 scheme this value is irrelevant + SDS.brunt[offset] = 0.0; } } @@ -120,6 +129,50 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: } } + // We are now going to repeat this test but with 1.5 TKE closure option activated + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // We will use the same input data as above but with the SGS buoyancy + // flux set to zero, as will be the case with the 1.5 TKE option. + // Additionally, we will fill the value of the brunt vaisala frequency. + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.wthv_sec[offset] = 0.0; + SDS.brunt[offset] = brunt_gr[s]; + SDS.tke[offset] = tke_init_gr[s]; + } + } + + // Call the C++ implementation + adv_sgs_tke(SDS); + + // Check to make sure that there has been + // TKE growth + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + // Require output to fall within reasonable bounds + REQUIRE(SDS.tke[offset] >= mintke); + REQUIRE(SDS.tke[offset] <= maxtke); + REQUIRE(SDS.a_diss[offset] <= adiss_upper_bound); + REQUIRE(SDS.a_diss[offset] >= 0); + + if (s == 0){ + // Growth check + REQUIRE(SDS.tke[offset] > tke_init_gr[s]); + } + else{ + // Decay check + REQUIRE(SDS.tke[offset] < tke_init_gr[s]); + } + } + } + // SECOND TEST // TKE Dissipation test. Given input values that are identical // in two columns, verify that the dissipation rate is higher @@ -132,7 +185,10 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: // Shear production term [s-2] static constexpr Real sterm_diss = 0.01; // TKE initial value - Real tke_init_diss= 0.1; + static constexpr Real tke_init_diss = 0.1; + + // Reset to default SHOC closures + SDS.shoc_1p5tke = false; // Fill in test data on zt_grid. for(Int s = 0; s < shcol; ++s) { @@ -188,6 +244,7 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: } } } + } void run_bfb() @@ -196,10 +253,10 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: AdvSgsTkeData baseline_data[] = { // shcol, nlev - AdvSgsTkeData(10, 71, 72), - AdvSgsTkeData(10, 12, 13), - AdvSgsTkeData(7, 16, 17), - AdvSgsTkeData(2, 7, 8) + AdvSgsTkeData(10, 71, 72, false), + AdvSgsTkeData(10, 12, 13, false), + AdvSgsTkeData(7, 16, 17, false), + AdvSgsTkeData(2, 7, 8, false) }; // Generate random input data diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp index ebbd6328fdf5..05d981986325 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp @@ -51,6 +51,8 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { Real dtime = 300; // Buoyancy flux [K m/s] Real wthv_sec[nlev] = {0.05, 0.04, 0.03, 0.02, 0.03}; + // Brunt Vaisalla frequency [s-1] + Real brunt[nlev] = {-0.0005,-0.0004,-0.0003,-0.0003,-0.0003}; // Length Scale [m] Real shoc_mix[nlev] = {1000, 750, 500, 400, 300}; // Define zonal wind on nlev grid [m/s] @@ -83,8 +85,11 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { tk[n] = tkh[n]; } + // Default SHOC formulation, not 1.5 TKE closure assumptions + const bool shoc_1p5tke = false; + // Initialize data structure for bridging to F90 - ShocTkeData SDS(shcol, nlev, nlevi, dtime); + ShocTkeData SDS(shcol, nlev, nlevi, dtime, shoc_1p5tke); // Test that the inputs are reasonable. REQUIRE(SDS.nlevi - SDS.nlev == 1); @@ -108,6 +113,7 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { SDS.tkh[offset] = tkh[n]; SDS.tk[offset] = tk[n]; SDS.tabs[offset] = tabs[n]; + SDS.brunt[offset] = 0; // Do not consider for SHOC default } // Fill in test data on zi_grid. @@ -178,6 +184,43 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { } } + // We are now going to repeat this test but with 1.5 TKE closure option activated + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // We will use the same input data as above but with the SGS buoyancy + // flux set to zero, as will be the case with the 1.5 TKE option. + // Additionally, we will fill the value of the brunt vaisala frequency. + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.wthv_sec[offset] = 0.0; + SDS.brunt[offset] = brunt[n]; + } + } + + // Call the C++ implementation + shoc_tke(SDS); + + // Make array to save the result of TKE + Real tke_test1_1p5[nlev*shcol]; + + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + REQUIRE(SDS.tke[offset] > tke_init[n]); + REQUIRE(SDS.tke[offset] >= mintke); + REQUIRE(SDS.tke[offset] <= maxtke); + REQUIRE(SDS.tkh[offset] > 0); + REQUIRE(SDS.tk[offset] > 0); + REQUIRE(SDS.isotropy[offset] >= 0); + REQUIRE(SDS.isotropy[offset] <= maxiso); + tke_test1_1p5[offset] = SDS.tke[offset]; + } + } + // TEST TWO // Decay test. Now starting with the TKE from TEST ONE in // its spun up state, feed inputs that should always make @@ -197,6 +240,9 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { // Define meridional wind on nlev grid [m/s] Real v_wind_decay[nlev] = {-2, -2, -2, -2, -2}; + // Call default SHOC closure assumptions + SDS.shoc_1p5tke = false; + // Fill in test data on zt_grid. for(Int s = 0; s < shcol; ++s) { for(Int n = 0; n < nlev; ++n) { @@ -206,6 +252,7 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { SDS.shoc_mix[offset] = shoc_mix_decay[n]; SDS.u_wind[offset] = u_wind_decay[n]; SDS.v_wind[offset] = v_wind_decay[n]; + SDS.brunt[offset] = 0; // do not consider for default SHOC } } @@ -244,6 +291,41 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { REQUIRE(SDS.isotropy[offset] <= maxiso); } } + + // We are now going to repeat this test but with 1.5 TKE closure option activated + + // Activate 1.5 TKE closure assumptions + SDS.shoc_1p5tke = true; + + // We will use the same input data as above but with the SGS buoyancy + // flux set to zero, as will be the case with the 1.5 TKE option. + // Additionally, we will fill the value of the brunt vaisala frequency. + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.wthv_sec[offset] = 0.0; + SDS.brunt[offset] = brunt[n]; + } + } + + // Call the C++ implementation + shoc_tke(SDS); + + // Verify ALL outputs are reasonable and that TKE has decayed + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + REQUIRE(SDS.tke[offset] < tke_test1_1p5[offset]); + REQUIRE(SDS.tke[offset] >= mintke); + REQUIRE(SDS.tke[offset] <= maxtke); + REQUIRE(SDS.tkh[offset] > 0); + REQUIRE(SDS.tk[offset] > 0); + REQUIRE(SDS.isotropy[offset] >= 0); + REQUIRE(SDS.isotropy[offset] <= maxiso); + } + } + } void run_bfb() @@ -251,10 +333,10 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { auto engine = Base::get_engine(); ShocTkeData baseline_data[] = { - ShocTkeData(10, 71, 72, 300), - ShocTkeData(10, 12, 13, 100), - ShocTkeData(7, 16, 17, 50), - ShocTkeData(2, 7, 8, 5), + ShocTkeData(10, 71, 72, 300, false), + ShocTkeData(10, 12, 13, 100, false), + ShocTkeData(7, 16, 17, 50, false), + ShocTkeData(2, 7, 8, 5, false), }; // Generate random input data diff --git a/components/eamxx/src/physics/tms/CMakeLists.txt b/components/eamxx/src/physics/tms/CMakeLists.txt index 5380bcccf3ba..67a55331dad7 100644 --- a/components/eamxx/src/physics/tms/CMakeLists.txt +++ b/components/eamxx/src/physics/tms/CMakeLists.txt @@ -1,5 +1,16 @@ +set(TMS_SRCS + eamxx_tms_process_interface.cpp +) + +# Add ETI source files if not on CUDA/HIP +if (NOT EAMXX_ENABLE_GPU OR Kokkos_ENABLE_CUDA_RELOCATABLE_DEVICE_CODE OR Kokkos_ENABLE_HIP_RELOCATABLE_DEVICE_CODE) + list(APPEND TMS_SRCS + eti/compute_tms.cpp + ) +endif() + # Create tms library -add_library(tms eamxx_tms_process_interface.cpp) +add_library(tms ${TMS_SRCS}) target_link_libraries(tms physics_share scream_share) target_compile_definitions(tms PUBLIC EAMXX_HAS_TMS) target_include_directories(tms PUBLIC @@ -7,25 +18,7 @@ target_include_directories(tms PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/impl ) -# Add ETI source files if not on CUDA/HIP -if (NOT EAMXX_ENABLE_GPU) - target_sources(tms PUBLIC - ${CMAKE_CURRENT_SOURCE_DIR}/eti/compute_tms.cpp - ) -endif() - if (NOT SCREAM_LIB_ONLY) - # For testing, add some more sources and modules directory - target_sources (tms PRIVATE - ${SCREAM_BASE_DIR}/../eam/src/physics/cam/trb_mtn_stress.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/tms_iso_c.f90 - ${CMAKE_CURRENT_SOURCE_DIR}/tms_functions_f90.cpp - ) - set_target_properties(tms PROPERTIES - Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/tms_modules - ) - target_include_directories (tms PUBLIC ${CMAKE_CURRENT_BINARY_DIR}/tms_modules) - add_subdirectory(tests) endif() diff --git a/components/eamxx/src/physics/tms/tests/CMakeLists.txt b/components/eamxx/src/physics/tms/tests/CMakeLists.txt index 1ab5ff68628d..6c7ec710e985 100644 --- a/components/eamxx/src/physics/tms/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/tms/tests/CMakeLists.txt @@ -1,9 +1,29 @@ -INCLUDE (ScreamUtils) - -# NOTE: tests inside this if statement won't be built in a baselines-only build -if (NOT SCREAM_ONLY_GENERATE_BASELINES) - CreateUnitTest(tms_tests compute_tms_tests.cpp - LIBS tms - THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} - ) +include(ScreamUtils) + +add_subdirectory(infra) + +set(TMS_TESTS_SRCS + compute_tms_tests.cpp +) # TMS_TESTS_SRCS + +# All tests should understand the same baseline args +if (SCREAM_ENABLE_BASELINE_TESTS) + if (SCREAM_ONLY_GENERATE_BASELINES) + set(BASELINE_FILE_ARG "-g -b ${SCREAM_BASELINES_DIR}/data") + # We don't want to do thread spreads when generating. That + # could cause race conditions in the file system. + set(TMS_THREADS "${SCREAM_TEST_MAX_THREADS}") + else() + set(BASELINE_FILE_ARG "-c -b ${SCREAM_BASELINES_DIR}/data") + set(TMS_THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC}) + endif() +else() + set(BASELINE_FILE_ARG "-n") # no baselines + set(TMS_THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC}) endif() + +CreateUnitTest(tms_tests "${TMS_TESTS_SRCS}" + LIBS tms tms_test_infra + EXE_ARGS "--args ${BASELINE_FILE_ARG}" + THREADS ${TMS_THREADS} + LABELS "tms;physics;baseline_gen;baseline_cmp") diff --git a/components/eamxx/src/physics/tms/tests/compute_tms_tests.cpp b/components/eamxx/src/physics/tms/tests/compute_tms_tests.cpp index 9da8b7bd1bca..e9c5560003eb 100644 --- a/components/eamxx/src/physics/tms/tests/compute_tms_tests.cpp +++ b/components/eamxx/src/physics/tms/tests/compute_tms_tests.cpp @@ -6,7 +6,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "tms_functions.hpp" -#include "tms_functions_f90.hpp" +#include "tms_test_data.hpp" #include "share/util/eamxx_setup_random_test.hpp" namespace scream { @@ -14,18 +14,18 @@ namespace tms { namespace unit_test { template -struct UnitWrap::UnitTest::TestComputeTMS { +struct UnitWrap::UnitTest::TestComputeTMS : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { // Should property tests be created? } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeTMSData f90_data[] = { + ComputeTMSData baseline_data[] = { // ncols, nlevs ComputeTMSData(12, 72), ComputeTMSData(8, 12), @@ -33,55 +33,57 @@ struct UnitWrap::UnitTest::TestComputeTMS { ComputeTMSData(2, 7) }; + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ComputeTMSData); + // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine, { {d.sgh, {0.5, 1.5}} }); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before read calls so that // inout data is in original state ComputeTMSData cxx_data[] = { - ComputeTMSData(f90_data[0]), - ComputeTMSData(f90_data[1]), - ComputeTMSData(f90_data[2]), - ComputeTMSData(f90_data[3]) + ComputeTMSData(baseline_data[0]), + ComputeTMSData(baseline_data[1]), + ComputeTMSData(baseline_data[2]), + ComputeTMSData(baseline_data[3]) }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - compute_tms(d); + // Read baseline data + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - compute_tms_f(d.ncols, d.nlevs, - d.u_wind, d.v_wind, d.t_mid, d.p_mid, d.exner, - d.z_mid, d.sgh, d.landfrac, d.ksrf, d.taux, d.tauy); - d.transpose(); // go back to C layout + compute_tms(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ComputeTMSData); - + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (int r = 0; rm_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -91,16 +93,12 @@ struct UnitWrap::UnitTest::TestComputeTMS { namespace { -//TEST_CASE("compute_tms_property", "tms") -//{ -// using TestStruct = scream::tms::unit_test::UnitWrap::UnitTest::TestComputeTMS; -// TestStruct::run_property(); -//} - TEST_CASE("compute_tms_bfb", "tms") { using TestStruct = scream::tms::unit_test::UnitWrap::UnitTest::TestComputeTMS; - TestStruct::run_bfb(); + + TestStruct t; + t.run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/tms/tests/infra/CMakeLists.txt b/components/eamxx/src/physics/tms/tests/infra/CMakeLists.txt new file mode 100644 index 000000000000..2c0cc0a47419 --- /dev/null +++ b/components/eamxx/src/physics/tms/tests/infra/CMakeLists.txt @@ -0,0 +1,7 @@ +set(INFRA_SRCS + tms_test_data.cpp +) + +add_library(tms_test_infra ${INFRA_SRCS}) +target_link_libraries(tms_test_infra tms) +target_include_directories(tms_test_infra PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/components/eamxx/src/physics/tms/tms_functions_f90.cpp b/components/eamxx/src/physics/tms/tests/infra/tms_test_data.cpp similarity index 81% rename from components/eamxx/src/physics/tms/tms_functions_f90.cpp rename to components/eamxx/src/physics/tms/tests/infra/tms_test_data.cpp index 790e5320d6c2..67227fb95db2 100644 --- a/components/eamxx/src/physics/tms/tms_functions_f90.cpp +++ b/components/eamxx/src/physics/tms/tests/infra/tms_test_data.cpp @@ -1,4 +1,4 @@ -#include "tms_functions_f90.hpp" +#include "tms_test_data.hpp" #include "ekat/ekat_assert.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" @@ -11,29 +11,9 @@ using scream::Real; -// -// A C interface to TMS fortran calls. The stubs below will link to fortran definitions in tms_iso_c.f90 -// -extern "C" { -void init_tms_c(Real orocnst, Real z0fac, Real karman, Real gravit, Real rair); -void compute_tms_c(int ncols, int nlevs, Real *u_wind, Real *v_wind, Real *t_mid, Real *p_mid, Real *exner, - Real *zm, Real *sgh, Real *landfrac, Real *ksrf, Real *taux, Real *tauy); -} - namespace scream { namespace tms { -// Glue functions to call fortran from from C++ with the Data struct -void compute_tms(ComputeTMSData& d) -{ - using C = scream::physics::Constants; - init_tms_c(C::orocnst, C::z0fac, C::Karman, C::gravit, C::Rair); - d.transpose(); - compute_tms_c(d.ncols, d.nlevs, d.u_wind, d.v_wind, d.t_mid, d.p_mid, d.exner, - d.z_mid, d.sgh, d.landfrac, d.ksrf, d.taux, d.tauy); - d.transpose(); -} - // // _f function definitions. These expect data in C layout // @@ -110,5 +90,11 @@ void compute_tms_f(int ncols, int nlevs, ScreamDeepCopy::copy_to_host({ksrf, taux, tauy}, ncols, output_data); } +void compute_tms(ComputeTMSData& d) +{ + compute_tms_f(d.ncols, d.nlevs, d.u_wind, d.v_wind, d.t_mid, d.p_mid, d.exner, + d.z_mid, d.sgh, d.landfrac, d.ksrf, d.taux, d.tauy); +} + } // namespace tms } // namespace scream diff --git a/components/eamxx/src/physics/tms/tms_functions_f90.hpp b/components/eamxx/src/physics/tms/tests/infra/tms_test_data.hpp similarity index 79% rename from components/eamxx/src/physics/tms/tms_functions_f90.hpp rename to components/eamxx/src/physics/tms/tests/infra/tms_test_data.hpp index 12b12b14a986..22d9c79f995a 100644 --- a/components/eamxx/src/physics/tms/tms_functions_f90.hpp +++ b/components/eamxx/src/physics/tms/tests/infra/tms_test_data.hpp @@ -40,13 +40,6 @@ struct ComputeTMSData : public PhysicsTestData // Glue functions to call fortran from from C++ with the Data struct void compute_tms(ComputeTMSData& d); -// _f function decls -extern "C" { -void compute_tms_f(int ncols, int nlevs, - Real *u_wind, Real *v_wind, Real *t_mid, Real *p_mid, Real *exner, Real *z_mid, - Real *sgh, Real *landfrac, Real *ksrf, Real *taux, Real *tauy); -} // end _f function decls - } // namespace tms } // namespace scream diff --git a/components/eamxx/src/physics/tms/tests/tms_unit_tests_common.hpp b/components/eamxx/src/physics/tms/tests/infra/tms_unit_tests_common.hpp similarity index 86% rename from components/eamxx/src/physics/tms/tests/tms_unit_tests_common.hpp rename to components/eamxx/src/physics/tms/tests/infra/tms_unit_tests_common.hpp index 7159b41173e2..8377e8e57bde 100644 --- a/components/eamxx/src/physics/tms/tests/tms_unit_tests_common.hpp +++ b/components/eamxx/src/physics/tms/tests/infra/tms_unit_tests_common.hpp @@ -4,6 +4,7 @@ #include "tms_functions.hpp" #include "share/eamxx_types.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "physics/share/physics_test_data.hpp" namespace scream { namespace tms { @@ -44,13 +45,23 @@ struct UnitWrap { using Scalar = typename Functions::Scalar; using Spack = ekat::Pack; + struct Base : public UnitBase { + + Base() : + UnitBase() + { + // Functions::tms_init(); // just in case there is ever global tms data + } + + ~Base() = default; + }; + // Put struct decls here struct TestComputeTMS; }; }; - } // namespace unit_test } // namespace tms } // namespace scream diff --git a/components/eamxx/src/physics/tms/tms_iso_c.f90 b/components/eamxx/src/physics/tms/tms_iso_c.f90 deleted file mode 100644 index 38ae1f286a8a..000000000000 --- a/components/eamxx/src/physics/tms/tms_iso_c.f90 +++ /dev/null @@ -1,36 +0,0 @@ - -module tms_iso_c - use iso_c_binding - implicit none - -#include "eamxx_config.f" - -! -! This file contains bridges from scream c++ to tms fortran. -! - -contains - subroutine init_tms_c(orocnst, z0fac, karman, gravit, rair) bind(c) - use trb_mtn_stress, only: init_tms - - real(kind=c_double), value, intent(in) :: orocnst, z0fac, karman, gravit, rair - character(len=128) :: errstring - - integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real - - call init_tms(r8, orocnst, z0fac, karman, gravit, rair, errstring) - end subroutine init_tms_c - - subroutine compute_tms_c(ncols, nlevs, u_wind, v_wind, t_mid, p_mid, exner, & - zm, sgh, landfrac, ksrf, taux, tauy) bind(c) - use trb_mtn_stress, only: compute_tms - - integer(kind=c_int), value, intent(in) :: ncols, nlevs - real(kind=c_double) , intent(in), dimension(ncols, nlevs) :: u_wind,v_wind,t_mid,p_mid,exner,zm - real(kind=c_double) , intent(in), dimension(ncols) :: sgh,landfrac - real(kind=c_double) , intent(out), dimension(ncols) :: ksrf, taux, tauy - - call compute_tms(ncols, nlevs, ncols, u_wind, v_wind, t_mid, p_mid, exner, zm, sgh, ksrf, taux, tauy, landfrac) - end subroutine compute_tms_c - -end module tms_iso_c diff --git a/components/eamxx/src/python/libpyeamxx/pyatmproc.hpp b/components/eamxx/src/python/libpyeamxx/pyatmproc.hpp index 77280f39f0a9..b17a7b87b464 100644 --- a/components/eamxx/src/python/libpyeamxx/pyatmproc.hpp +++ b/components/eamxx/src/python/libpyeamxx/pyatmproc.hpp @@ -172,9 +172,7 @@ struct PyAtmProc { auto gm = PySession::get().gm; std::map> fms; for (auto it : gm->get_repo()) { - fms[it.first] = std::make_shared(it.second); - fms[it.first]->registration_begins(); - fms[it.first]->registration_ends(); + fms[it.first] = std::make_shared(it.second,RepoState::Closed); } for (auto it : fields) { const auto& gn = it.second.f.get_header().get_identifier().get_grid_name(); diff --git a/components/eamxx/src/share/CMakeLists.txt b/components/eamxx/src/share/CMakeLists.txt index 8a7bc7d4463a..cdd977133ea8 100644 --- a/components/eamxx/src/share/CMakeLists.txt +++ b/components/eamxx/src/share/CMakeLists.txt @@ -17,6 +17,7 @@ set(SHARE_SRC field/field.cpp field/field_group.cpp field/field_manager.cpp + field/field_sync.cpp grid/abstract_grid.cpp grid/grids_manager.cpp grid/grid_import_export.cpp diff --git a/components/eamxx/src/share/atm_process/IOPDataManager.cpp b/components/eamxx/src/share/atm_process/IOPDataManager.cpp index 361a4311254f..81db8e718a32 100644 --- a/components/eamxx/src/share/atm_process/IOPDataManager.cpp +++ b/components/eamxx/src/share/atm_process/IOPDataManager.cpp @@ -345,7 +345,6 @@ read_fields_from_file_for_iop (const std::string& file_name, const auto lon = m_params.get("target_longitude"); auto remapper = std::make_shared(io_grid,grid,lat,lon); - remapper->registration_begins(); for (const auto& f : fields) { remapper->register_field_from_tgt(f); } diff --git a/components/eamxx/src/share/atm_process/atmosphere_process.cpp b/components/eamxx/src/share/atm_process/atmosphere_process.cpp index 97abc277f0e9..cba233b9e5b2 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process.cpp @@ -71,8 +71,12 @@ void AtmosphereProcess::initialize (const TimeStamp& t0, const RunType run_type) start_timer (m_timer_prefix + this->name() + "::init"); } - log (LogLevel::info," Initializing " + name() + "..."); - m_atm_logger->flush(); // During init, flush often (to help debug crashes) + // Avoid logging and flushing if ap type is diag ... + // ... because we could have 100+ of those in production runs + if (this->type()!=AtmosphereProcessType::Diagnostic) { + log (LogLevel::info," Initializing " + name() + "..."); + m_atm_logger->flush(); // During init, flush often (to help debug crashes) + } set_fields_and_groups_pointers(); m_start_of_step_ts = m_end_of_step_ts = t0; @@ -85,8 +89,12 @@ void AtmosphereProcess::initialize (const TimeStamp& t0, const RunType run_type) m_start_of_step_fields[fname] = get_field_out(fname).clone(); } - log (LogLevel::info," Initializing " + name() + "... done!"); - m_atm_logger->flush(); // During init, flush often (to help debug crashes) + // Avoid logging and flushing if ap type is diag ... + // ... because we could have 100+ of those in production runs + if (this->type()!=AtmosphereProcessType::Diagnostic) { + log (LogLevel::info," Initializing " + name() + "... done!"); + m_atm_logger->flush(); // During init, flush often (to help debug crashes) + } if (this->type()!=AtmosphereProcessType::Group) { stop_timer (m_timer_prefix + this->name() + "::init"); @@ -122,7 +130,7 @@ void AtmosphereProcess::run (const double dt) { // Print hash of INPUTS before run print_global_state_hash(name() + "-pre-sc-" + std::to_string(m_subcycle_iter), m_start_of_step_ts, - true, false, false); + true, false, true); // Run derived class implementation run_impl(dt_sub); @@ -131,7 +139,7 @@ void AtmosphereProcess::run (const double dt) { // Print hash of OUTPUTS/INTERNALS after run print_global_state_hash(name() + "-pst-sc-" + std::to_string(m_subcycle_iter), m_end_of_step_ts, - true, true, true); + false, true, true); if (has_column_conservation_check()) { // Run the column local mass and energy conservation checks diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_hash.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_hash.cpp index f07fab152e90..f39d78d0ebda 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_hash.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_hash.cpp @@ -150,20 +150,21 @@ ::print_global_state_hash (const std::string& label, const TimeStamp& t, } else if (m_internal_diagnostics_level==2) { // Hash fields individually. Notice that, if a field is requested individually // as well as part of a group, it will be hashed twice (independently) - auto layout = [](const Field& f) -> std::string { - const auto& fl = f.get_header().get_identifier().get_layout(); - return " (" + ekat::join(fl.names(),",") + ")"; + auto make_hash_name = [](const Field& f) -> std::string { + const auto& fid = f.get_header().get_identifier(); + const auto& fl = fid.get_layout(); + return f.name() + " (" + ekat::join(fl.names(),",") + ") <" + fid.get_grid_name() + ">"; }; if (compute[0]) { for (const auto& f : m_fields_in) { laccum.emplace_back(); - hash_names.push_back(f.name()+layout(f)); + hash_names.push_back(make_hash_name(f)); hash(f,laccum.back()); } for (const auto& g : m_groups_in) { for (const auto& [fn,f] : g.m_individual_fields) { laccum.emplace_back(); - hash_names.push_back(fn+layout(*f)); + hash_names.push_back(make_hash_name(*f)); hash(*f,laccum.back()); } } @@ -171,13 +172,13 @@ ::print_global_state_hash (const std::string& label, const TimeStamp& t, if (compute[1]) { for (const auto& f : m_fields_out) { laccum.emplace_back(); - hash_names.push_back(f.name()+layout(f)); + hash_names.push_back(make_hash_name(f)); hash(f,laccum.back()); } for (const auto& g : m_groups_out) { for (const auto& [fn,f] : g.m_individual_fields) { laccum.emplace_back(); - hash_names.push_back(fn+layout(*f)); + hash_names.push_back(make_hash_name(*f)); hash(*f,laccum.back()); } } @@ -185,7 +186,7 @@ ::print_global_state_hash (const std::string& label, const TimeStamp& t, if (compute[2]) { for (const auto& f : m_internal_fields) { laccum.emplace_back(); - hash_names.push_back(f.name()+layout(f)); + hash_names.push_back(make_hash_name(f)); hash(f,laccum.back()); } } diff --git a/components/eamxx/src/share/field/field.cpp b/components/eamxx/src/share/field/field.cpp index 972da0fab926..4678e51de3f0 100644 --- a/components/eamxx/src/share/field/field.cpp +++ b/components/eamxx/src/share/field/field.cpp @@ -64,65 +64,6 @@ Field::clone(const std::string& name, const std::string& grid_name) const { return f; } -void Field:: -sync_to_host (const bool fence) const { - // Sanity check - EKAT_REQUIRE_MSG (is_allocated(), - "Error! Input field must be allocated in order to sync host and device views.\n"); - - // Check for early return if Host and Device are the same memory space - if (host_and_device_share_memory_space()) return; - - // We allow sync_to_host for constant fields. Temporarily disable read only flag. - const bool original_read_only = m_is_read_only; - m_is_read_only = false; - - switch (data_type()) { - case DataType::IntType: - sync_views_impl(); - break; - case DataType::FloatType: - sync_views_impl(); - break; - case DataType::DoubleType: - sync_views_impl(); - break; - default: - EKAT_ERROR_MSG("Error! Unrecognized field data type in Field::sync_to_host.\n"); - } - - if (fence) Kokkos::fence(); - - // Return field to read-only state - m_is_read_only = original_read_only; -} - -void Field:: -sync_to_dev (const bool fence) const { - // Sanity check - EKAT_REQUIRE_MSG (is_allocated(), - "Error! Input field must be allocated in order to sync host and device views.\n"); - - // Check for early return if Host and Device are the same memory space - if (host_and_device_share_memory_space()) return; - - switch (data_type()) { - case DataType::IntType: - sync_views_impl(); - break; - case DataType::FloatType: - sync_views_impl(); - break; - case DataType::DoubleType: - sync_views_impl(); - break; - default: - EKAT_ERROR_MSG("Error! Unrecognized field data type in Field::sync_to_dev.\n"); - } - - if (fence) Kokkos::fence(); -} - Field Field:: subfield (const std::string& sf_name, const ekat::units::Units& sf_units, const int idim, const int index, const bool dynamic) const { diff --git a/components/eamxx/src/share/field/field_header.cpp b/components/eamxx/src/share/field/field_header.cpp index 3698894f0c36..7b874f18c433 100644 --- a/components/eamxx/src/share/field/field_header.cpp +++ b/components/eamxx/src/share/field/field_header.cpp @@ -34,6 +34,10 @@ set_extra_data (const std::string& key, std::shared_ptr FieldHeader::alias(const std::string& name) const { auto fh = create_header(get_identifier().alias(name)); + if (get_parent() != nullptr) { + // If we're aliasing, we MUST keep track of the parent + fh->create_parent_child_link(get_parent()); + } fh->m_tracking = m_tracking; fh->m_alloc_prop = m_alloc_prop; fh->m_extra_data = m_extra_data; diff --git a/components/eamxx/src/share/field/field_layout.cpp b/components/eamxx/src/share/field/field_layout.cpp index 3b2c4c195ec0..74a47e5a24f5 100644 --- a/components/eamxx/src/share/field/field_layout.cpp +++ b/components/eamxx/src/share/field/field_layout.cpp @@ -148,6 +148,27 @@ FieldLayout& FieldLayout::strip_dim (const int idim) { return *this; } +void FieldLayout::add_dim (const FieldTag t, const int extent, const std::string& name, + bool prepend_instead_of_append) +{ + if (prepend_instead_of_append) + { + m_tags.insert(m_tags.begin(), t); + m_names.insert(m_names.begin(), name); + m_dims.insert(m_dims.begin(), extent); + } + else + { + m_tags.push_back(t); + m_names.push_back(name); + m_dims.push_back(extent); + } + + ++m_rank; + set_extents(); + compute_type(); +} + FieldLayout& FieldLayout::append_dim (const FieldTag t, const int extent) { @@ -157,13 +178,20 @@ FieldLayout::append_dim (const FieldTag t, const int extent) FieldLayout& FieldLayout::append_dim (const FieldTag t, const int extent, const std::string& name) { - m_tags.push_back(t); - m_names.push_back(name); - m_dims.push_back(extent); + add_dim(t, extent, name); + return *this; +} + +FieldLayout& +FieldLayout::prepend_dim (const FieldTag t, const int extent) +{ + return prepend_dim(t,extent,e2str(t)); +} - ++m_rank; - set_extents(); - compute_type(); +FieldLayout& +FieldLayout::prepend_dim (const FieldTag t, const int extent, const std::string& name) +{ + add_dim(t, extent, name, true); return *this; } diff --git a/components/eamxx/src/share/field/field_layout.hpp b/components/eamxx/src/share/field/field_layout.hpp index f4d54168b866..fd4a665c32fe 100644 --- a/components/eamxx/src/share/field/field_layout.hpp +++ b/components/eamxx/src/share/field/field_layout.hpp @@ -132,6 +132,8 @@ class FieldLayout { FieldLayout& strip_dim (const int idim); FieldLayout& append_dim (const FieldTag t, const int extent); FieldLayout& append_dim (const FieldTag t, const int extent, const std::string& name); + FieldLayout& prepend_dim (const FieldTag t, const int extent); + FieldLayout& prepend_dim (const FieldTag t, const int extent, const std::string& name); FieldLayout& rename_dim (const int idim, const std::string& n); FieldLayout& rename_dim (const FieldTag tag, const std::string& n, const bool throw_if_not_found = true); FieldLayout& reset_dim (const int idim, const int extent); @@ -153,6 +155,9 @@ class FieldLayout { protected: void compute_type (); void set_extents (); + void add_dim (const FieldTag t, const int extent, const std::string& name, + bool prepend_instead_of_append = false); + int m_rank; std::vector m_tags; @@ -214,7 +219,7 @@ inline long long FieldLayout::size () const { return prod; } -inline FieldTag FieldLayout::tag (const int idim) const { +inline FieldTag FieldLayout::tag (const int idim) const { EKAT_REQUIRE_MSG (idim>=0 && idim& grid) - : FieldManager (std::make_shared(grid)) +FieldManager (const std::shared_ptr& grid, + const RepoState state) + : FieldManager (std::make_shared(grid),state) { // Nothing else to do } FieldManager:: -FieldManager (const std::shared_ptr& gm) - : m_grids_mgr (gm) +FieldManager (const std::shared_ptr& gm, + const RepoState state) + : m_repo_state (state) + , m_grids_mgr (gm) { EKAT_REQUIRE_MSG (m_grids_mgr!=nullptr, "Error! Input grids manager pointer is not valid."); @@ -24,19 +27,21 @@ FieldManager (const std::shared_ptr& gm) m_group_requests[gname] = std::map>(); } - m_repo_state = RepoState::Clean; + if (m_repo_state==RepoState::Closed) { + registration_ends(); + } } void FieldManager::register_field (const FieldRequest& req) { - const auto& id = req.fid; - const auto& grid_name = id.get_grid_name(); - // Sanity checks - EKAT_REQUIRE_MSG (m_repo_state!=RepoState::Clean, - "Error! Repo state is not 'Open' yet. You must call registration_begins() first.\n"); EKAT_REQUIRE_MSG (m_repo_state!=RepoState::Closed, - "Error! Repo state is not 'Open' anymore. You already called registration_ends().\n"); + "Error! Repo state is not 'Open' anymore. Did you already called 'registration_ends()'?\n"); + + m_repo_state = RepoState::Open; + + const auto& id = req.fid; + const auto& grid_name = id.get_grid_name(); // Make sure this FM contains a grid corresponding to the input grid name EKAT_REQUIRE_MSG(m_grids_mgr->has_grid(grid_name), @@ -347,12 +352,6 @@ init_fields_time_stamp (const util::TimeStamp& t0) } } -void FieldManager::registration_begins () -{ - // Update the state of the repo - m_repo_state = RepoState::Open; -} - void FieldManager::registration_ends () { // This method is responsible of allocating the fields in the repo. The most delicate part is diff --git a/components/eamxx/src/share/field/field_manager.hpp b/components/eamxx/src/share/field/field_manager.hpp index 7aa8518575dc..cd6883b044f3 100644 --- a/components/eamxx/src/share/field/field_manager.hpp +++ b/components/eamxx/src/share/field/field_manager.hpp @@ -43,8 +43,8 @@ class FieldManager { using group_info_map = std::map>; // Constructor(s) - explicit FieldManager (const std::shared_ptr& grid); - explicit FieldManager (const std::shared_ptr& grid); + explicit FieldManager (const std::shared_ptr& grid, const RepoState state = RepoState::Clean); + explicit FieldManager (const std::shared_ptr& grid, const RepoState state = RepoState::Clean); // No copies, cause the internal database is not a shared_ptr. // NOTE: you can change this if you find that copies are needed/useful. @@ -52,7 +52,6 @@ class FieldManager { FieldManager& operator= (const FieldManager&) = delete; // Change the state of the database - void registration_begins (); void register_field (const FieldRequest& req); void register_group (const GroupRequest& req); void registration_ends (); diff --git a/components/eamxx/src/share/field/field_sync.cpp b/components/eamxx/src/share/field/field_sync.cpp new file mode 100644 index 000000000000..469c73fc3009 --- /dev/null +++ b/components/eamxx/src/share/field/field_sync.cpp @@ -0,0 +1,65 @@ +#include "share/field/field.hpp" + +namespace scream +{ + +void Field:: +sync_to_host (const bool fence) const { + // Sanity check + EKAT_REQUIRE_MSG (is_allocated(), + "Error! Input field must be allocated in order to sync host and device views.\n"); + + // Check for early return if Host and Device are the same memory space + if (host_and_device_share_memory_space()) return; + + // We allow sync_to_host for constant fields. Temporarily disable read only flag. + const bool original_read_only = m_is_read_only; + m_is_read_only = false; + + switch (data_type()) { + case DataType::IntType: + sync_views_impl(); + break; + case DataType::FloatType: + sync_views_impl(); + break; + case DataType::DoubleType: + sync_views_impl(); + break; + default: + EKAT_ERROR_MSG("Error! Unrecognized field data type in Field::sync_to_host.\n"); + } + + if (fence) Kokkos::fence(); + + // Return field to read-only state + m_is_read_only = original_read_only; +} + +void Field:: +sync_to_dev (const bool fence) const { + // Sanity check + EKAT_REQUIRE_MSG (is_allocated(), + "Error! Input field must be allocated in order to sync host and device views.\n"); + + // Check for early return if Host and Device are the same memory space + if (host_and_device_share_memory_space()) return; + + switch (data_type()) { + case DataType::IntType: + sync_views_impl(); + break; + case DataType::FloatType: + sync_views_impl(); + break; + case DataType::DoubleType: + sync_views_impl(); + break; + default: + EKAT_ERROR_MSG("Error! Unrecognized field data type in Field::sync_to_dev.\n"); + } + + if (fence) Kokkos::fence(); +} + +} // namespace scream diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index b3e66e0faf68..3ce0fb168bc0 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -190,9 +190,9 @@ void horiz_contraction(const Field &f_out, const Field &f_in, // - Weight is assumed to be (in order of checking/impl): // - rank-1, with only LEV/ILEV dimension // - rank-2, with only COL and LEV/ILEV dimensions +// NOTE: we assume the LEV/ILEV dimension is NOT partitioned. template -void vert_contraction(const Field &f_out, const Field &f_in, - const Field &weight, const ekat::Comm *comm = nullptr) { +void vert_contraction(const Field &f_out, const Field &f_in, const Field &weight) { using namespace ShortFieldTagsNames; const auto &l_out = f_out.get_header().get_identifier().get_layout(); @@ -266,7 +266,7 @@ void vert_contraction(const Field &f_out, const Field &f_in, "Error! Weight field must have the same data type as input field."); // All good, call the implementation - impl::vert_contraction(f_out, f_in, weight, comm); + impl::vert_contraction(f_out, f_in, weight); } template diff --git a/components/eamxx/src/share/field/field_utils_impl.hpp b/components/eamxx/src/share/field/field_utils_impl.hpp index c7f6d4da627e..8b3ac040a9b1 100644 --- a/components/eamxx/src/share/field/field_utils_impl.hpp +++ b/components/eamxx/src/share/field/field_utils_impl.hpp @@ -378,8 +378,7 @@ void horiz_contraction(const Field &f_out, const Field &f_in, } template -void vert_contraction(const Field &f_out, const Field &f_in, - const Field &weight, const ekat::Comm *comm) { +void vert_contraction(const Field &f_out, const Field &f_in, const Field &weight) { using KT = ekat::KokkosTypes; using RangePolicy = Kokkos::RangePolicy; using TeamPolicy = Kokkos::TeamPolicy; @@ -452,17 +451,6 @@ void vert_contraction(const Field &f_out, const Field &f_in, default: EKAT_ERROR_MSG("Error! Unsupported field rank in vert_contraction.\n"); } - - if(comm) { - // TODO: use device-side MPI calls - // TODO: the dev ptr causes problems; revisit this later - // TODO: doing cuda-aware MPI allreduce would be ~10% faster - Kokkos::fence(); - f_out.sync_to_host(); - comm->all_reduce(f_out.template get_internal_view_data(), - l_out.size(), MPI_SUM); - f_out.sync_to_dev(); - } } template diff --git a/components/eamxx/src/share/grid/abstract_grid.hpp b/components/eamxx/src/share/grid/abstract_grid.hpp index ece2e6e2ec7f..cc75c2767ffe 100644 --- a/components/eamxx/src/share/grid/abstract_grid.hpp +++ b/components/eamxx/src/share/grid/abstract_grid.hpp @@ -205,7 +205,7 @@ class AbstractGrid : public ekat::enable_shared_from_this // with the same name, IO can use this as a suffix to diambiguate the fields in // the IO file, by appending each grid's suffix to the fields names. // NOTE: we'd need setter/getter for this, so we might as well make it public - std::string m_short_name = ""; + std::string m_disambiguation_suffix = ""; int get_unique_grid_id () const { return m_unique_grid_id; } diff --git a/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp b/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp index d172001c32fa..169ea989ea65 100644 --- a/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp +++ b/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp @@ -103,7 +103,7 @@ build_se_grid (const std::string& name, ekat::ParameterList& params) elem_gids.sync_to_dev(); lid2idx.sync_to_dev(); - se_grid->m_short_name = "se"; + se_grid->m_disambiguation_suffix = "_se"; add_geo_data(se_grid); add_nonconst_grid(se_grid); @@ -130,7 +130,7 @@ build_point_grid (const std::string& name, ekat::ParameterList& params) area.sync_to_host(); add_geo_data(pt_grid); - pt_grid->m_short_name = "pt"; + pt_grid->m_disambiguation_suffix = "_pt"; add_nonconst_grid(pt_grid); } diff --git a/components/eamxx/src/share/grid/remap/abstract_remapper.cpp b/components/eamxx/src/share/grid/remap/abstract_remapper.cpp index f8621a4b0310..970680207b16 100644 --- a/components/eamxx/src/share/grid/remap/abstract_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/abstract_remapper.cpp @@ -10,21 +10,14 @@ AbstractRemapper (const grid_ptr_type& src_grid, set_grids (src_grid,tgt_grid); } -void AbstractRemapper:: -registration_begins () { - EKAT_REQUIRE_MSG(m_state==RepoState::Clean, - "Error! Cannot start registration on a non-clean repo.\n" - " Did you call 'registration_begins' already?\n"); - - m_state = RepoState::Open; -} - void AbstractRemapper:: register_field (const Field& src, const Field& tgt) { - EKAT_REQUIRE_MSG(m_state==RepoState::Open, + EKAT_REQUIRE_MSG(m_state!=RepoState::Closed, "Error! Cannot register fields in the remapper at this time.\n" - " Did you forget to call 'registration_begins' or called 'registeration_ends' already?"); + " Did you already call 'registeration_ends'?"); + + m_state = RepoState::Open; EKAT_REQUIRE_MSG(src.is_allocated(), "Error! Source field is not yet allocated.\n"); EKAT_REQUIRE_MSG(tgt.is_allocated(), "Error! Target field is not yet allocated.\n"); @@ -59,7 +52,7 @@ register_field (const Field& src, const Field& tgt) ++m_num_fields; } -void AbstractRemapper:: +Field AbstractRemapper:: register_field_from_src (const Field& src) { const auto& src_fid = src.get_header().get_identifier(); const auto& tgt_fid = create_tgt_fid(src_fid); @@ -71,9 +64,11 @@ register_field_from_src (const Field& src) { tgt.allocate_view(); register_field(src,tgt); + + return tgt; } -void AbstractRemapper:: +Field AbstractRemapper:: register_field_from_tgt (const Field& tgt) { const auto& tgt_fid = tgt.get_header().get_identifier(); const auto& src_fid = create_src_fid(tgt_fid); @@ -85,6 +80,8 @@ register_field_from_tgt (const Field& tgt) { src.allocate_view(); register_field(src,tgt); + + return src; } void AbstractRemapper::registration_ends () @@ -106,13 +103,11 @@ void AbstractRemapper::remap_fwd () "Error! Cannot perform remapping at this time.\n" " Did you forget to call 'registration_ends'?\n"); - if (m_state!=RepoState::Clean) { - EKAT_REQUIRE_MSG (m_fwd_allowed, - "Error! Forward remap is not allowed by this remapper.\n"); - EKAT_REQUIRE_MSG (not m_has_read_only_tgt_fields, - "Error! Forward remap IS allowed by this remapper, but some of the tgt fields are read-only\n"); - remap_fwd_impl (); - } + EKAT_REQUIRE_MSG (m_fwd_allowed, + "Error! Forward remap is not allowed by this remapper.\n"); + EKAT_REQUIRE_MSG (not m_has_read_only_tgt_fields, + "Error! Forward remap IS allowed by this remapper, but some of the tgt fields are read-only\n"); + remap_fwd_impl (); } void AbstractRemapper::remap_bwd () @@ -121,13 +116,11 @@ void AbstractRemapper::remap_bwd () "Error! Cannot perform remapping at this time.\n" " Did you forget to call 'registration_ends'?\n"); - if (m_state!=RepoState::Clean) { - EKAT_REQUIRE_MSG (m_bwd_allowed, - "Error! Backward remap is not allowed by this remapper.\n"); - EKAT_REQUIRE_MSG (not m_has_read_only_src_fields, - "Error! Backward remap IS allowed by this remapper, but some of the src fields are read-only\n"); - remap_bwd_impl (); - } + EKAT_REQUIRE_MSG (m_bwd_allowed, + "Error! Backward remap is not allowed by this remapper.\n"); + EKAT_REQUIRE_MSG (not m_has_read_only_src_fields, + "Error! Backward remap IS allowed by this remapper, but some of the src fields are read-only\n"); + remap_bwd_impl (); } void AbstractRemapper:: diff --git a/components/eamxx/src/share/grid/remap/abstract_remapper.hpp b/components/eamxx/src/share/grid/remap/abstract_remapper.hpp index a8dd0c38f751..c935db5fd586 100644 --- a/components/eamxx/src/share/grid/remap/abstract_remapper.hpp +++ b/components/eamxx/src/share/grid/remap/abstract_remapper.hpp @@ -33,20 +33,16 @@ class AbstractRemapper // ----- Registration/setup methods ---- // - // Call this before you begin registering fields with this remapper. - void registration_begins (); - // This method registers a source field to be remapped to a target field. void register_field (const Field& src, const Field& tgt); // Like the above, but create tgt/src internally - virtual void register_field_from_src (const Field& src); - virtual void register_field_from_tgt (const Field& tgt); + virtual Field register_field_from_src (const Field& src); + virtual Field register_field_from_tgt (const Field& tgt); // Call this to indicate that field registration is complete. void registration_ends (); - // ------- Getter methods ------- // RepoState get_state () const { return m_state; } diff --git a/components/eamxx/src/share/grid/remap/coarsening_remapper.cpp b/components/eamxx/src/share/grid/remap/coarsening_remapper.cpp index 5646de8a2e1a..930d571c7323 100644 --- a/components/eamxx/src/share/grid/remap/coarsening_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/coarsening_remapper.cpp @@ -27,7 +27,6 @@ CoarseningRemapper (const grid_ptr_type& src_grid, // Replicate the src grid geo data in the tgt grid. We use this remapper to do // the remapping (if needed), and clean it up afterwards. const auto& src_geo_data_names = src_grid->get_geometry_data_names(); - registration_begins(); for (const auto& name : src_geo_data_names) { // Since different remappers may share the same data (if the map file is the same) // the coarse grid may already have the geo data. diff --git a/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.cpp b/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.cpp index 6b6d382b2fb9..2ae1c96df0c4 100644 --- a/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.cpp +++ b/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.cpp @@ -88,41 +88,10 @@ get_my_triplets (const std::string& map_file) const scorpio::release_file(map_file); - // 1.2 Dofs in grid are likely 0-based, while row/col ids in map file - // are likely 1-based. To match dofs, we need to offset the row/cols - // ids we just read in. - int map_file_min_row = std::numeric_limits::max(); - int map_file_min_col = std::numeric_limits::max(); - for (int id=0; idget_global_min_dof_gid(); - } else { - col_offset -= fine_grid->get_global_min_dof_gid(); - } - for (auto& id : rows) { - id -= row_offset; - } - for (auto& id : cols) { - id -= col_offset; - } - // Create a grid based on the row gids I read in (may be duplicated across ranks) - std::vector unique_gids; const auto& gids = type==InterpType::Refine ? rows : cols; - for (auto gid : gids) { - if (not ekat::contains(unique_gids,gid)) { - unique_gids.push_back(gid); - } - } + std::set temp (gids.begin(),gids.end()); + std::vector unique_gids (temp.begin(),temp.end()); auto io_grid = std::make_shared ("helper",unique_gids.size(),0,comm); auto io_grid_gids_h = io_grid->get_dofs_gids().get_view(); int k = 0; @@ -150,10 +119,18 @@ get_my_triplets (const std::string& map_file) const MPI_Type_create_struct (3,lengths,displacements,types,&mpi_triplet_t); MPI_Type_commit(&mpi_triplet_t); - // Create import-export - GridImportExport imp_exp (fine_grid,io_grid); + // Create import-export and gather my triplets std::map> my_triplets_map; - imp_exp.gather(mpi_triplet_t,io_triplets,my_triplets_map); + try { + GridImportExport imp_exp (fine_grid,io_grid); + imp_exp.gather(mpi_triplet_t,io_triplets,my_triplets_map); + } catch (...) { + // Print the map file name, to help debugging + std::cout << "[HorizRemapperData] Something went wrong while performing a grid import-export operation.\n" + << " - map file name : " << map_file << "\n" + << " - fine grid name: " << fine_grid->name() << "\n"; + throw; + } MPI_Type_free(&mpi_triplet_t); std::vector my_triplets; diff --git a/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.hpp b/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.hpp index e99a41e09bd0..760c3604701a 100644 --- a/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.hpp +++ b/components/eamxx/src/share/grid/remap/horiz_interp_remapper_data.hpp @@ -17,13 +17,16 @@ enum class InterpType { Coarsen }; -// A small struct to hold horiz remap data, which can -// be shared across multiple horiz remappers +// A small struct to hold horiz remap data, which can be shared across multiple horiz remappers +// NOTE: the client will call the build method, which will read the map file, and create the +// CRS matrix data for online interpolation. struct HorizRemapperData { using KT = KokkosTypes; template using view_1d = typename KT::template view_1d; + // The last argument specifies the base index for gids in the map file + // For ncremap-type files, all indices are 1-based void build (const std::string& map_file, const std::shared_ptr& fine_grid, const ekat::Comm& comm, diff --git a/components/eamxx/src/share/grid/remap/identity_remapper.cpp b/components/eamxx/src/share/grid/remap/identity_remapper.cpp index 6e8fa77a1e3c..cdef20508dcd 100644 --- a/components/eamxx/src/share/grid/remap/identity_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/identity_remapper.cpp @@ -12,29 +12,31 @@ IdentityRemapper (const grid_ptr_type grid, } void IdentityRemapper::set_aliasing (const Aliasing aliasing) { - EKAT_REQUIRE_MSG (get_state()==RepoState::Clean, + EKAT_REQUIRE_MSG (m_num_fields==0, "Error! Aliasing in IdentityRemapper must be set *before* registration starts.\n"); m_aliasing = aliasing; } -void IdentityRemapper::register_field_from_src (const Field& src) +Field IdentityRemapper::register_field_from_src (const Field& src) { EKAT_REQUIRE_MSG (m_aliasing!=SrcAliasTgt, "Error! Makes no sense to register from src and ask that src alias tgt.\n"); if (m_aliasing==TgtAliasSrc) { register_field(src,src); + return src; } else { - AbstractRemapper::register_field_from_src(src); + return AbstractRemapper::register_field_from_src(src); } } -void IdentityRemapper::register_field_from_tgt (const Field& tgt) +Field IdentityRemapper::register_field_from_tgt (const Field& tgt) { EKAT_REQUIRE_MSG (m_aliasing!=TgtAliasSrc, "Error! Makes no sense to register from tgt and ask that tgt alias src.\n"); if (m_aliasing==SrcAliasTgt) { register_field(tgt,tgt); + return tgt; } else { - AbstractRemapper::register_field_from_tgt(tgt); + return AbstractRemapper::register_field_from_tgt(tgt); } } diff --git a/components/eamxx/src/share/grid/remap/identity_remapper.hpp b/components/eamxx/src/share/grid/remap/identity_remapper.hpp index e958efbb90b2..1643de6619a0 100644 --- a/components/eamxx/src/share/grid/remap/identity_remapper.hpp +++ b/components/eamxx/src/share/grid/remap/identity_remapper.hpp @@ -33,8 +33,8 @@ class IdentityRemapper : public AbstractRemapper void set_aliasing (const Aliasing aliasing); - void register_field_from_src (const Field& src) override; - void register_field_from_tgt (const Field& tgt) override; + Field register_field_from_src (const Field& src) override; + Field register_field_from_tgt (const Field& tgt) override; protected: diff --git a/components/eamxx/src/share/grid/remap/inverse_remapper.hpp b/components/eamxx/src/share/grid/remap/inverse_remapper.hpp index 2733d7934ec5..517badaa701d 100644 --- a/components/eamxx/src/share/grid/remap/inverse_remapper.hpp +++ b/components/eamxx/src/share/grid/remap/inverse_remapper.hpp @@ -53,7 +53,6 @@ class InverseRemapper : public AbstractRemapper } void registration_ends_impl () override { - m_remapper->registration_begins(); for (int i=0; iregister_field(m_tgt_fields[i],m_src_fields[i]); } diff --git a/components/eamxx/src/share/io/eamxx_io_utils.cpp b/components/eamxx/src/share/io/eamxx_io_utils.cpp index 9cc5a0c3bfe3..0639150e910b 100644 --- a/components/eamxx/src/share/io/eamxx_io_utils.cpp +++ b/components/eamxx/src/share/io/eamxx_io_utils.cpp @@ -139,6 +139,8 @@ create_diagnostic (const std::string& diag_field_name, std::regex pot_temp ("(Liq)?PotentialTemperature$"); std::regex vert_layer ("(z|geopotential|height)_(mid|int)$"); std::regex horiz_avg ("([A-Za-z0-9_]+)_horiz_avg$"); + std::regex vert_contract ("([A-Za-z0-9_]+)_vert_(avg|sum)(_((dp|dz)_weighted))?$"); + std::regex zonal_avg (R"(([A-Za-z0-9_]+)_zonal_avg_(\d+)_bins$)"); std::string diag_name; std::smatch matches; @@ -179,7 +181,6 @@ create_diagnostic (const std::string& diag_field_name, params.set("wind_component",matches[1].str()); } else if (std::regex_search(diag_field_name,matches,backtend)) { diag_name = "AtmBackTendDiag"; - // Set the grid_name params.set("grid_name",grid->name()); params.set("tendency_name",matches[1].str()); } else if (std::regex_search(diag_field_name,matches,pot_temp)) { @@ -196,10 +197,26 @@ create_diagnostic (const std::string& diag_field_name, } else if (std::regex_search(diag_field_name,matches,horiz_avg)) { diag_name = "HorizAvgDiag"; - // Set the grid_name params.set("grid_name",grid->name()); params.set("field_name",matches[1].str()); } + else if (std::regex_search(diag_field_name,matches,vert_contract)) { + diag_name = "VertContractDiag"; + params.set("grid_name", grid->name()); + params.set("field_name", matches[1].str()); + params.set("contract_method", matches[2].str()); + // The 3rd match an optional _(dp|dz)_weighted, so check if it was matched + if (matches[3].matched) { + // note that the 4th match is (dp|dz)_weighted, while the 5th is (dp|dz) + params.set("weighting_method", matches[5].str()); + } + } + else if (std::regex_search(diag_field_name,matches,zonal_avg)) { + diag_name = "ZonalAvgDiag"; + params.set("grid_name", grid->name()); + params.set("field_name", matches[1].str()); + params.set("number_of_zonal_bins", matches[2].str()); + } else { // No existing special regex matches, so we assume that the diag field name IS the diag name. diff --git a/components/eamxx/src/share/io/eamxx_output_manager.cpp b/components/eamxx/src/share/io/eamxx_output_manager.cpp index c812449d2e5c..58bb2c75dfa9 100644 --- a/components/eamxx/src/share/io/eamxx_output_manager.cpp +++ b/components/eamxx/src/share/io/eamxx_output_manager.cpp @@ -127,6 +127,7 @@ setup (const std::shared_ptr& field_mgr, // geo data in the output file when we create it. if (m_save_grid_data) { std::map> grids; + DefaultMetadata meta; for (const auto& it : m_output_streams) { grids[it->get_io_grid()->name()] = it->get_io_grid(); } @@ -149,7 +150,13 @@ setup (const std::shared_ptr& field_mgr, continue; } if (use_suffix) { - fields.push_back(f.clone(f.name()+"_"+grid.second->m_short_name, grid.first)); + fields.push_back(f.clone(f.name() + grid.second->m_disambiguation_suffix, grid.first)); + + // Adjust long/std name, as the default metadata does not recognize the names with suffix + using stratts_t = std::map; + auto& str_atts = fields.back().get_header().get_extra_data("io: string attributes"); + str_atts["long_name"] = meta.get_longname(f.name()); + str_atts["standard_name"] = meta.get_standardname(f.name()); } else { fields.push_back(f.clone(f.name(), grid.first)); } diff --git a/components/eamxx/src/share/io/scorpio_output.cpp b/components/eamxx/src/share/io/scorpio_output.cpp index ca79383c4d9e..c7bc76723ea6 100644 --- a/components/eamxx/src/share/io/scorpio_output.cpp +++ b/components/eamxx/src/share/io/scorpio_output.cpp @@ -241,7 +241,6 @@ AtmosphereOutput (const ekat::Comm& comm, const ekat::ParameterList& params, // Now create a new FM on io grid, and create copies of output fields on that grid, // using the remapper to get the correct identifier on the tgt grid auto io_fm = std::make_shared(io_grid); - io_fm->registration_begins(); for (const auto& fname : m_fields_names) { const auto src = get_field(fname,"sim"); const auto tgt_fid = m_vert_remapper->create_tgt_fid(src.get_header().get_identifier()); @@ -256,7 +255,6 @@ AtmosphereOutput (const ekat::Comm& comm, const ekat::ParameterList& params, } // Register all output fields in the remapper. - m_vert_remapper->registration_begins(); for (const auto& fname : m_fields_names) { const auto src = get_field(fname,"sim"); const auto tgt = io_fm->get_field(src.name(), io_grid->name()); @@ -297,7 +295,6 @@ AtmosphereOutput (const ekat::Comm& comm, const ekat::ParameterList& params, // Create a FM on the horiz remapper tgt grid, and register fields on it auto io_fm = std::make_shared(io_grid); - io_fm->registration_begins(); for (const auto& fname : m_fields_names) { const auto src = get_field(fname,"before_horizontal_remap"); const auto tgt_fid = m_horiz_remapper->create_tgt_fid(src.get_header().get_identifier()); @@ -312,7 +309,6 @@ AtmosphereOutput (const ekat::Comm& comm, const ekat::ParameterList& params, } // Register all output fields in the remapper. - m_horiz_remapper->registration_begins(); for (const auto& fname : m_fields_names) { const auto src = get_field(fname,"before_horizontal_remap"); const auto tgt = io_fm->get_field(src.name(), io_grid->name()); @@ -794,7 +790,8 @@ void AtmosphereOutput::register_dimensions(const std::string& name) // If t==CMP, and the name stored in the layout is the default ("dim"), // we append also the extent, to allow different vector dims in the file - tag_name += tag_name=="dim" ? std::to_string(dims[i]) : ""; + // TODO: generalie this to all tags, for now hardcoding to dim and bin only + tag_name += (tag_name == "dim" or tag_name=="bin") ? std::to_string(dims[i]) : ""; auto is_partitioned = m_io_grid->get_partitioned_dim_tag()==tags[i]; int dim_len = is_partitioned @@ -877,6 +874,7 @@ void AtmosphereOutput::set_avg_cnt_tracking(const std::string& name, const Field // Now create and store a dev view to track the averaging count for this layout (if we are tracking) // We don't need to track average counts for files that are not tracking the time dim + using namespace ShortFieldTagsNames; const auto& avg_cnt_suffix = m_field_to_avg_cnt_suffix[name]; const auto size = layout.size(); const auto tags = layout.tags(); @@ -890,7 +888,8 @@ void AtmosphereOutput::set_avg_cnt_tracking(const std::string& name, const Field // If t==CMP, and the name stored in the layout is the default ("dim"), // we append also the extent, to allow different vector dims in the file - tag_name += tag_name=="dim" ? std::to_string(layout.dim(i)) : ""; + // TODO: generalize this to all tags, for now hardcoding to dim and bin only + tag_name += (tag_name=="dim" or tag_name=="bin") ? std::to_string(layout.dim(i)) : ""; avg_cnt_name += "_" + tag_name; } @@ -955,7 +954,7 @@ register_variables(const std::string& filename, auto tag_name = m_io_grid->has_special_tag_name(t) ? m_io_grid->get_special_tag_name(t) : layout.names()[i]; - if (tag_name=="dim") { + if (tag_name=="dim" or tag_name=="bin") { tag_name += std::to_string(layout.dim(i)); } vec_of_dims.push_back(tag_name); // Add dimensions string to vector of dims. @@ -1343,6 +1342,7 @@ AtmosphereOutput::create_diagnostic (const std::string& diag_field_name) auto diag = scream::create_diagnostic(diag_field_name,sim_grid); // Some diags need some extra setup or trigger extra behaviors + // TODO: move this to the diag class itself, then query bool + string std::string diag_avg_cnt_name = ""; auto& params = diag->get_params(); if (diag->name()=="FieldAtPressureLevel") { @@ -1358,6 +1358,10 @@ AtmosphereOutput::create_diagnostic (const std::string& diag_field_name) + params.get("height_units") + "_above_sealevel"; m_track_avg_cnt = m_track_avg_cnt || m_avg_type!=OutputAvgType::Instant; } + } else if (diag->name()=="AerosolOpticalDepth550nm") { + params.set("mask_value", m_fill_value); + m_track_avg_cnt = m_track_avg_cnt || m_avg_type!=OutputAvgType::Instant; + diag_avg_cnt_name = "_" + diag->name(); } // Ensure there's an entry in the map for this diag, so .at(diag_name) always works diff --git a/components/eamxx/src/share/io/tests/CMakeLists.txt b/components/eamxx/src/share/io/tests/CMakeLists.txt index 4733c5f22312..90b5b3a589fb 100644 --- a/components/eamxx/src/share/io/tests/CMakeLists.txt +++ b/components/eamxx/src/share/io/tests/CMakeLists.txt @@ -88,6 +88,12 @@ CreateUnitTest(io_remap_test "io_remap_test.cpp" MPI_RANKS 1 ${SCREAM_TEST_MAX_RANKS} ) +## Test remap output when map file is sub-sampling (ARM-style) +CreateUnitTest(io_horiz_sampling "io_horiz_sampling.cpp" + LIBS scream_io LABELS io remap + MPI_RANKS 1 ${SCREAM_TEST_MAX_RANKS} +) + ## Test single-column reader CreateUnitTest(io_scm_reader "io_scm_reader.cpp" LIBS scream_io LABELS io diff --git a/components/eamxx/src/share/io/tests/io_horiz_sampling.cpp b/components/eamxx/src/share/io/tests/io_horiz_sampling.cpp new file mode 100644 index 000000000000..62f6c306a045 --- /dev/null +++ b/components/eamxx/src/share/io/tests/io_horiz_sampling.cpp @@ -0,0 +1,165 @@ +#include +#include + +#include "diagnostics/register_diagnostics.hpp" + +#include "share/io/eamxx_output_manager.hpp" +#include "share/io/scorpio_input.hpp" +#include "share/io/eamxx_scorpio_interface.hpp" +#include "share/field/field_utils.hpp" +#include "share/util/eamxx_setup_random_test.hpp" + +#include "share/grid/point_grid.hpp" + +namespace scream { + +Field create_f (const std::string& name, + const FieldLayout layout, + const std::string& grid_name) +{ + const auto nondim = ekat::units::Units::nondimensional(); + FieldIdentifier fid(name,layout,nondim,grid_name); + Field f(fid); + f.allocate_view(); + return f; +} + +ekat::ParameterList output_params(const std::string& map_file) +{ + using strvec_t = std::vector; + + ekat::ParameterList params; + params.set("filename_prefix","horiz_sampling"); + params.set("averaging_type","instant"); + params.set("floating_point_precision","real"); + auto& oc = params.sublist("output_control"); + oc.set("frequency",1); + oc.set("frequency_units","nsteps"); + params.set("field_names",{"s2d","s3d"}); + params.set("horiz_remap_file",map_file); + + return params; +} + +void print (const std::string& msg, const ekat::Comm& comm) { + if (comm.am_i_root()) { + printf("%s",msg.c_str()); + } +} + +TEST_CASE("io_remap_test","io_remap_test") +{ + using gid_type = AbstractGrid::gid_type; + + // Init scorpio + ekat::Comm comm(MPI_COMM_WORLD); + scorpio::init_subsystem(comm); + + util::TimeStamp t0 ({2000,1,1},{0,0,0}); + + // Random number generation + using RPDF = std::uniform_real_distribution; + auto engine = setup_random_test(&comm); + RPDF pdf(0, 1); + + // Create src grid + const std::string& gname = "point_grid"; + const int ngcols_src = 10*comm.size(); + const int nlevs = 4; + const auto src_grid = create_point_grid (gname,ngcols_src,nlevs,comm); + const int nlcols_src = src_grid->get_num_local_dofs(); + const auto gids_src_h = src_grid->get_dofs_gids().get_view(); + + // Create remap file. The mapping strategy is simply to take every other column, + // but making sure to NOT pick the 1st one, so that the min col GID in map file is 2 + print (" -> Create remap file ... \n",comm); + const int ngcols_tgt = ngcols_src / 2; + const int nlcols_tgt = nlcols_src / 2; + std::vector col(nlcols_tgt), row(nlcols_tgt); + std::vector S(nlcols_tgt,1.0); + for (int i=0; i Create remap file ... done\n",comm); + + // Create random source data + print (" -> Create source data ... \n",comm); + + // Create the fields and randomize + auto s2d_src = create_f("s2d",src_grid->get_2d_scalar_layout(),gname); + auto s3d_src = create_f("s3d",src_grid->get_3d_scalar_layout(true),gname); + randomize(s2d_src,engine,pdf); + randomize(s3d_src,engine,pdf); + + // Stuff fields in a FieldManager, since that's what OuputManager wants + auto fm = std::make_shared (src_grid,RepoState::Closed); + fm->add_field(s2d_src); + fm->add_field(s3d_src); + fm->init_fields_time_stamp(t0); + print (" -> Create source data ... done\n",comm); + + print (" -> Write output ... \n",comm); + double dt = 1.5; + OutputManager om; + auto params = output_params(remap_filename); + om.initialize (comm, params, t0, false); + om.setup(fm,{gname}); + + om.init_timestep(t0,dt); + om.run(t0+dt); + om.finalize(); + print (" -> Write output ... done\n",comm); + + print (" -> Check output ... \n",comm); + + // Read output file + std::string filename = "horiz_sampling.INSTANT.nsteps_x1.np" + std::to_string(comm.size()) + "." + t0.to_string() + ".nc"; + auto tgt_grid = create_point_grid(gname + "_tgt",ngcols_tgt,nlevs,comm); + auto s2d_tgt = create_f("s2d",tgt_grid->get_2d_scalar_layout(),gname+"_tgt"); + auto s3d_tgt = create_f("s3d",tgt_grid->get_3d_scalar_layout(true),gname+"_tgt"); + + AtmosphereInput reader(filename,tgt_grid,{s2d_tgt,s3d_tgt}); + reader.read_variables(); + reader.finalize(); // manually finalize, or scorpio cleanup will complain about a file still open + + // Check values + auto s2d_src_h = s2d_src.get_view(); + auto s3d_src_h = s3d_src.get_view(); + auto s2d_tgt_h = s2d_tgt.get_view(); + auto s3d_tgt_h = s3d_tgt.get_view(); + for (int i=0; i Check output ... done\n",comm); + + // Cleanup scorpio + scorpio::finalize_subsystem(); +} + +} //namespace scream diff --git a/components/eamxx/src/share/io/tests/io_remap_test.cpp b/components/eamxx/src/share/io/tests/io_remap_test.cpp index 1a2178370922..7deb0f817f53 100644 --- a/components/eamxx/src/share/io/tests/io_remap_test.cpp +++ b/components/eamxx/src/share/io/tests/io_remap_test.cpp @@ -87,10 +87,10 @@ TEST_CASE("io_remap_test","io_remap_test") const Real wgt = 0.4; for (int ii=0; ii get_test_fm(std::shared_ptr gr // Register fields with fm // Make sure packsize isn't bigger than the packsize for this machine, but not so big that we end up with only 1 pack. - fm->registration_begins(); fm->register_field(FR{fid_ps,"output"}); fm->register_field(FR{fid_pm,"output",Pack::n}); fm->register_field(FR{fid_pi,"output",Pack::n}); diff --git a/components/eamxx/src/share/io/tests/io_se_grid.cpp b/components/eamxx/src/share/io/tests/io_se_grid.cpp index 384ae98fd1b7..b4013ec79753 100644 --- a/components/eamxx/src/share/io/tests/io_se_grid.cpp +++ b/components/eamxx/src/share/io/tests/io_se_grid.cpp @@ -123,7 +123,6 @@ get_test_fm(const std::shared_ptr& grid, FieldIdentifier fid4("field_packed",grid->get_3d_scalar_layout(true),kg/m,gn); // Register fields with fm - fm->registration_begins(); fm->register_field(FR{fid1}); fm->register_field(FR{fid2}); fm->register_field(FR{fid3}); diff --git a/components/eamxx/src/share/io/tests/output_restart.cpp b/components/eamxx/src/share/io/tests/output_restart.cpp index cc9ad3d2a951..9c5cffa7826a 100644 --- a/components/eamxx/src/share/io/tests/output_restart.cpp +++ b/components/eamxx/src/share/io/tests/output_restart.cpp @@ -182,7 +182,6 @@ get_test_fm(const std::shared_ptr& grid) FieldIdentifier fid5("field_5",rad_vector_3d,m*m, gn); // Register fields with fm - fm->registration_begins(); fm->register_field(FR{fid1,SL{"output"}}); fm->register_field(FR{fid2,SL{"output"}}); fm->register_field(FR{fid3,SL{"output"}}); @@ -203,9 +202,7 @@ get_test_fm(const std::shared_ptr& grid) std::shared_ptr clone_fm(const std::shared_ptr& src) { - auto copy = std::make_shared(src->get_grid()); - copy->registration_begins(); - copy->registration_ends(); + auto copy = std::make_shared(src->get_grid(),RepoState::Closed); for (auto it : src->get_repo()) { copy->add_field(it.second->clone()); } diff --git a/components/eamxx/src/share/property_checks/field_within_interval_check.cpp b/components/eamxx/src/share/property_checks/field_within_interval_check.cpp index b8822badc4af..23ae05fe53cc 100644 --- a/components/eamxx/src/share/property_checks/field_within_interval_check.cpp +++ b/components/eamxx/src/share/property_checks/field_within_interval_check.cpp @@ -96,11 +96,11 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check_impl () const { auto v = f.template get_view(); Kokkos::parallel_reduce(size, KOKKOS_LAMBDA(int i, minmaxloc_value_t& result) { - if (v(i)= result.min_val)) { result.min_val = v(i); result.min_loc = i; } - if (v(i)>result.max_val) { + if (not (v(i) <= result.max_val)) { result.max_val = v(i); result.max_loc = i; } @@ -113,11 +113,11 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check_impl () const Kokkos::parallel_reduce(size, KOKKOS_LAMBDA(int idx, minmaxloc_value_t& result) { int i,j; unflatten_idx(idx,extents,i,j); - if (v(i,j)= result.min_val)) { result.min_val = v(i,j); result.min_loc = idx; } - if (v(i,j)>result.max_val) { + if (not (v(i,j) <= result.max_val)) { result.max_val = v(i,j); result.max_loc = idx; } @@ -130,11 +130,11 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check_impl () const Kokkos::parallel_reduce(size, KOKKOS_LAMBDA(int idx, minmaxloc_value_t& result) { int i,j,k; unflatten_idx(idx,extents,i,j,k); - if (v(i,j,k)= result.min_val)) { result.min_val = v(i,j,k); result.min_loc = idx; } - if (v(i,j,k)>result.max_val) { + if (not (v(i,j,k) <= result.max_val)) { result.max_val = v(i,j,k); result.max_loc = idx; } @@ -147,11 +147,11 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check_impl () const Kokkos::parallel_reduce(size, KOKKOS_LAMBDA(int idx, minmaxloc_value_t& result) { int i,j,k,l; unflatten_idx(idx,extents,i,j,k,l); - if (v(i,j,k,l)= result.min_val)) { result.min_val = v(i,j,k,l); result.min_loc = idx; } - if (v(i,j,k,l)>result.max_val) { + if (not (v(i,j,k,l) <= result.max_val)) { result.max_val = v(i,j,k,l); result.max_loc = idx; } @@ -164,11 +164,11 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check_impl () const Kokkos::parallel_reduce(size, KOKKOS_LAMBDA(int idx, minmaxloc_value_t& result) { int i,j,k,l,m; unflatten_idx(idx,extents,i,j,k,l,m); - if (v(i,j,k,l,m)= result.min_val)) { result.min_val = v(i,j,k,l,m); result.min_loc = idx; } - if (v(i,j,k,l,m)>result.max_val) { + if (not (v(i,j,k,l,m) <= result.max_val)) { result.max_val = v(i,j,k,l,m); result.max_loc = idx; } @@ -181,11 +181,11 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check_impl () const Kokkos::parallel_reduce(size, KOKKOS_LAMBDA(int idx, minmaxloc_value_t& result) { int i,j,k,l,m,n; unflatten_idx(idx,extents,i,j,k,l,m,n); - if (v(i,j,k,l,m,n)= result.min_val)) { result.min_val = v(i,j,k,l,m,n); result.min_loc = idx; } - if (v(i,j,k,l,m,n)>result.max_val) { + if (not (v(i,j,k,l,m,n) <= result.max_val)) { result.max_val = v(i,j,k,l,m,n); result.max_loc = idx; } diff --git a/components/eamxx/src/share/tests/coarsening_remapper_tests.cpp b/components/eamxx/src/share/tests/coarsening_remapper_tests.cpp index 16df958b9800..799772f3d380 100644 --- a/components/eamxx/src/share/tests/coarsening_remapper_tests.cpp +++ b/components/eamxx/src/share/tests/coarsening_remapper_tests.cpp @@ -337,7 +337,6 @@ TEST_CASE("coarsening_remap") // Register fields in the remapper // // -------------------------------------- // - remap->registration_begins(); for (size_t i=0; iregister_field(src_f[i],tgt_f[i]); } diff --git a/components/eamxx/src/share/tests/eamxx_time_interpolation_tests.cpp b/components/eamxx/src/share/tests/eamxx_time_interpolation_tests.cpp index 5e8e274ad261..7698205610a5 100644 --- a/components/eamxx/src/share/tests/eamxx_time_interpolation_tests.cpp +++ b/components/eamxx/src/share/tests/eamxx_time_interpolation_tests.cpp @@ -344,9 +344,7 @@ std::shared_ptr get_fm (const std::shared_ptr& FL({COL,CMP,ILEV}, {nlcols,2,nlevs+1}) }; - auto fm = std::make_shared(grid); - fm->registration_begins(); - fm->registration_ends(); + auto fm = std::make_shared(grid,RepoState::Closed); const auto units = ekat::units::Units::nondimensional(); for (const auto& fl : layouts) { diff --git a/components/eamxx/src/share/tests/field_tests.cpp b/components/eamxx/src/share/tests/field_tests.cpp index 606a9f2a073e..0d7fa220c987 100644 --- a/components/eamxx/src/share/tests/field_tests.cpp +++ b/components/eamxx/src/share/tests/field_tests.cpp @@ -271,6 +271,10 @@ TEST_CASE("field", "") { auto g1_x0 = f1.subfield(1,0); auto g1_x1 = f1.subfield(1,1); + // Check we preserve parent info + auto f1_0x_p = f1_0x.get_header().get_parent(); + REQUIRE (f1_0x.alias("foo").get_header().get_parent()==f1_0x_p); + REQUIRE (f1_0x.is_aliasing(g1_0x)); REQUIRE (f1_1x.is_aliasing(g1_1x)); REQUIRE (f1_x0.is_aliasing(g1_x0)); @@ -463,11 +467,6 @@ TEST_CASE("field_mgr", "") { auto gm = std::make_shared(g1, g2); FieldManager field_mgr(gm); - // Should not be able to register fields yet - REQUIRE_THROWS(field_mgr.register_field(FR(fid1_1))); - - field_mgr.registration_begins(); - // === Valid registration calls === // field_mgr.register_field(FR(fid1_1,Pack1::n)); field_mgr.register_field(FR{fid1_2,Pack2::n}); @@ -588,8 +587,6 @@ TEST_CASE("tracers_group", "") { auto gm = std::make_shared(g1, g2); FieldManager field_mgr(gm); - field_mgr.registration_begins(); - using los = std::list; field_mgr.register_field(FR{qv_id,"tracers"}); field_mgr.register_field(FR{a_id,"tracers"}); diff --git a/components/eamxx/src/share/tests/iop_remapper_tests.cpp b/components/eamxx/src/share/tests/iop_remapper_tests.cpp index 6ede2ca20dcc..731d80c2df4a 100644 --- a/components/eamxx/src/share/tests/iop_remapper_tests.cpp +++ b/components/eamxx/src/share/tests/iop_remapper_tests.cpp @@ -141,8 +141,6 @@ TEST_CASE("iop_remap") LayoutType::Tensor3D }; - remap->registration_begins(); - bool midpoints = false; // midpoints is unused for 2d layouts for (auto l : layouts) { auto n = e2str(l); diff --git a/components/eamxx/src/share/tests/refining_remapper_p2p_tests.cpp b/components/eamxx/src/share/tests/refining_remapper_p2p_tests.cpp index c82d2db0e5f9..3454e7f60a8f 100644 --- a/components/eamxx/src/share/tests/refining_remapper_p2p_tests.cpp +++ b/components/eamxx/src/share/tests/refining_remapper_p2p_tests.cpp @@ -192,7 +192,6 @@ TEST_CASE ("refining_remapper") { { auto r = std::make_shared(tgt_grid,filename); auto src_grid = r->get_src_grid(); - r->registration_begins(); Field bad_src(FieldIdentifier("",src_grid->get_2d_scalar_layout(),ekat::units::m,src_grid->name(),DataType::IntType)); Field bad_tgt(FieldIdentifier("",tgt_grid->get_2d_scalar_layout(),ekat::units::m,tgt_grid->name(),DataType::IntType)); CHECK_THROWS (r->register_field(bad_src,bad_tgt)); // not allocated @@ -217,7 +216,6 @@ TEST_CASE ("refining_remapper") { auto s3d_tgt = create_field("s3d_tgt",LayoutType::Scalar3D,*tgt_grid); auto v3d_tgt = create_field("v3d_tgt",LayoutType::Vector3D,*tgt_grid); - r->registration_begins(); r->register_field(s2d_src,s2d_tgt); r->register_field(v2d_src,v2d_tgt); r->register_field(s3d_src,s3d_tgt); diff --git a/components/eamxx/src/share/tests/refining_remapper_rma_tests.cpp b/components/eamxx/src/share/tests/refining_remapper_rma_tests.cpp index a4457ffa2e4d..5b08c7ce41e6 100644 --- a/components/eamxx/src/share/tests/refining_remapper_rma_tests.cpp +++ b/components/eamxx/src/share/tests/refining_remapper_rma_tests.cpp @@ -247,7 +247,6 @@ TEST_CASE ("refining_remapper") { { auto r = std::make_shared(tgt_grid,filename); auto src_grid = r->get_src_grid(); - r->registration_begins(); Field bad_src(FieldIdentifier("",src_grid->get_2d_scalar_layout(),ekat::units::m,src_grid->name(),DataType::IntType)); Field bad_tgt(FieldIdentifier("",tgt_grid->get_2d_scalar_layout(),ekat::units::m,tgt_grid->name(),DataType::IntType)); CHECK_THROWS (r->register_field(bad_src,bad_tgt)); // not allocated @@ -272,7 +271,6 @@ TEST_CASE ("refining_remapper") { auto s3d_tgt = create_field("s3d_tgt",LayoutType::Scalar3D,*tgt_grid); auto v3d_tgt = create_field("v3d_tgt",LayoutType::Vector3D,*tgt_grid); - r->registration_begins(); r->register_field(s2d_src,s2d_tgt); r->register_field(v2d_src,v2d_tgt); r->register_field(s3d_src,s3d_tgt); diff --git a/components/eamxx/src/share/tests/utils_tests.cpp b/components/eamxx/src/share/tests/utils_tests.cpp index 0d62f3e3ab01..472a8ec0b59f 100644 --- a/components/eamxx/src/share/tests/utils_tests.cpp +++ b/components/eamxx/src/share/tests/utils_tests.cpp @@ -144,6 +144,12 @@ TEST_CASE ("time_stamp") { REQUIRE (ts2.get_num_steps()==6); } + SECTION ("fractional_update") { + // Check update with fractional seconds + REQUIRE ((ts1+0.999)==ts1); + REQUIRE ((ts1+0.9999)!=ts1); // When seconds frac is <0.001 or >0.999 we round + } + SECTION ("leap_years") { // Check leap year correctness TS ts2({2000,2,28},{23,59,59}); diff --git a/components/eamxx/src/share/tests/vertical_remapper_tests.cpp b/components/eamxx/src/share/tests/vertical_remapper_tests.cpp index 448aeb749cb7..d997587e1ab4 100644 --- a/components/eamxx/src/share/tests/vertical_remapper_tests.cpp +++ b/components/eamxx/src/share/tests/vertical_remapper_tests.cpp @@ -458,7 +458,6 @@ TEST_CASE ("vertical_remapper") { REQUIRE_THROWS (remap->set_mask_value(std::numeric_limits::quiet_NaN())); remap->set_mask_value(mask_val); // Only needed if top and/or bot use etype=Mask - remap->registration_begins(); remap->register_field(src_s2d, tgt_s2d); remap->register_field(src_v2d, tgt_v2d); remap->register_field(src_s3d_m,tgt_s3d_m); diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp index 3412f320b0e3..013fd658d2d4 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -515,14 +515,11 @@ setup_vert_remapper (const RemapData& data) void DataInterpolation::register_fields_in_remappers () { // Register fields in the remappers. Vertical first, since we only have model-grid fields - m_vert_remapper->registration_begins(); for (int i=0; iregister_field_from_tgt(m_fields[i]); } m_vert_remapper->registration_ends(); - m_horiz_remapper_beg->registration_begins(); - m_horiz_remapper_end->registration_begins(); for (int i=0; iget_src_field(i); m_horiz_remapper_beg->register_field_from_tgt(f.clone(f.name(), m_horiz_remapper_beg->get_src_grid()->name())); diff --git a/components/eamxx/src/share/util/eamxx_time_interpolation.cpp b/components/eamxx/src/share/util/eamxx_time_interpolation.cpp index 080e3435ab76..ba09db3be217 100644 --- a/components/eamxx/src/share/util/eamxx_time_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_time_interpolation.cpp @@ -12,12 +12,8 @@ TimeInterpolation::TimeInterpolation( ) { // Given the grid initialize field managers to store interpolation data - m_fm_time0 = std::make_shared(grid); - m_fm_time1 = std::make_shared(grid); - m_fm_time0->registration_begins(); - m_fm_time0->registration_ends(); - m_fm_time1->registration_begins(); - m_fm_time1->registration_ends(); + m_fm_time0 = std::make_shared(grid,RepoState::Closed); + m_fm_time1 = std::make_shared(grid,RepoState::Closed); } /*-----------------------------------------------------------------------------------------------*/ TimeInterpolation::TimeInterpolation( diff --git a/components/eamxx/src/share/util/eamxx_time_stamp.cpp b/components/eamxx/src/share/util/eamxx_time_stamp.cpp index b064d57e4669..2665c293d8dd 100644 --- a/components/eamxx/src/share/util/eamxx_time_stamp.cpp +++ b/components/eamxx/src/share/util/eamxx_time_stamp.cpp @@ -128,7 +128,8 @@ std::string TimeStamp::get_time_string () const { } double TimeStamp::frac_of_year_in_days () const { - double doy = (m_date[2]-1) + sec_of_day() / 86400.0; // WARNING: avoid integer division + double doy = m_date[2]-1; + doy += (sec_of_day() + m_sec_fraction) / 86400.0; for (int m=1; m=0, "Error! Cannot rewind time.\n"); - EKAT_REQUIRE_MSG ((seconds-round(seconds))::epsilon()*10, - "Error! Cannot update TimeStamp with non-integral number of seconds " << seconds << "\n"); - EKAT_REQUIRE_MSG(is_valid(), "Error! The time stamp contains uninitialized values.\n" " To use this object, use operator= with a valid rhs first.\n"); + // Allow updating with fractional seconds (useful in case of subcycling) + // The time stamp will never print fractions, but will allow them, keeping + // a runningy tally. To avoid carrying rounding for too long, whenever we get + // within 1ms of a round second, we reset the tally to 0 and round the seconds + m_sec_fraction += seconds; + m_sec_fraction = std::modf(m_sec_fraction,&seconds); + if (m_sec_fraction<1e-3) { + m_sec_fraction = 0; + } else if (m_sec_fraction>0.999) { + m_sec_fraction = 0; + seconds += 1; + } + auto& sec = m_time[2]; auto& min = m_time[1]; auto& hour = m_time[0]; @@ -238,7 +247,7 @@ bool operator<= (const TimeStamp& ts1, const TimeStamp& ts2) { return false; } -TimeStamp operator+ (const TimeStamp& ts, const int dt) { +TimeStamp operator+ (const TimeStamp& ts, const double dt) { TimeStamp sum = ts; sum += dt; return sum; diff --git a/components/eamxx/src/share/util/eamxx_time_stamp.hpp b/components/eamxx/src/share/util/eamxx_time_stamp.hpp index 1fd1c04e4215..7831b53ea954 100644 --- a/components/eamxx/src/share/util/eamxx_time_stamp.hpp +++ b/components/eamxx/src/share/util/eamxx_time_stamp.hpp @@ -58,7 +58,7 @@ class TimeStamp { TimeStamp& operator= (const TimeStamp&) = default; // This method checks that time shifts forward (i.e. that seconds is positive) - TimeStamp& operator+= (const double seconds); + TimeStamp& operator+= (double seconds); // Clones the stamps and sets num steps to given value. If -1, clones num steps too TimeStamp clone (const int num_steps); @@ -67,15 +67,20 @@ class TimeStamp { std::vector m_date; // [year, month, day] std::vector m_time; // [hour, min, sec] + double m_sec_fraction = 0; int m_num_steps = std::numeric_limits::lowest(); // Number of steps since simulation started }; // Overload operators for TimeStamp bool operator== (const TimeStamp& ts1, const TimeStamp& ts2); +inline bool operator!= (const TimeStamp& ts1, const TimeStamp& ts2) +{ + return not (ts1==ts2); +} bool operator< (const TimeStamp& ts1, const TimeStamp& ts2); bool operator<= (const TimeStamp& ts1, const TimeStamp& ts2); -TimeStamp operator+ (const TimeStamp& ts, const int dt); +TimeStamp operator+ (const TimeStamp& ts, const double dt); // Difference (in seconds) between two timestamps std::int64_t operator- (const TimeStamp& ts1, const TimeStamp& ts2); diff --git a/components/eamxx/src/share/util/eamxx_utils.cpp b/components/eamxx/src/share/util/eamxx_utils.cpp index 17ba48ebf038..69e4927a061c 100644 --- a/components/eamxx/src/share/util/eamxx_utils.cpp +++ b/components/eamxx/src/share/util/eamxx_utils.cpp @@ -73,4 +73,8 @@ std::vector globloc(const std::string& pattern) { return filenames; } +// Instantiate non-const static members of DefaultMetadata class +std::map DefaultMetadata::name_2_standardname; +std::map DefaultMetadata::name_2_longname; + } // namespace scream diff --git a/components/eamxx/src/share/util/eamxx_utils.hpp b/components/eamxx/src/share/util/eamxx_utils.hpp index a24891a9d61d..2b30a1c471ac 100644 --- a/components/eamxx/src/share/util/eamxx_utils.hpp +++ b/components/eamxx/src/share/util/eamxx_utils.hpp @@ -374,38 +374,38 @@ struct DefaultMetadata { // struct to store default metadata for variables output // See the io_metadata folder for the file of interest - // Default string to fill in missing metadata - std::string fill_str = "MISSING"; - - std::map name_2_standardname, name_2_longname; + static std::map name_2_standardname; + static std::map name_2_longname; DefaultMetadata() { - // Ensure to resolve the path to the io_metadata.csv file - std::string fpath = __FILE__; - std::string directory = fpath.substr(0, fpath.find_last_of("/\\")); - std::string csv_path = directory + "/io_metadata/io_metadata.csv"; - read_csv_file_to_maps(csv_path, name_2_standardname, name_2_longname); + if (name_2_standardname.size()==0) { + // Ensure to resolve the path to the io_metadata.csv file + std::string fpath = __FILE__; + std::string directory = fpath.substr(0, fpath.find_last_of("/\\")); + std::string csv_path = directory + "/io_metadata/io_metadata.csv"; + read_csv_file_to_maps(csv_path, name_2_standardname, name_2_longname); + } } - std::string get_standardname(const std::string &name) const { + static std::string get_standardname(const std::string &name) { auto it = name_2_standardname.find(name); if(it != name_2_standardname.end()) { return it->second; } else { - return fill_str; + return "MISSING"; } } - std::string get_longname(const std::string &name) const { + static std::string get_longname(const std::string &name) { auto it = name_2_longname.find(name); if(it != name_2_longname.end()) { return it->second; } else { - return fill_str; + return "MISSING"; } } - void read_csv_file_to_maps( + static void read_csv_file_to_maps( const std::string &filename, std::map &name_2_standardname, std::map &name_2_longname) { @@ -436,8 +436,8 @@ struct DefaultMetadata { } // Store the values to the maps, if they are not empty - name_2_standardname[column1] = column2.empty() ? fill_str : column2; - name_2_longname[column1] = column3.empty() ? fill_str : column3; + name_2_standardname[column1] = column2.empty() ? "MISSING" : column2; + name_2_longname[column1] = column3.empty() ? "MISSING" : column3; } file.close(); } diff --git a/components/eamxx/src/share/util/io_metadata/io_metadata.csv b/components/eamxx/src/share/util/io_metadata/io_metadata.csv index 61cefc48fa1b..ea3eca6096dd 100644 --- a/components/eamxx/src/share/util/io_metadata/io_metadata.csv +++ b/components/eamxx/src/share/util/io_metadata/io_metadata.csv @@ -33,10 +33,11 @@ cldfrac_ice_at_cldtop,ice_cloud_area_fraction, cldfrac_ice,ice_cloud_area_fraction_in_atmosphere_layer, omega,lagrangian_tendency_of_air_pressure, landfrac,land_area_fraction, -latitude,latitude, +area,cell_area, +lat,latitude, cldfrac_liq_at_cldtop,liquid_water_cloud_area_fraction, cldfrac_liq,liquid_water_cloud_area_fraction_in_atmosphere_layer, -longitude,longitude, +lon,longitude, rainfrac,mass_fraction_of_liquid_precipitation_in_air, V,northward_wind, nc,number_concentration_of_cloud_liquid_water_particles_in_air, diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml index 456052173e7a..f255ff4896f7 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml @@ -55,6 +55,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml index 95dc1c36b575..d9ec89fa9838 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml @@ -60,6 +60,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml index ac556b385c08..357f40b8e821 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml @@ -51,6 +51,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml index cb59198f18b9..523bbb880b1e 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml @@ -51,6 +51,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp.cpp b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp.cpp index c1efa80da1fc..541d5dd207c0 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp.cpp +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp.cpp @@ -47,7 +47,7 @@ TEST_CASE("scream_homme_physics", "scream_homme_physics") { AtmosphereDriver ad; // Init, run, and finalize - // NOTE: Kokkos is finalize in ekat_catch_main.cpp, and YAKL is finalized + // NOTE: Kokkos is finalize in ekat_catch_main.cpp, and Kokkos is finalized // during RRTMGPRatiation::finalize_impl, after RRTMGP has deallocated // all its arrays. ad.set_comm(atm_comm); diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml index 208a51adf870..37aa3aa36fde 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml @@ -69,6 +69,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml index 5aa193627ef1..312bab66a388 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml @@ -77,6 +77,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false mam4_optics: mam4_mode1_physical_properties_file : ${SCREAM_DATA_DIR}/mam4xx/physprops/mam4_mode1_rrtmg_aeronetdust_c20240206.nc diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml index 72941aff856a..b5fc280e4fe5 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml @@ -57,6 +57,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false mam4_optics: mam4_mode1_physical_properties_file : ${SCREAM_DATA_DIR}/mam4xx/physprops/mam4_mode1_rrtmg_aeronetdust_c20240206.nc diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml index 4dd7d5685d3a..dc1ed07dc1c8 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml @@ -64,6 +64,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml index e4e36932eee3..1df269c0562f 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml @@ -55,6 +55,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] do_aerosol_rad: false diff --git a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml index e5cd556d3050..3078f11a5abc 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml @@ -55,6 +55,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] do_aerosol_rad: false diff --git a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml index 114e53548a2d..f38a26d2b78b 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml @@ -39,6 +39,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] do_aerosol_rad: false diff --git a/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml b/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml index a00154f9bb45..606652876da3 100644 --- a/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml @@ -27,6 +27,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false compute_tendencies: [tke] grids_manager: diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml index 6660f8ebea13..6ef2dbad369b 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml @@ -32,6 +32,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false mam4_aci: wsubmin: 0.001 top_level_mam4xx: 6 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml index 9af98a900c3e..d7343bf3ebb5 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml @@ -36,6 +36,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false mam4_optics: mam4_mode1_physical_properties_file : ${SCREAM_DATA_DIR}/mam4xx/physprops/mam4_mode1_rrtmg_aeronetdust_c20240206.nc mam4_mode2_physical_properties_file : ${SCREAM_DATA_DIR}/mam4xx/physprops/mam4_mode2_rrtmg_c20240206.nc diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml index a5185a403dc5..d2145d56d54e 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml @@ -36,6 +36,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml index 2afb0b6c64db..bc843cd7cbec 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml @@ -32,6 +32,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false grids_manager: type: mesh_free geo_data_source: IC_FILE diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml index e372818605a0..0137e35ef5ce 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml @@ -33,6 +33,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false grids_manager: type: mesh_free diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml index 30071dd99648..bb5169e4212d 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml @@ -29,6 +29,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false mam4_drydep: # Fractional land use file drydep_remap_file: "" diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml index 0389518e0fc4..36b214b41775 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml @@ -32,6 +32,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml index f6805d83d09d..e3d9fc1b5928 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml @@ -33,6 +33,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false rrtmgp: column_chunk_size: 123 active_gases: ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"] diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml index cb6dc55d6775..3925f5a1a6e6 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml @@ -34,6 +34,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false grids_manager: type: mesh_free diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml index fe0271554137..68ce36c984fd 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml @@ -35,6 +35,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false grids_manager: type: mesh_free diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml index 7d8a67ba763a..b8a24ed51f72 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml @@ -26,6 +26,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false grids_manager: type: mesh_free diff --git a/components/eamxx/tests/single-process/rrtmgp/CMakeLists.txt b/components/eamxx/tests/single-process/rrtmgp/CMakeLists.txt index c8b57e98948b..b7953b0e6103 100644 --- a/components/eamxx/tests/single-process/rrtmgp/CMakeLists.txt +++ b/components/eamxx/tests/single-process/rrtmgp/CMakeLists.txt @@ -6,25 +6,20 @@ set (FIXTURES_BASE_NAME ${TEST_BASE_NAME}_generate_output_nc_files) # Ensure test input files are present in the data dir GetInputFile(scream/init/${EAMxx_tests_IC_FILE_72lev}) -set(YAKL_LIB_NAME "") -if (SCREAM_RRTMGP_ENABLE_YAKL) - set(YAKL_LIB_NAME "yakl") -endif() - if (SCREAM_ENABLE_BASELINE_TESTS AND NOT SCREAM_ONLY_GENERATE_BASELINES) # Unit test to compare against raw rrtmgp output configure_file(${CMAKE_CURRENT_SOURCE_DIR}/input_unit.yaml ${CMAKE_CURRENT_BINARY_DIR}/input_unit.yaml) CreateUnitTest(${TEST_BASE_NAME}_unit rrtmgp_standalone_unit.cpp LABELS rrtmgp physics driver - LIBS scream_rrtmgp rrtmgp scream_control ${YAKL_LIB_NAME} diagnostics rrtmgp_test_utils + LIBS scream_rrtmgp rrtmgp scream_control diagnostics rrtmgp_test_utils EXE_ARGS "--args --rrtmgp_inputfile ${SCREAM_DATA_DIR}/init/rrtmgp-allsky.nc --rrtmgp_baseline ${SCREAM_BASELINES_DIR}/data/rrtmgp-allsky-baseline.nc" ) endif() ## Create rrtmgp stand alone executable CreateUnitTestExec(${TEST_BASE_NAME} "rrtmgp_standalone.cpp" - LIBS scream_rrtmgp rrtmgp scream_control ${YAKL_LIB_NAME} diagnostics + LIBS scream_rrtmgp rrtmgp scream_control diagnostics ) # The RRTMGP stand-alone test that runs multi-step diff --git a/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone.cpp b/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone.cpp index f5d575c79b1c..dc8bf9e8c62f 100644 --- a/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone.cpp +++ b/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone.cpp @@ -63,20 +63,23 @@ TEST_CASE("rrtmgp-stand-alone", "") { ap_old.request_allocation(ap_new.get_largest_pack_size()); sw_flux_up_old.allocate_view(); + int rad_freq = ad_params.sublist("atmosphere_processes").sublist("rrtmgp").get("rad_frequency"); // Start stepping if (atm_comm.am_i_root()) { printf("Start time stepping loop... [ 0%%]\n"); } - for (int i=0; i(); auto d_sw_flux_up_old = sw_flux_up_old.get_view(); - if (i == 0) { - REQUIRE(!views_are_equal(sw_flux_up_old, sw_flux_up)); - } else if (i == 1) { - REQUIRE(views_are_equal(sw_flux_up_old, sw_flux_up)); - } else if (i == 2) { - REQUIRE(views_are_equal(sw_flux_up_old, sw_flux_up)); - } else if (i == 3) { - REQUIRE(!views_are_equal(sw_flux_up_old, sw_flux_up)); + + if (istep==1 or istep%rad_freq==0) { + REQUIRE(!views_are_equal(sw_flux_up_old, sw_flux_up)); + } else { + REQUIRE(views_are_equal(sw_flux_up_old, sw_flux_up)); } } diff --git a/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone_unit.cpp b/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone_unit.cpp index be67bc9bc5b1..bc7c05b517c7 100644 --- a/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone_unit.cpp +++ b/components/eamxx/tests/single-process/rrtmgp/rrtmgp_standalone_unit.cpp @@ -19,12 +19,9 @@ #include #include -// RRTMGP and YAKL +// RRTMGP #include #include -#ifdef RRTMGP_ENABLE_YAKL -#include -#endif // System headers #include @@ -46,381 +43,6 @@ using PC = scream::physics::Constants; /* * Run standalone test through SCREAM driver this time */ -#ifdef RRTMGP_ENABLE_YAKL -TEST_CASE("rrtmgp_scream_standalone", "") { - // Get baseline name (needs to be passed as an arg) - std::string inputfile = ekat::TestSession::get().params.at("inputfile"); - std::string baseline = ekat::TestSession::get().params.at("baseline"); - - // Check if files exists - REQUIRE(rrtmgpTest::file_exists(inputfile.c_str())); - REQUIRE(rrtmgpTest::file_exists(baseline.c_str())); - - // Initialize yakl - if(!yakl::isInitialized()) { yakl::init(); } - - // Read reference fluxes from baseline file - real2d sw_flux_up_ref; - real2d sw_flux_dn_ref; - real2d sw_flux_dn_dir_ref; - real2d lw_flux_up_ref; - real2d lw_flux_dn_ref; - rrtmgpTest::read_fluxes(baseline, sw_flux_up_ref, sw_flux_dn_ref, sw_flux_dn_dir_ref, lw_flux_up_ref, lw_flux_dn_ref ); - - // Load ad parameter list - std::string fname = "input_unit.yaml"; - ekat::ParameterList ad_params("Atmosphere Driver"); - parse_yaml_file(fname,ad_params); - // Create a MPI communicator - ekat::Comm atm_comm (MPI_COMM_WORLD); - - // Need to register products in the factory *before* we create any atm process or grids manager. - register_physics (); - register_mesh_free_grids_manager(); - - // Create the driver - AtmosphereDriver ad; - - // Dummy timestamp - util::TimeStamp time ({2000,1,1},{0,0,0}); - - // Initialize the driver - ad.initialize(atm_comm, ad_params, time); - - /* - * Setup the dummy problem and overwrite default initial conditions - */ - - // Get dimension sizes from the field manager - const auto& grid = ad.get_grids_manager()->get_grid("point_grid"); - const auto& field_mgr = *ad.get_field_mgr(); - int ncol = grid->get_num_local_dofs(); - int nlay = grid->get_num_vertical_levels(); - - // In this test, we need to hack lat/lon. But the fields we get - // from the grid are read-only. Therefore, hack a bit, and cast - // away constness. It's bad, but it's only for this unit test - auto clat = grid->get_geometry_data("lat").get_view(); - auto clon = grid->get_geometry_data("lon").get_view(); - auto lat = const_cast(clat.data()); - auto lon = const_cast(clon.data()); - - // Get number of shortwave bands and number of gases from RRTMGP - int ngas = 8; // TODO: get this intelligently - - // Make sure we have the right dimension sizes - REQUIRE(nlay == static_cast(sw_flux_up_ref.dimension[1])-1); - - // Create yakl arrays to store the input data - auto p_lay = real2d("p_lay", ncol, nlay); - auto t_lay = real2d("t_lay", ncol, nlay); - auto p_del = real2d("p_del", ncol, nlay); - auto p_lev = real2d("p_lev", ncol, nlay+1); - auto t_lev = real2d("t_lev", ncol, nlay+1); - auto sfc_alb_dir_vis = real1d("sfc_alb_dir_vis", ncol); - auto sfc_alb_dir_nir = real1d("sfc_alb_dir_nir", ncol); - auto sfc_alb_dif_vis = real1d("sfc_alb_dif_vis", ncol); - auto sfc_alb_dif_nir = real1d("sfc_alb_dif_nir", ncol); - auto lwp = real2d("lwp", ncol, nlay); - auto iwp = real2d("iwp", ncol, nlay); - auto rel = real2d("rel", ncol, nlay); - auto rei = real2d("rei", ncol, nlay); - auto cld = real2d("cld", ncol, nlay); - auto mu0 = real1d("mu0", ncol); - auto gas_vmr = real3d("gas_vmr", ncol, nlay, ngas); - - // Setup dummy problem; need to use tmp arrays with ncol_all size - auto ncol_all = grid->get_num_global_dofs(); - auto p_lay_all = real2d("p_lay", ncol_all, nlay); - auto t_lay_all = real2d("t_lay", ncol_all, nlay); - auto p_lev_all = real2d("p_lev", ncol_all, nlay+1); - auto t_lev_all = real2d("t_lev", ncol_all, nlay+1); - auto sfc_alb_dir_vis_all = real1d("sfc_alb_dir_vis", ncol_all); - auto sfc_alb_dir_nir_all = real1d("sfc_alb_dir_nir", ncol_all); - auto sfc_alb_dif_vis_all = real1d("sfc_alb_dif_vis", ncol_all); - auto sfc_alb_dif_nir_all = real1d("sfc_alb_dif_nir", ncol_all); - auto lwp_all = real2d("lwp", ncol_all, nlay); - auto iwp_all = real2d("iwp", ncol_all, nlay); - auto rel_all = real2d("rel", ncol_all, nlay); - auto rei_all = real2d("rei", ncol_all, nlay); - auto cld_all = real2d("cld", ncol_all, nlay); - auto mu0_all = real1d("mu0", ncol_all); - // Read in dummy Garand atmosphere; if this were an actual model simulation, - // these would be passed as inputs to the driver - // NOTE: set ncol to size of col_flx dimension in the input file. This is so - // that we can compare to the reference data provided in that file. Note that - // this will copy the first column of the input data (the first profile) ncol - // times. We will then fill some fraction of these columns with clouds for - // the test problem. - GasConcs gas_concs; - real2d col_dry; - read_atmos(inputfile, p_lay_all, t_lay_all, p_lev_all, t_lev_all, gas_concs, col_dry, ncol_all); - // Setup dummy problem; need to use tmp arrays with ncol_all size - rrtmgpTest::dummy_atmos( - inputfile, ncol_all, p_lay_all, t_lay_all, - sfc_alb_dir_vis_all, sfc_alb_dir_nir_all, - sfc_alb_dif_vis_all, sfc_alb_dif_nir_all, - mu0_all, - lwp_all, iwp_all, rel_all, rei_all, cld_all - ); - // Populate our local input arrays with the proper columns, based on our rank - int irank = atm_comm.rank(); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<1>(ncol), YAKL_LAMBDA(int icol) { - auto icol_all = ncol * irank + icol; - sfc_alb_dir_vis(icol) = sfc_alb_dir_vis_all(icol_all); - sfc_alb_dir_nir(icol) = sfc_alb_dir_nir_all(icol_all); - sfc_alb_dif_vis(icol) = sfc_alb_dif_vis_all(icol_all); - sfc_alb_dif_nir(icol) = sfc_alb_dif_nir_all(icol_all); - mu0(icol) = mu0_all(icol_all); - }); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { - auto icol_all = ncol * irank + icol; - p_lay(icol,ilay) = p_lay_all(icol_all,ilay); - t_lay(icol,ilay) = t_lay_all(icol_all,ilay); - lwp(icol,ilay) = lwp_all(icol_all,ilay); - iwp(icol,ilay) = iwp_all(icol_all,ilay); - rel(icol,ilay) = rel_all(icol_all,ilay); - rei(icol,ilay) = rei_all(icol_all,ilay); - cld(icol,ilay) = cld_all(icol_all,ilay); - }); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay+1,ncol), YAKL_LAMBDA(int ilay, int icol) { - auto icol_all = ncol * irank + icol; - p_lev(icol,ilay) = p_lev_all(icol_all,ilay); - t_lev(icol,ilay) = t_lev_all(icol_all,ilay); - }); - // Free temporary variables - p_lay_all.deallocate(); - t_lay_all.deallocate(); - p_lev_all.deallocate(); - t_lev_all.deallocate(); - sfc_alb_dir_vis_all.deallocate(); - sfc_alb_dir_nir_all.deallocate(); - sfc_alb_dif_vis_all.deallocate(); - sfc_alb_dif_nir_all.deallocate(); - lwp_all.deallocate(); - iwp_all.deallocate(); - rel_all.deallocate(); - rei_all.deallocate(); - cld_all.deallocate(); - mu0_all.deallocate(); - - // Need to calculate a dummy pseudo_density for our test problem - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { - p_del(icol,ilay) = abs(p_lev(icol,ilay+1) - p_lev(icol,ilay)); - }); - - // We do not want to pass lwp and iwp through the FM, so back out qc and qi for this test - // NOTE: test problem provides lwp/iwp in g/m2, not kg/m2! Factor of 1e3 here! - auto qc = real2d("qc", ncol, nlay); - auto nc = real2d("nc", ncol, nlay); - auto qi = real2d("qi", ncol, nlay); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay, ncol), YAKL_LAMBDA(int ilay, int icol) { - qc(icol,ilay) = 1e-3 * lwp(icol,ilay) * cld(icol,ilay) * PC::gravit / p_del(icol,ilay); - qi(icol,ilay) = 1e-3 * iwp(icol,ilay) * cld(icol,ilay) * PC::gravit / p_del(icol,ilay); - }); - - // Copy gases from gas_concs to gas_vmr array - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<3>(ncol,nlay,ngas), YAKL_LAMBDA(int icol, int ilay, int igas) { - auto icol_all = ncol * irank + icol; - gas_vmr(icol,ilay,igas) = gas_concs.concs(icol_all,ilay,igas); - }); - gas_concs.reset(); - - // Before running, make a copy of T_mid so we can see changes - auto T_mid0 = real2d("T_mid0", ncol, nlay); - t_lay.deep_copy_to(T_mid0); - - // Grab views from field manager and copy in values from yakl arrays. Making - // copies is necessary since the yakl::Array take in data arranged with ncol - // as the fastest index, but the field manager expects the 2nd dimension as - // the fastest index. - auto d_pmid = field_mgr.get_field("p_mid").get_view(); - auto d_tmid = field_mgr.get_field("T_mid").get_view(); - auto d_pint = field_mgr.get_field("p_int").get_view(); - auto d_pdel = field_mgr.get_field("pseudo_density").get_view(); - auto d_sfc_alb_dir_vis = field_mgr.get_field("sfc_alb_dir_vis").get_view(); - auto d_sfc_alb_dir_nir = field_mgr.get_field("sfc_alb_dir_nir").get_view(); - auto d_sfc_alb_dif_vis = field_mgr.get_field("sfc_alb_dif_vis").get_view(); - auto d_sfc_alb_dif_nir = field_mgr.get_field("sfc_alb_dif_nir").get_view(); - auto d_surf_lw_flux_up = field_mgr.get_field("surf_lw_flux_up").get_view(); - auto d_qc = field_mgr.get_field("qc").get_view(); - auto d_nc = field_mgr.get_field("nc").get_view(); - auto d_qi = field_mgr.get_field("qi").get_view(); - auto d_rel = field_mgr.get_field("eff_radius_qc").get_view(); - auto d_rei = field_mgr.get_field("eff_radius_qi").get_view(); - auto d_cld = field_mgr.get_field("cldfrac_tot").get_view(); - - auto d_qv = field_mgr.get_field("qv").get_view(); - auto d_co2 = field_mgr.get_field("co2_volume_mix_ratio").get_view(); - auto d_o3 = field_mgr.get_field("o3_volume_mix_ratio").get_view(); - auto d_n2o = field_mgr.get_field("n2o_volume_mix_ratio").get_view(); - auto d_co = field_mgr.get_field("co_volume_mix_ratio").get_view(); - auto d_ch4 = field_mgr.get_field("ch4_volume_mix_ratio").get_view(); - auto d_o2 = field_mgr.get_field("o2_volume_mix_ratio").get_view(); - auto d_n2 = field_mgr.get_field("n2_volume_mix_ratio").get_view(); - - // Gather molecular weights of all the active gases in the test for conversion - // to mass-mixing-ratio. - { - const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, nlay); - Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { - const int i = team.league_rank(); - - // Set lat and lon to single value for just this test: - // Note, these values will ensure that the cosine zenith - // angle will end up matching the constant value meant for - // the test, which is 0.86 - lat[i] = 5.224000000000; - lon[i] = 167.282000000000; - - d_sfc_alb_dir_vis(i) = sfc_alb_dir_vis(i+1); - d_sfc_alb_dir_nir(i) = sfc_alb_dir_nir(i+1); - d_sfc_alb_dif_vis(i) = sfc_alb_dif_vis(i+1); - d_sfc_alb_dif_nir(i) = sfc_alb_dif_nir(i+1); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay), [&] (const int& k) { - d_pmid(i,k) = p_lay(i+1,k+1); - d_tmid(i,k) = t_lay(i+1,k+1); - d_pdel(i,k) = p_del(i+1,k+1); - d_qc(i,k) = qc(i+1,k+1); - d_nc(i,k) = nc(i+1,k+1); - d_qi(i,k) = qi(i+1,k+1); - d_rel(i,k) = rel(i+1,k+1); - d_rei(i,k) = rei(i+1,k+1); - d_cld(i,k) = cld(i+1,k+1); - d_pint(i,k) = p_lev(i+1,k+1); - // qv specified as a wet mixing ratio - Real qv_dry = gas_vmr(i+1,k+1,1)*PC::ep_2; - Real qv_wet = qv_dry/(1.0+qv_dry); - d_qv(i,k) = qv_wet; - // rest of active gases are specified as volume mixing ratios - d_co2(i,k) = gas_vmr(i+1,k+1,2); - d_o3(i,k) = gas_vmr(i+1,k+1,3); - d_n2o(i,k) = gas_vmr(i+1,k+1,4); - d_co(i,k) = gas_vmr(i+1,k+1,5); - d_ch4(i,k) = gas_vmr(i+1,k+1,6); - d_o2(i,k) = gas_vmr(i+1,k+1,7); - d_n2(i,k) = gas_vmr(i+1,k+1,8); - }); - - d_pint(i,nlay) = p_lev(i+1,nlay+1); - - // Compute surface flux from surface temperature - auto ibot = (p_lay(1,1) > p_lay(1,nlay)) ? 1 : nlay+1; - d_surf_lw_flux_up(i) = PC::stebol * pow(t_lev(i+1,ibot), 4.0); - }); - } - Kokkos::fence(); - - // Run driver - ad.run(300); - - // Check values; The correct values have been stored in the field manager, we need to - // copy back to YAKL::Array. - auto d_sw_flux_up = field_mgr.get_field("sw_flux_up").get_view(); - auto d_sw_flux_dn = field_mgr.get_field("sw_flux_dn").get_view(); - auto d_sw_flux_dn_dir = field_mgr.get_field("sw_flux_dn_dir").get_view(); - auto d_lw_flux_up = field_mgr.get_field("lw_flux_up").get_view(); - auto d_lw_flux_dn = field_mgr.get_field("lw_flux_dn").get_view(); - auto sw_flux_up_test = real2d("sw_flux_up_test", ncol, nlay+1); - auto sw_flux_dn_test = real2d("sw_flux_dn_test", ncol, nlay+1); - auto sw_flux_dn_dir_test = real2d("sw_flux_dn_dir_test", ncol, nlay+1); - auto lw_flux_up_test = real2d("lw_flux_up_test", ncol, nlay+1); - auto lw_flux_dn_test = real2d("lw_flux_dn_test", ncol, nlay+1); - { - const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol, nlay); - Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { - const int i = team.league_rank(); - - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlay+1), [&] (const int& k) { - if (k < nlay) t_lay(i+1,k+1) = d_tmid(i,k); - - sw_flux_up_test(i+1,k+1) = d_sw_flux_up(i,k); - sw_flux_dn_test(i+1,k+1) = d_sw_flux_dn(i,k); - sw_flux_dn_dir_test(i+1,k+1) = d_sw_flux_dn_dir(i,k); - lw_flux_up_test(i+1,k+1) = d_lw_flux_up(i,k); - lw_flux_dn_test(i+1,k+1) = d_lw_flux_dn(i,k); - }); - }); - } - Kokkos::fence(); - - // Dumb check to verify that we did indeed update temperature - REQUIRE(t_lay.createHostCopy()(1,1) != T_mid0.createHostCopy()(1,1)); - T_mid0.deallocate(); - - // Make sure fluxes from field manager that were calculated in AD call of RRTMGP match reference fluxes from input file - // We use all_close here instead of all_equals because we are only able - // to approximate the solar zenith angle used in the RRTMGP clear-sky - // test problem with our trial and error lat/lon values, so fluxes will - // be slightly off. We just verify that they are all "close" here, within - // some tolerance. Computation of level temperatures from midpoints is - // also unable to exactly reproduce the values in the test problem, so - // computed fluxes will be further off from the reference calculation. - // - // We need to create local copies with only the columns specific to our rank in case we have split columns over multiple ranks - auto sw_flux_up_loc = real2d("sw_flux_up_loc" , ncol, nlay+1); - auto sw_flux_dn_loc = real2d("sw_flux_dn_loc" , ncol, nlay+1); - auto sw_flux_dn_dir_loc = real2d("sw_flux_dn_dir_loc", ncol, nlay+1); - auto lw_flux_up_loc = real2d("lw_flux_up_loc" , ncol, nlay+1); - auto lw_flux_dn_loc = real2d("lw_flux_dn_loc" , ncol, nlay+1); - yakl::fortran::parallel_for(yakl::fortran::SimpleBounds<2>(nlay+1,ncol), YAKL_LAMBDA(int ilay, int icol) { - auto icol_all = ncol * irank + icol; - sw_flux_up_loc(icol,ilay) = sw_flux_up_ref(icol_all,ilay); - sw_flux_dn_loc(icol,ilay) = sw_flux_dn_ref(icol_all,ilay); - sw_flux_dn_dir_loc(icol,ilay) = sw_flux_dn_dir_ref(icol_all,ilay); - lw_flux_up_loc(icol,ilay) = lw_flux_up_ref(icol_all,ilay); - lw_flux_dn_loc(icol,ilay) = lw_flux_dn_ref(icol_all,ilay); - }); - REQUIRE(rrtmgpTest::all_close(sw_flux_up_loc , sw_flux_up_test , 1.0)); - REQUIRE(rrtmgpTest::all_close(sw_flux_dn_loc , sw_flux_dn_test , 1.0)); - REQUIRE(rrtmgpTest::all_close(sw_flux_dn_dir_loc, sw_flux_dn_dir_test, 1.0)); - REQUIRE(rrtmgpTest::all_close(lw_flux_up_loc , lw_flux_up_test , 1.0)); - REQUIRE(rrtmgpTest::all_close(lw_flux_dn_loc , lw_flux_dn_test , 1.0)); - - // Deallocate YAKL arrays - p_lay.deallocate(); - t_lay.deallocate(); - p_del.deallocate(); - p_lev.deallocate(); - t_lev.deallocate(); - sfc_alb_dir_vis.deallocate(); - sfc_alb_dir_nir.deallocate(); - sfc_alb_dif_vis.deallocate(); - sfc_alb_dif_nir.deallocate(); - lwp.deallocate(); - iwp.deallocate(); - rel.deallocate(); - rei.deallocate(); - cld.deallocate(); - qc.deallocate(); - nc.deallocate(); - qi.deallocate(); - mu0.deallocate(); - gas_vmr.deallocate(); - sw_flux_up_test.deallocate(); - sw_flux_dn_test.deallocate(); - sw_flux_dn_dir_test.deallocate(); - lw_flux_up_test.deallocate(); - lw_flux_dn_test.deallocate(); - sw_flux_up_ref.deallocate(); - sw_flux_dn_ref.deallocate(); - sw_flux_dn_dir_ref.deallocate(); - lw_flux_up_ref.deallocate(); - lw_flux_dn_ref.deallocate(); - sw_flux_up_loc.deallocate(); - sw_flux_dn_loc.deallocate(); - sw_flux_dn_dir_loc.deallocate(); - lw_flux_up_loc.deallocate(); - lw_flux_dn_loc.deallocate(); - col_dry.deallocate(); - - // Finalize the driver. YAKL will be finalized inside - // RRTMGPRadiation::finalize_impl after RRTMGP has had the - // opportunity to deallocate all it's arrays. - ad.finalize(); -} -#endif -#ifdef RRTMGP_ENABLE_KOKKOS TEST_CASE("rrtmgp_scream_standalone_k", "") { #ifdef RRTMGP_LAYOUT_LEFT using layout_t = Kokkos::LayoutLeft; @@ -442,7 +64,7 @@ TEST_CASE("rrtmgp_scream_standalone_k", "") { REQUIRE(rrtmgpTest::file_exists(inputfile.c_str())); REQUIRE(rrtmgpTest::file_exists(baseline.c_str())); - // Initialize yakl + // Initialize kokkos scream::init_kls(); // Read reference fluxes from baseline file @@ -497,7 +119,7 @@ TEST_CASE("rrtmgp_scream_standalone_k", "") { // Make sure we have the right dimension sizes REQUIRE(nlay == static_cast(sw_flux_up_ref.extent(1))-1); - // Create yakl arrays to store the input data + // Create kokkos arrays to store the input data auto p_lay = real2dk("p_lay", ncol, nlay); auto t_lay = real2dk("t_lay", ncol, nlay); auto p_del = real2dk("p_del", ncol, nlay); @@ -601,8 +223,8 @@ TEST_CASE("rrtmgp_scream_standalone_k", "") { auto T_mid0 = real2dk("T_mid0", ncol, nlay); Kokkos::deep_copy(T_mid0, t_lay); - // Grab views from field manager and copy in values from yakl arrays. Making - // copies is necessary since the yakl::Array take in data arranged with ncol + // Grab views from field manager and copy in values from kokkos arrays. Making + // copies is necessary since the kokkos::View take in data arranged with ncol // as the fastest index, but the field manager expects the 2nd dimension as // the fastest index. auto d_pmid = field_mgr.get_field("p_mid").get_view(); @@ -686,7 +308,7 @@ TEST_CASE("rrtmgp_scream_standalone_k", "") { ad.run(300); // Check values; The correct values have been stored in the field manager, we need to - // copy back to YAKL::Array. + // copy back to Kokkos::View. auto d_sw_flux_up = field_mgr.get_field("sw_flux_up").get_view(); auto d_sw_flux_dn = field_mgr.get_field("sw_flux_dn").get_view(); auto d_sw_flux_dn_dir = field_mgr.get_field("sw_flux_dn_dir").get_view(); @@ -748,11 +370,10 @@ TEST_CASE("rrtmgp_scream_standalone_k", "") { REQUIRE(utils_t::all_close(lw_flux_up_loc , lw_flux_up_test , 1.0)); REQUIRE(utils_t::all_close(lw_flux_dn_loc , lw_flux_dn_test , 1.0)); - // Finalize the driver. YAKL will be finalized inside + // Finalize the driver. Kokkos will be finalized inside // RRTMGPRadiation::finalize_impl after RRTMGP has had the // opportunity to deallocate all it's arrays. ad.finalize(); } -#endif } diff --git a/components/eamxx/tests/single-process/shoc/input.yaml b/components/eamxx/tests/single-process/shoc/input.yaml index ec20a7d3aafa..1bf705227e69 100644 --- a/components/eamxx/tests/single-process/shoc/input.yaml +++ b/components/eamxx/tests/single-process/shoc/input.yaml @@ -25,6 +25,7 @@ atmosphere_processes: c_diag_3rd_mom: 7.0 coeff_kh: 0.1 coeff_km: 0.1 + shoc_1p5tke: false grids_manager: type: mesh_free diff --git a/components/eamxx/tests/single-process/surface_coupling/surface_coupling.cpp b/components/eamxx/tests/single-process/surface_coupling/surface_coupling.cpp index c3a0b1a883f2..0e7cad0b5c7b 100644 --- a/components/eamxx/tests/single-process/surface_coupling/surface_coupling.cpp +++ b/components/eamxx/tests/single-process/surface_coupling/surface_coupling.cpp @@ -68,9 +68,7 @@ std::vector create_from_file_test_data(const ekat::Comm& comm, cons const auto dofs_gids = grid->get_dofs_gids().get_view(); std::vector fnames = {"lwdn"}; FieldLayout layout({COL},{nlcols}); - auto fm = std::make_shared(grid); - fm->registration_begins(); - fm->registration_ends(); + auto fm = std::make_shared(grid,RepoState::Closed); auto nondim = Units::nondimensional(); for (auto name : fnames) { FieldIdentifier fid(name,layout,nondim,grid->name()); diff --git a/components/elm/bld/ELMBuildNamelist.pm b/components/elm/bld/ELMBuildNamelist.pm index cbf067e67607..e5103bed89af 100755 --- a/components/elm/bld/ELMBuildNamelist.pm +++ b/components/elm/bld/ELMBuildNamelist.pm @@ -830,7 +830,18 @@ sub setup_cmdl_fates_mode { "use_fates_tree_damage", "use_century_decomp", "use_snicar_ad", - "use_vertsoilc"); + "use_vertsoilc", + "use_fates_daylength_factor", + "fates_photosynth_acclimation", + "fates_stomatal_model", + "fates_stomatal_assimilation", + "fates_leafresp_model", + "fates_cstarvation_model", + "fates_regeneration_model", + "fates_hydro_solver", + "fates_radiation_model", + "fates_electron_transport_model"); + foreach my $var ( @list ) { if ( defined($nl->get_value($var)) ) { $nl_flags->{$var} = $nl->get_value($var); @@ -3429,7 +3440,17 @@ sub setup_logic_fates { "use_fates_planthydro", "use_fates_potentialveg", "use_fates_sp", - "use_fates_tree_damage"); + "use_fates_tree_damage", + "use_fates_daylength_factor", + "fates_photosynth_acclimation", + "fates_stomatal_model", + "fates_stomatal_assimilation", + "fates_leafresp_model", + "fates_cstarvation_model", + "fates_regeneration_model", + "fates_hydro_solver", + "fates_radiation_model", + "fates_electron_transport_model"); foreach my $var (@list) { add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var,'use_fates'=>$nl_flags->{'use_fates'}); diff --git a/components/elm/bld/namelist_files/namelist_defaults.xml b/components/elm/bld/namelist_files/namelist_defaults.xml index dfa66a6da949..73fc58dbe65a 100644 --- a/components/elm/bld/namelist_files/namelist_defaults.xml +++ b/components/elm/bld/namelist_files/namelist_defaults.xml @@ -134,7 +134,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/fates_params_api.36.1.0_14pft_c241003.nc +lnd/clm2/paramdata/fates_params_api.40.0.0_14pft_c250512.nc lnd/clm2/paramdata/CNP_parameters_c131108.nc @@ -235,7 +235,13 @@ ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata/elmi.v3-SORRM.ne30pg2_r05_SOwISC12to30E3r3.1850-01-01-00000.c20240923.nc +sim_year="1850" glc_nec="0" use_crop=".false.">lnd/clm2/initdata/elmi.v3-SORRM.ne30pg2_r05_SOwISC12to30E3r3.1850-01-01-00000.c20250524.nc + + + + +lnd/clm2/initdata_map/elmi.CNPRDCTCBCTOP.r025_RRSwISC6to18E3r5.1850.c20250325.nc @@ -1757,7 +1763,7 @@ this mask will have smb calculated over the entire global land surface lnd/clm2/mappingdata/maps/0.5x0.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.5x0.5_nomask_aave_da_c190417.nc lnd/clm2/mappingdata/maps/0.5x0.5/map_0.01x0.01_nomask_to_0.5x0.5_nomask_aave_da_c240501.nc +>lnd/clm2/mappingdata/maps/0.5x0.5/map_0.01x0.01_nomask_to_0.5x0.5_nomask_aave_da_c250513.nc @@ -2145,7 +2151,7 @@ this mask will have smb calculated over the entire global land surface lnd/clm2/mappingdata/maps/0.25x0.25/map_0.5x0.5_GSDTG2000_to_0.25x0.25_nomask_aave_da_c240123.nc lnd/clm2/mappingdata/maps/0.25x0.25/map_0.01x0.01_nomask_to_0.25x0.25_nomask_aave_da_c240501.nc +>lnd/clm2/mappingdata/maps/0.25x0.25/map_0.01x0.01_nomask_to_0.25x0.25_nomask_aave_da_c250513.nc lnd/clm2/mappingdata/maps/0.25x0.25/map_0.1x0.1_nomask_to_0.25x0.25_nomask_aave_da_c240308.nc @@ -2215,35 +2221,45 @@ this mask will have smb calculated over the entire global land surface -0 -no_harvest -2,2 - "/dev/null" -1 -0 -.false. -.false. -.false. -.false. -.false. -.false. -.false. -.false. -.true. -.true. -.true. -.true. -.false. -.false. -.true. -.true. -.false. -.true. -.true. -.false. -.true. -.true. -.false. +0 +no_harvest +2,2 + "/dev/null" +1 +0 +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.true. +nonacclimating +ballberry1987 +net +ryan1991 +linear +default +1D_Taylor +norman +FvCB1980 +.true. +.true. +.true. +.true. +.false. +.false. +.true. +.true. +.false. +.true. +.true. +.false. +.true. +.true. +.false. .false. diff --git a/components/elm/bld/namelist_files/namelist_defaults_tools.xml b/components/elm/bld/namelist_files/namelist_defaults_tools.xml index f97a41314be0..446433b060ea 100644 --- a/components/elm/bld/namelist_files/namelist_defaults_tools.xml +++ b/components/elm/bld/namelist_files/namelist_defaults_tools.xml @@ -89,6 +89,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >lnd/clm2/mappingdata/grids/SCRIPgrid_0.9x1.25_GRDC_c130307.nc lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_GSDTG2000_c161010.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.01x0.01_nomask_c250510.nc diff --git a/components/elm/bld/namelist_files/namelist_definition.xml b/components/elm/bld/namelist_files/namelist_definition.xml index e5c5e9a2bcf7..c63aa2967625 100644 --- a/components/elm/bld/namelist_files/namelist_definition.xml +++ b/components/elm/bld/namelist_files/namelist_definition.xml @@ -360,6 +360,62 @@ Toggle to turn on FATES no competition mode (only relevant if FATES is being use Toggle to turn on FATES satellite phenology mode (only relevant if FATES is being used). + +Set the FATES radiation model + + + +Set the FATES electron transport model + + + +Set the FATES hydro solver method + + + +Set the FATES seed regeneration model +Valid values: + default: default scheme + trs: Tree Recruitment Scheme (Hanbury-Brown et al., 2022) + trs_no_seed_dyn: Tree Recruitment Scheme (Hanbury-Brown et al., 2022) without seed dynamics + + + +Set the FATES carbon starvation model + + + +Set the FATES leaf maintenance respiration model + + + +Set net or gross asslimiation for the FATES stomatal model + + + +Set the FATES stomatal conductance model + + + +Set the FATES photosynthesis temperature acclimation model. +(Only relevant if FATES is on) + + + +If TRUE, enable FATES to utilize the day length factor from the host land model. +(Only relevant if FATES is on) + + Toggle to turn on plant hydraulics (only relevant if FATES is on). @@ -1451,7 +1507,7 @@ Land mask description for mksurfdata input files + valid_values="0.1x0.1,0.5x0.5,10x10min,5x5min,360x720cru,0.9x1.25,19basin,1km-merge-10min,0.01x0.01"> Horizontal grid resolutions for mksurfdata input files @@ -1484,7 +1540,7 @@ CLM run type. +"512x1024,360x720cru,128x256,64x128,48x96,32x64,8x16,94x192,0.23x0.31,0.9x1.25,1.9x2.5,2.5x3.33,4x5,10x15,5x5_amazon,1x1_tropicAtl,1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ,1x1_brazil,1x1_icycape,1x1_urbanc_alpha,1x1_numaIA,1x1_smallvilleIA,0.1x0.1,0.5x0.5,3x3min,5x5min,10x10min,0.33x0.33,ne4np4,ne4np4.pg2,ne11np4,ne16np4,ne30np4,ne30np4.pg2,ne60np4,ne120np4,ne120np4.pg2,ne240np4,ne256np4,ne256np4.pg2,ne512np4.pg2,ne1024np4,ne1024np4.pg2,1km-merge-10min,ne0np4_CAx32v1.pg2,ne0np4_arm_x8v3_lowcon,ne0np4_conus_x4v1_lowcon,ne0np4_enax4v1,ne0np4_twpx4v1,r2,r05,r0125,NLDAS,ne0np4_northamericax4v1.pg2,ne0np4_arcticx4v1.pg2,r025,0.01x0.01"> Horizontal resolutions Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools diff --git a/components/elm/cime_config/config_pes.xml b/components/elm/cime_config/config_pes.xml index 39e36221175b..db0d6cc9b04c 100644 --- a/components/elm/cime_config/config_pes.xml +++ b/components/elm/cime_config/config_pes.xml @@ -59,7 +59,7 @@ - + elm: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0 @@ -89,21 +89,6 @@ - - - elm+gcp10: default 1 node - - 30 - 30 - 30 - 16 - 16 - 16 - 30 - 30 - - - elm+lawrencium-lr3: default, 2 nodes @@ -235,7 +220,7 @@ - + elm: pm-cpu 3 nodes for grid l%360x720cru @@ -316,31 +301,6 @@ - - - elm: gcp10 PEs for grid l%360x720cru, 4 nodes, 2 threads - - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 - - - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - - - @@ -358,7 +318,7 @@ - + @@ -409,7 +369,7 @@ - + elm: grid l%4x5 on 1 full node @@ -509,21 +469,6 @@ - - - gcp10 r05 4 nodes - - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 - - - elm: ascent|summit|improv PEs for grid l%r05_*r%r05 @@ -568,7 +513,7 @@ - + GIS 20km (low-res) testing config 128 @@ -606,7 +551,7 @@ - + GIS 1-to-10km (high-res) config 128 diff --git a/components/elm/cime_config/testdefs/testmods_dirs/elm/fates_cold_allvars/user_nl_elm b/components/elm/cime_config/testdefs/testmods_dirs/elm/fates_cold_allvars/user_nl_elm index 249764fb277d..be1d8e95b518 100644 --- a/components/elm/cime_config/testdefs/testmods_dirs/elm/fates_cold_allvars/user_nl_elm +++ b/components/elm/cime_config/testdefs/testmods_dirs/elm/fates_cold_allvars/user_nl_elm @@ -7,7 +7,7 @@ fates_history_dimlevel(2) = 2 use_fates_tree_damage = .true. hist_fincl1 = 'FATES_TLONGTERM', 'FATES_TGROWTH','FATES_SEEDS_IN_GRIDCELL_PF','FATES_SEEDS_OUT_GRIDCELL_PF','FATES_NCL_AP', -'FATES_NPATCH_AP','FATES_VEGC_AP','FATES_SECONDAREA_ANTHRODIST_AP','FATES_SECONDAREA_DIST_AP', +'FATES_NPATCH_AP','FATES_VEGC_AP','FATES_SECONDARY_ANTHRODISTAGE_AP','FATES_SECONDARY_AREA_AP', 'FATES_FUEL_AMOUNT_APFC','FATES_STOREC_TF_USTORY_SZPF','FATES_STOREC_TF_CANOPY_SZPF', 'FATES_CROWNAREA_CLLL','FATES_ABOVEGROUND_MORT_SZPF', 'FATES_ABOVEGROUND_PROD_SZPF','FATES_NPLANT_SZAP','FATES_NPLANT_CANOPY_SZAP', @@ -25,7 +25,7 @@ hist_fincl1 = 'FATES_TLONGTERM', 'FATES_MORTALITY_CROWNSCORCH_SZPF','FATES_MORTALITY_CAMBIALBURN_SZPF','FATES_MORTALITY_TERMINATION_SZPF', 'FATES_MORTALITY_LOGGING_SZPF','FATES_MORTALITY_FREEZING_SZPF','FATES_MORTALITY_SENESCENCE_SZPF', 'FATES_MORTALITY_AGESCEN_SZPF','FATES_MORTALITY_AGESCEN_ACPF','FATES_MORTALITY_CANOPY_SZPF', -'FATES_M3_MORTALITY_CANOPY_SZPF','FATES_M3_MORTALITY_USTORY_SZPF','FATES_C13DISC_SZPF', +'FATES_M3_MORTALITY_CANOPY_SZPF','FATES_M3_MORTALITY_USTORY_SZPF', 'FATES_STOREC_CANOPY_SZPF','FATES_LEAFC_CANOPY_SZPF','FATES_LAI_CANOPY_SZPF','FATES_CROWNAREA_CANOPY_SZPF', 'FATES_CROWNAREA_USTORY_SZPF','FATES_NPLANT_CANOPY_SZPF','FATES_MORTALITY_USTORY_SZPF','FATES_STOREC_USTORY_SZPF', 'FATES_LEAFC_USTORY_SZPF','FATES_LAI_USTORY_SZPF','FATES_NPLANT_USTORY_SZPF','FATES_CWD_ABOVEGROUND_DC', @@ -55,4 +55,6 @@ hist_fincl1 = 'FATES_TLONGTERM', 'FATES_PARSUN_CL','FATES_PARSHA_CL','FATES_LAISUN_CLLL','FATES_LAISHA_CLLL','FATES_LAISUN_CLLLPF', 'FATES_LAISHA_CLLLPF','FATES_PARPROF_DIR_CLLLPF','FATES_PARPROF_DIF_CLLLPF','FATES_LAISUN_CL','FATES_LAISHA_CL', 'FATES_PARPROF_DIR_CLLL','FATES_PARPROF_DIF_CLLL','FATES_NET_C_UPTAKE_CLLL','FATES_CROWNFRAC_CLLLPF', -'FATES_LBLAYER_COND_AP','FATES_STOMATAL_COND_AP' +'FATES_LBLAYER_COND_AP','FATES_STOMATAL_COND_AP','FATES_TLONGTERM','FATES_PRIMARY_AREA_AP','FATES_NPP_LU','FATES_GPP_LU', +'FATES_SEED_BANK_PF','FATES_UNGERM_SEED_BANK_PF','FATES_SEEDLING_POOL_PF','FATES_SEEDS_IN_PF','FATES_SEEDS_IN_LOCAL_PF', +'FATES_SAPWOOD_AREA_SZPF','FATES_C13DISC_SZPF' diff --git a/components/elm/cime_config/testdefs/testmods_dirs/elm/lulcc_sville/shell_commands b/components/elm/cime_config/testdefs/testmods_dirs/elm/lulcc_sville/shell_commands index fac579d00bf9..0612041eb671 100755 --- a/components/elm/cime_config/testdefs/testmods_dirs/elm/lulcc_sville/shell_commands +++ b/components/elm/cime_config/testdefs/testmods_dirs/elm/lulcc_sville/shell_commands @@ -1,4 +1,3 @@ ./xmlchange ELM_BLDNML_OPTS="-irrig .true." -append if [ `./xmlquery --value MACH` == chrysalis ]; then ./xmlchange FORCE_BUILD_SMP=TRUE; fi -./xmlchange JOB_WALLCLOCK_TIME=2:00:00 ./xmlchange DATM_CLMNCEP_YR_END=1902 diff --git a/components/elm/docs/figures/longwave_radiation.png b/components/elm/docs/figures/longwave_radiation.png new file mode 100644 index 000000000000..493fda9d006d Binary files /dev/null and b/components/elm/docs/figures/longwave_radiation.png differ diff --git a/components/elm/docs/tech-guide/index.md b/components/elm/docs/tech-guide/index.md index 82d933882ebe..6ce636548204 100644 --- a/components/elm/docs/tech-guide/index.md +++ b/components/elm/docs/tech-guide/index.md @@ -6,3 +6,4 @@ Shortwave radiation model - [TOP Parameterization](top_solar_parameterization.md): Parameterization of sub-grid topographical effects on solar radiation. +- [Longwave Radiation](longwave_radiation.md): Longwave radiation model diff --git a/components/elm/docs/tech-guide/longwave_radiation.md b/components/elm/docs/tech-guide/longwave_radiation.md new file mode 100644 index 000000000000..c8a548b0b6ff --- /dev/null +++ b/components/elm/docs/tech-guide/longwave_radiation.md @@ -0,0 +1,299 @@ +# Overview + +The longwave radiation module in ELM solves the amount of longwave +radiation absorbed by the ground and the vegetation, and the +amount of outgoing radiation to the atmosphere (Figure 1). +The model represents the ground surface as a mixture of snow, +soil, and standing surface water. The shaded and sunlit leaves +are combined as a single leaf within the model. The incoming +longwave atmosphere radiation, $L^\downarrow_{atm}$, is a +boundary condition for the model. + +![Image title](../figures/longwave_radiation.png) + +Fig 1. Two-stream longwave radiation model for +(a) non-vegetated and (b) vegetated surfaces. + +## Governing Equations For Non-vegetated Surfaces + +The emitted longwave radation from ground, $L^{\uparrow}_g$, is + +$$ +\begin{equation} +L^{\uparrow}_{g} = (1 - \epsilon_g)L^\downarrow_{atm} + \epsilon_g \sigma T_{g}^4 +\label{eq:lg_up_nonveg} +\end{equation} +$$ + +where $\epsilon_g$ is the emissivity of the ground, +$\sigma$ is the Stefan-Boltzmann constant, and +$T_g$ is the ground temperature. The first term on the +right-hand side represents the reflected atmospheric longwave +radiation, while the second term represents the emitted longwave +radiation by the ground. The emitted longwave radiation is computed as + +$$ +\begin{equation} +\epsilon_g \sigma T_g^4 = \epsilon_g \sigma \left[ f_{sno} T^4_{sno,top} + \left( 1 - f_{sno} - f_{h2osfc}\right) T^4_{soi,1} + f_{h2osfc} T^4_{h2osfc} \right] +\label{eqn:tg} +\end{equation} +$$ + +where $T_{sno,top}$, $T_{soi,1}$ and $T_{h2osfc}$ +the temperature of the top snow layer, the first soil layer, and +the standing surface water, respectively, and +$f_{sno}$ and $f_{h2osfc}$ are fraction of snow and +standing surface water. The ground emissivity is computed as the weighted +average of soil and snow emissivity as + +$$ +\begin{equation} +\epsilon_g = \epsilon_{soi} (1 - f_{sno}) + \epsilon_{sno} f_{sno} +\end{equation} +$$ + +where $\epsilon_{soi}$ is 0.96 for soil, 0.97 for glacier, and +0.96 for wetland, while $\epsilon_{sno}$ is 0.97. + +The radiation absorbed by the ground, $\overrightarrow{L}_g$, is + +$$ +\begin{equation} +\overrightarrow{L}_g = \epsilon_g \sigma T_g^4 + \epsilon_g L_{atm}^\downarrow +\label{eqn:lg_net_nonveg} +\end{equation} +$$ + +## Governing Equations For Vegetated Surfaces + +The longwave radiation below the canopy, $L_v\downarrow$, is + +$$ +\begin{equation} +L_v^\downarrow = (1 - \epsilon_v)L_{atm}^\downarrow + \epsilon_v \sigma T_v^4 +\end{equation} +$$ + +where $\epsilon_v$ is the emissivity of the vegetation +and $T_v$ is the temperature of the canopy. The model assumes +the sunlit and shaded leaves are at the same temperature. +The first term on the right-hand side of the equation represents +the transmitted atmospheric longwave radiation through the +canopy and the second term represents the emitted longwave +radiation by the canopy. The emissivity of the vegetation is + +$$ +\begin{equation} +\epsilon_v = 1 - \exp\left( {-(L+S)/\bar{\mu}} \right) +\end{equation} +$$ + +The upwelling longwave radiation from the ground is + +$$ +\begin{eqnarray} +L_g^\uparrow &=& (1 - \epsilon_g) L_v^\downarrow + \epsilon_g \sigma T_g^4 \nonumber\\[0.5em] +&=& (1 - \epsilon_g)(1 - \epsilon_v)L_{atm}^\downarrow + (1 - \epsilon_g)\epsilon_v \sigma T_v^4 + \epsilon_g \sigma T_g^4 +\end{eqnarray} +$$ + +where the $T_g$ is given by equation \eqref{eqn:tg}. + +Lastly, the upwelling radiation from the top of the canopy to +the atmosphere is + +$$ +\begin{eqnarray} +L_{vg}^\uparrow &=& (1 - \epsilon_v) L_g^\uparrow + \epsilon_v \sigma T_v^4 \nonumber \\[0.5em] +&=& (1 - \epsilon_v) \left[ (1 - \epsilon_g) L_v^\downarrow + \epsilon_g \sigma T_g^4 \right] + \epsilon_v \sigma T_v^4 \nonumber \\[0.5em] +&=& (1 - \epsilon_v) (1 - \epsilon_g) L_v^\downarrow ++ (1 - \epsilon_v) \epsilon_g \sigma T_g^4 + \epsilon_v \sigma T_v^4 \nonumber \\[0.5em] +&=& (1 - \epsilon_v) (1 - \epsilon_g) \left[ (1 - \epsilon_v)L_{atm}^\downarrow + \epsilon_v \sigma T_v^4 \right] \nonumber\\[0.5em] +& & + \epsilon_v \sigma T_v^4 + (1 - \epsilon_v) \epsilon_g \sigma T_g^4 \nonumber\\[0.5em] +&=& (1 - \epsilon_v) (1 - \epsilon_g) (1 - \epsilon_v)L_{atm}^\downarrow \nonumber\\[0.5em] +& & +(1 - \epsilon_v) (1 - \epsilon_g) \epsilon_v \sigma T_v^4 \nonumber\\[0.5em] +& & + \epsilon_v \sigma T_v^4 + (1 - \epsilon_v) \epsilon_g \sigma T_g^4 +\end{eqnarray} +$$ + +The radiation absorbed by the vegetation, $\overrightarrow{L}_{v}$, with +positive value towards the atmosphere, is + +$$ +\begin{eqnarray} +\overrightarrow{L}_v & = & 2 \epsilon_v T_v^4 - \epsilon_v L_g^\uparrow - \epsilon_v L_{atm}^\downarrow \nonumber\\[0.5em] +& = & 2 \epsilon_v T_v^4 - \epsilon_v \left[ (1 - \epsilon_g)(1 - \epsilon_v)L_{atm}^\downarrow + (1 - \epsilon_g)\epsilon_v \sigma T_v^4 + \epsilon_g \sigma T_g^4 \right] \nonumber\\[0.5em] +& & - \epsilon_v L_{atm}^\downarrow \nonumber\\[0.5em] +& = & \left[ 2 - \epsilon_v (1 - \epsilon_g)\right] \epsilon_v \sigma T_v^4 - \epsilon_v \epsilon_g \sigma T_g^4 - \epsilon_v \left[ 1 + (1 - \epsilon_g)(1 - \epsilon_v) \right] L_{atm}^\downarrow \label{eq:net_lv} +\end{eqnarray} +$$ + +The radiation absorbed by the ground with a positive value towards the atmosphere is + +$$ +\begin{equation} +\overrightarrow{L_g} = \epsilon_g \sigma T_g^4 - \epsilon_g L_{v}^\downarrow +\label{eq:net_lg_veg1} +\end{equation} +$$ + +## Temporal Discretization of Ground Temperature + +The three components of ground temperature +(i.e. $T_{sno,1}$, $T_{soi,1}$ and $T_{h2osoi}$) that contribute +to the upward longwave radiation at the ground are coupled to the +temperature of deeper snow and soil layers. This *coupling* of +the temporally discretized equation of the surface energy +balance (that includes absorbed shortwave radiation, $\overrightarrow{S}_{soi}$, +absorbed longwave radiation, sensible heat flux, $H_{soi}$, +latent heat flux, $\lambda E_{soi}$, and ground heat flux, $G$) +with the spatio-temporally discretized equations +of the vertical heat diffusion model within the snow and soil layers +leads to complexity. +This complexity is discussed in Section 7.3 of Bonan (2019)[@bonan2019climate] +and briefly summarized below. + +### Non-vegetated Surface + +For simplicity, let's consider the non-vegetated case in which +snow and standing are absent. In such a case, the ground temperature is the +temperature of the first soil layer i.e. $T_g = T_{soi,1}$. +At the current time step $n+1$, the absorbed +longwave radiation given by equation \eqref{eqn:lg_net_nonveg} is a function +of soil temperature at time $n+1$, $T_{sol,1}^{n+1}$, which is unknown. +The ground heat flux at the top of the soil is given as + +$$ +\begin{eqnarray} +G_{soi} &=& \overrightarrow{S}_{soi} - \overrightarrow{L}_g - H_{soi} - \lambda E_{soi} \nonumber\\[0.5em] +& = & \overrightarrow{S}_{soi} - \epsilon_{soi} \sigma T_{soi,1}^4 - \epsilon_{soi}L_{atm}^\downarrow - H_{soi} - \lambda E_{soi} +\end{eqnarray} +$$ + +The vertical heat diffusion model in ELM uses the Crank-Nicholson temporal discretization +method in which the fluxes between cells are computed as an average of the flux +at $n$-th and $(n+1)$-th time step. The top boundary heat flux (i.e. $G$) in +ELM is computed only at $(n+1)$-th time step and is linearized as + +$$ +\begin{eqnarray} +G_{soi}^{n+1} &=& G_{soi}^{n} + \dfrac{\partial G}{\partial T_{soi,1}} +\left(T_{soi,1}^{n+1} - T_{soi,1}^n\right) \nonumber \\[0.5em] +& = & \overrightarrow{S}_{soi} - \left[ \epsilon_{soi} \sigma (T_{soi,1}^{n})^4 + 4 \epsilon_{soi} \sigma (T_{soi,1}^{n})^3 \Delta T_{soi}^{n+1} + \epsilon_{soi}L_{atm}^\downarrow \right] \nonumber \\[0.5em] +& & - \left[ H_{soi}^n + \dfrac{\partial H}{\partial T_{soi,1}} \Delta T_{soi}^{n+1} \right] \nonumber\\[0.5em] +& & - \left[ \lambda E_{soi}^n + \dfrac{\partial \lambda E}{\partial T_{soi,1}} \Delta T_{soi}^{n+1} \right] \nonumber \\[0.5em] +& = & \overrightarrow{S}_{soi} - \overrightarrow{L}_g^{n+1} - H_{soi}^{n+1} - \lambda E_{soi}^{n+1} \label{eqn:G_bc_discretized} +\end{eqnarray} +$$ + +Thus, the temporally discretized net absorbed longwave radiation in Equation \eqref{eqn:G_bc_discretized} is + +$$ +\begin{equation} +\overrightarrow{L}_g^{n+1} = \left[ \epsilon_{soi} \sigma (T_{soi,1}^{n})^4 + 4 \epsilon_{soi} \sigma (T_{soi,1}^{n})^3 \Delta T_{soi}^{n+1} + \epsilon_{soi}L_{atm}^\downarrow \right] +\label{eqn:lg_net_nonveg2} +\end{equation} +$$ + +Comparing Equation \eqref{eqn:lg_net_nonveg} and \eqref{eqn:lg_net_nonveg2}, one can +interpret the second term on the right hand side, $4\epsilon_{soi}\sigma$ ($T_{soi}^n)^3 \Delta T^{n+1}$, +as an additional source of emitted longwave radiation. However, this term can only +be computed after the vertical heat diffusion model is solved, i.e, after $\Delta T_{soi}^{n+1}$ +is known. Furthermore, this additional longwave radiation source term is added to +the upward longwave radiation to the atmosphere given by $L_g^\uparrow$ in +equation \eqref{eq:lg_up_nonveg). + +For the more general case, when snow and standing surface water are +present on the ground, the temporally discretized net absorbed longwave radiation is + +$$ +\begin{equation} +\overrightarrow{L}_g^{n+1} = \epsilon_{g} \sigma (T_{g}^{n})^4 + 4 \epsilon_{g} \sigma (T_{g}^{n})^3 \Delta T_{g}^{n+1} + \epsilon_{soi}L_{atm}^\downarrow +\label{eqn:lg_net_nonveg3} +\end{equation} +$$ + +### Vegetated Surface + +The same coupling of the surface ground energy flux equations and vertical +heat diffusion model leads to a similar model complexity and the temporally +discretized net longwave radiation for vegetated given by equation \eqref{eq:net_lg_veg1} +is + +$$ +\begin{equation} +\overrightarrow{L_g}^{n+1} = \epsilon_g \sigma (T_g^n)^4 + 4 \epsilon_{g} \sigma (T_{g}^{n})^3 \Delta T_{g}^{n+1} - \epsilon_g L_{v}^\downarrow +\end{equation} +$$ + +The additional *apparent* emitted longwave radiation represented by the second term on the right +hand side of the above equation is not absorbed by the canopy and directly sent upwards to +the atmosphere by adding it in $L_{vg}^\uparrow$. + +## Temporally Discretized Governing Equations + +For the sake of completeness and clarity, we list below the temporally discretized +longwave equations used in ELM. + +### Non-vegetated Surfaces + +The temporally discretized upwelling longwave radiation to the atmosphere and +absorbed longwave radiation by the ground are + +$$ +\begin{eqnarray} +L^{\uparrow n+1}_{g} &=& (1 - \epsilon_g)L^{\downarrow n+1}_{atm} + \epsilon_g \sigma (T_{g}^{n})^4 + 4 \epsilon_{g} \sigma (T_{g}^{n})^3 \Delta T_{g}^{n+1} \\[0.5em] +\overrightarrow{L}_g^{n+1} &=& \epsilon_g \sigma (T_g^n)^4 + \epsilon_g L_{atm}^{\downarrow n+1} + 4 \epsilon_{g} \sigma (T_{g}^{n})^3 \Delta T_{g}^{n+1} +\end{eqnarray} +$$ + +### Vegetated Surfaces + +When solving for $T_v^{n+1}$, ELM uses a diagnostic heat model in which leaves +have no heat capacity and the sum of net absorbed solar and longwave radiation +must balance the latent and sensible heat energy. This leads to a nonlinear +equation for the vegetation canopy temperature, which is solved iteratively. +When the solution for vegetation temperature has been found after $k$-th iteration, +$T_v^{n+1,k}$, ELM uses a linear approximation of the non-linear term related +to canopy temperature in the canopy emitted upward and downward longwave radiation +equations. The linear approximation is as follows. + +$$ +\begin{equation} +\epsilon_v \sigma_v (T_v^{n+1,k+1})^4 = \epsilon_v \sigma_v (T_v^{n+1,k})^4 + 4\epsilon_v \sigma_v (T_v^{n+1,k})^3 \Delta T_v^{n+1,k} +\end{equation} +$$ + +The temporally discretized downward longwave radiation by leaves is + +$$ +\begin{equation} +L_v^{\downarrow n+1} = (1 - \epsilon_v)L_{atm}^{\downarrow n+1} + \epsilon_v \sigma (T_v^{n+1,k})^4 ++ 4 \epsilon_v \sigma (T_v^{n+1,k})^3 (\Delta T_v^{n+1,k+1}) +\end{equation} +$$ + +The temporally discretized upward longwave from the canopy + +$$ +\begin{eqnarray} +L_{vg}^{\uparrow n+1} +&=& (1 - \epsilon_v) (1 - \epsilon_g) (1 - \epsilon_v)L_{atm}^{\downarrow n+1} \nonumber \\[0.5em] +& & + (1 - \epsilon_v) (1 - \epsilon_g) \epsilon_v \sigma (T_v^{n+1,k})^4 \nonumber\\[0.5em] +& & + 4 (1 - \epsilon_v) (1 - \epsilon_g) \epsilon_v \sigma (T_v^{n+1,k})^3 (\Delta T_v^{n+1,k+1}) \nonumber\\[0.5em] +& & + \epsilon_v \sigma (T_v^{n+1,k})^4 + 4 \epsilon_v \sigma (T_v^{n+1,k})^3 \Delta T_v^{n+1,k+1} \nonumber\\[0.5em] +& & + (1 - \epsilon_v) \epsilon_g \sigma (T_g^n)^4 +\end{eqnarray} +$$ + +The temporally discretized upward longwave from the canopy and ground to the atmosphere is + +$$ +\begin{equation} +L^{\uparrow n + 1} = L_{vg}^{\uparrow n+1} + 4 \epsilon_g \sigma (T_g^n)^3 (\Delta T_g^{n+1}) +\end{equation} +$$ + +Note the $T_v$ used in computing the net longwave radiation absorbed by +the leaf given by equation \eqref{eq:net_lv} is $T_v^{n+1,k}$ and it is not +adjusted after the solution for vegetation temperature is found. diff --git a/components/elm/src/biogeochem/FanUpdateMod.F90 b/components/elm/src/biogeochem/FanUpdateMod.F90 index 41648316b275..fbb0e0467ab9 100644 --- a/components/elm/src/biogeochem/FanUpdateMod.F90 +++ b/components/elm/src/biogeochem/FanUpdateMod.F90 @@ -727,6 +727,7 @@ subroutine handle_storage(bounds, frictionvel_vars, dt, & real(r8), parameter :: kg_to_g = 1e3_r8 ! FAN allows a fraction of manure N diverted before storage; this option is currently not used. real(r8), parameter :: fract_direct = 0.0_r8 + real(r8), parameter :: abstol = 1.e-6_r8 ! weight tolerance to remove small column and landunits ! N fluxes, gN/m2/sec: ! @@ -792,7 +793,9 @@ subroutine handle_storage(bounds, frictionvel_vars, dt, & if (l /= ispval) then ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) do c = lun_pp%coli(l), lun_pp%colf(l) - if (.not. col_pp%active(c)) cycle + if (.not. col_pp%active(c) .or. col_pp%wtgcell(c) < abstol) cycle + + if (lun_pp%wtgcell(l) < abstol) cycle ! Ignore if landunit is very tiny flux_avail = ndep_mixed_grc(g) * kg_to_g / lun_pp%wtgcell(l) @@ -850,7 +853,7 @@ subroutine handle_storage(bounds, frictionvel_vars, dt, & end do ! column end if ! land unit not ispval - if (col_grass /= ispval .and. col_pp%wtgcell(col_grass) > 0.0_r8) then + if (col_grass /= ispval .and. col_pp%wtgcell(col_grass) > abstol) then n_manure_spread(col_grass) = n_manure_spread(col_grass) & + flux_grass_spread / col_pp%wtgcell(col_grass) tan_manure_spread(col_grass) = tan_manure_spread(col_grass) & @@ -862,8 +865,10 @@ subroutine handle_storage(bounds, frictionvel_vars, dt, & flux_grass_spread_tan, col_grass, tan_manure_spread(col_grass) end if else if (flux_grass_spread > 0._r8) then - ! call endrun('Cannot spread manure') - write(iulog,*) 'warning: FAN cannot spread manure' + if (debug_fan) then + ! call endrun('Cannot spread manure') + write(iulog,*) 'warning: FAN cannot spread manure' + end if end if end do ! grid @@ -885,12 +890,14 @@ subroutine update_summary(filter_soilc, num_soilc) do fc = 1, num_soilc c = filter_soilc(fc) + if (.not. col_pp%active(c) .or. col_pp%wtgcell(c) < 1.e-15_r8) cycle total = col_ns%tan_g1(c) + col_ns%tan_g2(c) + col_ns%tan_g3(c) total = total + col_ns%manure_u_grz(c) + col_ns%manure_a_grz(c) + col_ns%manure_r_grz(c) total = total + col_ns%tan_s0(c) + col_ns%tan_s1(c) + col_ns%tan_s2(c) + col_ns%tan_s3(c) total = total + col_ns%manure_u_app(c) + col_ns%manure_a_app(c) + col_ns%manure_r_app(c) total = total + col_ns%tan_f1(c) + col_ns%tan_f2(c) + col_ns%tan_f3(c) + col_ns%tan_f4(c) total = total + col_ns%fert_u1(c) + col_ns%fert_u2(c) + total = total + col_ns%manure_n_stored(c) col_ns%fan_totn(c) = total if (lun_pp%itype(col_pp%landunit(c)) == istcrop) then diff --git a/components/elm/src/biogeophys/BareGroundFluxesMod.F90 b/components/elm/src/biogeophys/BareGroundFluxesMod.F90 index 83662758eba8..03ecff38f137 100644 --- a/components/elm/src/biogeophys/BareGroundFluxesMod.F90 +++ b/components/elm/src/biogeophys/BareGroundFluxesMod.F90 @@ -87,7 +87,7 @@ subroutine BareGroundFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface real(r8) :: dqh(bounds%begp:bounds%endp) ! diff of humidity between ref. height and surface - real(r8) :: obu(bounds%begp:bounds%endp) ! Monin-Obukhov length (m) + real(r8) :: obu(bounds%begp:bounds%endp) ! Obukhov length scale (m) real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] real(r8) :: um(bounds%begp:bounds%endp) ! wind speed including the stablity effect [m/s] real(r8) :: temp1(bounds%begp:bounds%endp) ! relation for potential temperature profile @@ -250,7 +250,7 @@ subroutine BareGroundFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & z0hg_patch(p) = z0hg_col(c) z0qg_patch(p) = z0qg_col(c) - ! Initialize Monin-Obukhov length and wind speed + ! Initialize Obukhov length scale and wind speed call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_patch(p), um(p), obu(p)) num_iter(p) = 0._r8 diff --git a/components/elm/src/biogeophys/CanopyFluxesMod.F90 b/components/elm/src/biogeophys/CanopyFluxesMod.F90 index fd6cd3ab163e..47d4558990f9 100755 --- a/components/elm/src/biogeophys/CanopyFluxesMod.F90 +++ b/components/elm/src/biogeophys/CanopyFluxesMod.F90 @@ -17,6 +17,8 @@ module CanopyFluxesMod use elm_varctl , only : use_hydrstress use elm_varpar , only : nlevgrnd, nlevsno use elm_varcon , only : namep + use elm_varcon , only : mm_epsilon + use elm_varcon , only : pa_to_kpa use pftvarcon , only : crop, nfixer use decompMod , only : bounds_type use PhotosynthesisMod , only : Photosynthesis, PhotosynthesisTotal, Fractionation, PhotoSynthesisHydraulicStress @@ -168,21 +170,16 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & real(r8), parameter :: ria = 0.5_r8 ! free parameter for stable formulation (currently = 0.5, "gamma" in Sakaguchi&Zeng,2008) real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] - real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: wc ! convective velocity [m/s] real(r8) :: ugust_total(bounds%begp:bounds%endp) ! gustiness including convective velocity [m/s] real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface real(r8) :: dthv(bounds%begp:bounds%endp) ! diff of vir. poten. temp. between ref. height and surface real(r8) :: dqh(bounds%begp:bounds%endp) ! diff of humidity between ref. height and surface - real(r8) :: obu(bounds%begp:bounds%endp) ! Monin-Obukhov length (m) - real(r8) :: um(bounds%begp:bounds%endp) ! wind speed including the stablity effect [m/s] real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] - real(r8) :: uaf(bounds%begp:bounds%endp) ! velocity of air within foliage [m/s] real(r8) :: temp1(bounds%begp:bounds%endp) ! relation for potential temperature profile real(r8) :: temp12m(bounds%begp:bounds%endp) ! relation for potential temperature profile applied at 2-m real(r8) :: temp2(bounds%begp:bounds%endp) ! relation for specific humidity profile real(r8) :: temp22m(bounds%begp:bounds%endp) ! relation for specific humidity profile applied at 2-m - real(r8) :: ustar(bounds%begp:bounds%endp) ! friction velocity [m/s] real(r8) :: tstar ! temperature scaling parameter real(r8) :: qstar ! moisture scaling parameter real(r8) :: thvstar ! virtual potential temperature scaling parameter @@ -235,7 +232,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & real(r8) :: efpot ! potential latent energy flux [kg/m2/s] real(r8) :: efe(bounds%begp:bounds%endp) ! water flux from leaf [mm/s] real(r8) :: efsh ! sensible heat from leaf [mm/s] - real(r8) :: obuold(bounds%begp:bounds%endp) ! monin-obukhov length from previous iteration + real(r8) :: obuold(bounds%begp:bounds%endp) ! Obukhov length scale from previous iteration real(r8) :: tlbef(bounds%begp:bounds%endp) ! leaf temperature from previous iteration [K] real(r8) :: ecidif ! excess energies [W/m2] real(r8) :: err(bounds%begp:bounds%endp) ! balance error @@ -319,6 +316,13 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & real(r8) :: prev_tau_diff(bounds%begp:bounds%endp) ! Previous difference in iteration tau character(len=64) :: event !! timing event + + ! Indices for raw and rah + integer, parameter :: above_canopy = 1 ! Above canopy + integer, parameter :: below_canopy = 2 ! Below canopy + + ! Lower bound for VPD (based on CLM) + real(r8), parameter :: vpd_min = 50._r8 !------------------------------------------------------------------------------ associate( & @@ -444,6 +448,18 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & eflx_sh_soil => veg_ef%eflx_sh_soil , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] eflx_sh_veg => veg_ef%eflx_sh_veg , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] eflx_sh_grnd => veg_ef%eflx_sh_grnd , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + rah_above => frictionvel_vars%rah_above_patch , & ! Output: [real(r8) (:) ] above-canopy sensible heat flux resistance [s/m] + rah_below => frictionvel_vars%rah_above_patch , & ! Output: [real(r8) (:) ] below-canopy sensible heat flux resistance [s/m] + raw_above => frictionvel_vars%raw_below_patch , & ! Output: [real(r8) (:) ] above-canopy water vapour flux resistance [s/m] + raw_below => frictionvel_vars%raw_below_patch , & ! Output: [real(r8) (:) ] below-canopy water vapour flux resistance [s/m] + ustar => frictionvel_vars%ustar_patch , & ! Output: [real(r8) (:) ] friction velocity [m/s] + um => frictionvel_vars%um_patch , & ! Output: [real(r8) (:) ] wind speed including the stablity effect [m/s] + uaf => frictionvel_vars%uaf_patch , & ! Output: [real(r8) (:) ] canopy air wind speed [m/s] + taf => frictionvel_vars%taf_patch , & ! Output: [real(r8) (:) ] canopy air temperature [K] + qaf => frictionvel_vars%qaf_patch , & ! Output: [real(r8) (:) ] canopy air specific humidity [kg/kg] + obu => frictionvel_vars%obu_patch , & ! Output: [real(r8) (:) ] Obukhov length scale [m] + zeta => frictionvel_vars%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter + vpd => frictionvel_vars%vpd_patch , & ! Output: [real(r8) (:) ] vapour pressure deficit [kPa] begp => bounds%begp , & endp => bounds%endp & ) @@ -747,7 +763,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & p = filterp(f) c = veg_pp%column(p) - ! Initialize Monin-Obukhov length and wind speed + ! Initialize Obukhov length scale and wind speed call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) num_iter(p) = 0._r8 @@ -784,8 +800,8 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & ! Determine aerodynamic resistances ram1(p) = 1._r8/(ustar(p)*ustar(p)/um(p)) - rah(p,1) = 1._r8/(temp1(p)*ustar(p)) - raw(p,1) = 1._r8/(temp2(p)*ustar(p)) + rah(p,above_canopy) = 1._r8/(temp1(p)*ustar(p)) + raw(p,above_canopy) = 1._r8/(temp2(p)*ustar(p)) ! Forbid removing more than 99% of wind speed in a time step. ! This is mainly to avoid convergence issues since this is such a @@ -842,18 +858,25 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & !! Sakaguchi changes for stability formulation ends here - rah(p,2) = 1._r8/(csoilcn*uaf(p)) - raw(p,2) = rah(p,2) + rah(p,below_canopy) = 1._r8/(csoilcn*uaf(p)) + raw(p,below_canopy) = rah(p,below_canopy) if (use_lch4) then - grnd_ch4_cond(p) = 1._r8/(raw(p,1)+raw(p,2)) + grnd_ch4_cond(p) = 1._r8/(raw(p,above_canopy)+raw(p,below_canopy)) end if ! Stomatal resistances for sunlit and shaded fractions of canopy. ! Done each iteration to account for differences in eah, tv. - svpts(p) = el(p) ! pa - eah(p) = forc_pbot(t) * qaf(p) / 0.622_r8 ! pa + svpts(p) = el(p) ! Pa + eah(p) = forc_pbot(t) * qaf(p) / mm_epsilon ! Pa rhaf(p) = eah(p)/svpts(p) + + ! variables for history fields + rah_above(p) = rah(p,above_canopy) + raw_above(p) = raw(p,above_canopy) + rah_below(p) = rah(p,below_canopy) + raw_below(p) = raw(p,below_canopy) + vpd(p) = max((svpts(p) - eah(p)), vpd_min) * pa_to_kpa ! kPa end do ! Modification for shrubs proposed by X.D.Z @@ -941,9 +964,9 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & ! Sensible heat conductance for air, leaf and ground ! Moved the original subroutine in-line... - wta = 1._r8/rah(p,1) ! air + wta = 1._r8/rah(p,above_canopy) ! air wtl = (elai(p)+esai(p))/rb(p) ! leaf - wtg(p) = 1._r8/rah(p,2) ! ground + wtg(p) = 1._r8/rah(p,below_canopy) ! ground wtshi = 1._r8/(wta+wtl+wtg(p)) wtl0(p) = wtl*wtshi ! leaf wtg0 = wtg(p)*wtshi ! ground @@ -1005,7 +1028,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & ! Air has same conductance for both sensible and latent heat. ! Moved the original subroutine in-line... - wtaq = frac_veg_nosno(p)/raw(p,1) ! air + wtaq = frac_veg_nosno(p)/raw(p,above_canopy) ! air wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi @@ -1016,10 +1039,10 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & ! add litter resistance and Lee and Pielke 1992 beta if (delq(p) < 0._r8) then !dew. Do not apply beta for negative flux (follow old rsoil) - wtgq(p) = frac_veg_nosno(p)/(raw(p,2)+rdl) + wtgq(p) = frac_veg_nosno(p)/(raw(p,below_canopy)+rdl) else if (do_soilevap_beta()) then - wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,2)+rdl) + wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,below_canopy)+rdl) endif end if @@ -1112,7 +1135,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & taf(p) = wtg0*t_grnd(c) + wta0(p)*thm(p) + wtl0(p)*t_veg(p) qaf(p) = wtlq0(p)*qsatl(p) + wtgq0*qg(c) + forc_q(t)*wtaq0(p) - ! Update Monin-Obukhov length and wind speed including the + ! Update Obukhov length scale and wind speed including the ! stability effect dth(p) = thm(p)-taf(p) @@ -1123,13 +1146,13 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & qstar = temp2(p)*dqh(p) thvstar = tstar*(1._r8+0.61_r8*forc_q(t)) + 0.61_r8*forc_th(t)*qstar - zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) - if (zeta >= 0._r8) then !stable - zeta = min(2._r8,max(zeta,0.01_r8)) + if (zeta(p) >= 0._r8) then !stable + zeta(p) = min(2._r8,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable - zeta = max(-100._r8,min(zeta,-0.01_r8)) + zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) if ((.not. atm_gustiness) .or. force_land_gustiness) then wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 ugust_total(p) = sqrt(ugust(t)**2 + wc**2) @@ -1138,7 +1161,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & um(p) = max(ur(p),0.1_r8) end if end if - obu(p) = zldis(p)/zeta + obu(p) = zldis(p)/zeta(p) if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 if (nmozsgn(p) >= 4) obu(p) = zldis(p)/(-0.01_r8) diff --git a/components/elm/src/biogeophys/FrictionVelocityMod.F90 b/components/elm/src/biogeophys/FrictionVelocityMod.F90 index 347f2ffb962e..9d2883ffc81c 100644 --- a/components/elm/src/biogeophys/FrictionVelocityMod.F90 +++ b/components/elm/src/biogeophys/FrictionVelocityMod.F90 @@ -24,7 +24,7 @@ module FrictionVelocityMod ! ! !PUBLIC MEMBER FUNCTIONS: public :: FrictionVelocity ! Calculate friction velocity - public :: MoninObukIni ! Initialization of the Monin-Obukhov length + public :: MoninObukIni ! Initialization of the Obukhov length scale ! ! !PRIVATE MEMBER FUNCTIONS: private :: StabilityFunc1 ! Stability function for rib < 0. @@ -62,7 +62,7 @@ subroutine FrictionVelocity(lbn, ubn, fn, filtern, & real(r8) , intent(in) :: z0m ( lbn: ) ! roughness length over vegetation, momentum [m] [lbn:ubn] real(r8) , intent(in) :: z0h ( lbn: ) ! roughness length over vegetation, sensible heat [m] [lbn:ubn] real(r8) , intent(in) :: z0q ( lbn: ) ! roughness length over vegetation, latent heat [m] [lbn:ubn] - real(r8) , intent(in) :: obu ( lbn: ) ! monin-obukhov length (m) [lbn:ubn] + real(r8) , intent(in) :: obu ( lbn: ) ! Obukhov length scale (m) [lbn:ubn] integer , intent(in) :: iter ! iteration number real(r8) , intent(in) :: ur ( lbn: ) ! wind speed at reference height [m/s] [lbn:ubn] real(r8) , intent(in) :: um ( lbn: ) ! wind speed including the stablity effect [m/s] [lbn:ubn] @@ -445,7 +445,7 @@ end function StabilityFunc2 subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) !$acc routine seq ! !DESCRIPTION: - ! Initialization of the Monin-Obukhov length. + ! Initialization of the Obukhov length scale. ! The scheme is based on the work of Zeng et al. (1998): ! Intercomparison of bulk aerodynamic algorithms for the computation ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, @@ -462,7 +462,7 @@ subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) real(r8), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] real(r8), intent(in) :: z0m ! roughness length, momentum [m] real(r8), intent(out) :: um ! wind speed including the stability effect [m/s] - real(r8), intent(out) :: obu ! monin-obukhov length (m) + real(r8), intent(out) :: obu ! Obukhov length scale (m) ! ! !LOCAL VARIABLES: real(r8) :: wc ! convective velocity [m/s] diff --git a/components/elm/src/biogeophys/FrictionVelocityType.F90 b/components/elm/src/biogeophys/FrictionVelocityType.F90 index bd2f4458dd5a..f00afe453f8c 100644 --- a/components/elm/src/biogeophys/FrictionVelocityType.F90 +++ b/components/elm/src/biogeophys/FrictionVelocityType.F90 @@ -43,6 +43,19 @@ module FrictionVelocityType real(r8), pointer :: z0qg_col (:) ! col roughness length over ground, latent heat [m] real(r8), pointer :: num_iter_patch (:) ! number of iterations performed to find a solution ! to the land-energy flux balance in CanopyFluxes() + ! variables to add history output from CanopyFluxesMod + real(r8), pointer :: rah_above_patch (:) ! patch above-canopy sensible heat flux resistance [s/m] + real(r8), pointer :: rah_below_patch (:) ! patch below-canopy sensible heat flux resistance [s/m] + real(r8), pointer :: raw_above_patch (:) ! patch above-canopy water vapour flux resistance [s/m] + real(r8), pointer :: raw_below_patch (:) ! patch below-canopy water vapour flux resistance [s/m] + real(r8), pointer :: ustar_patch (:) ! patch friction velocity [m/s] + real(r8), pointer :: um_patch (:) ! patch wind speed including the stability effect [m/s] + real(r8), pointer :: uaf_patch (:) ! patch canopy air wind speed [m/s] + real(r8), pointer :: taf_patch (:) ! patch canopy air temperature [K] + real(r8), pointer :: qaf_patch (:) ! patch canopy specific humidity [kg/kg] + real(r8), pointer :: obu_patch (:) ! patch Obukhov length scale [m] + real(r8), pointer :: zeta_patch (:) ! patch dimensionless stability parameter + real(r8), pointer :: vpd_patch (:) ! patch vapour pressure deficit [kPa] contains @@ -108,6 +121,18 @@ subroutine InitAllocate(this, bounds) allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = spval allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = spval allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = spval + allocate(this%rah_above_patch (begp:endp)) ; this%rah_above_patch (:) = spval + allocate(this%rah_below_patch (begp:endp)) ; this%rah_below_patch (:) = spval + allocate(this%raw_above_patch (begp:endp)) ; this%raw_above_patch (:) = spval + allocate(this%raw_below_patch (begp:endp)) ; this%raw_below_patch (:) = spval + allocate(this%um_patch (begp:endp)) ; this%um_patch (:) = spval + allocate(this%uaf_patch (begp:endp)) ; this%uaf_patch (:) = spval + allocate(this%taf_patch (begp:endp)) ; this%taf_patch (:) = spval + allocate(this%qaf_patch (begp:endp)) ; this%qaf_patch (:) = spval + allocate(this%ustar_patch (begp:endp)) ; this%ustar_patch (:) = spval + allocate(this%obu_patch (begp:endp)) ; this%obu_patch (:) = spval + allocate(this%zeta_patch (begp:endp)) ; this%zeta_patch (:) = spval + allocate(this%vpd_patch (begp:endp)) ; this%vpd_patch (:) = spval end subroutine InitAllocate !----------------------------------------------------------------------- @@ -216,7 +241,67 @@ subroutine InitHistory(this, bounds) call hist_addfld1d(fname='ITER_LND_EBAL_AVG', units='count', & avgflag='A', long_name='average number of iterations performed in land-energy balance', & ptr_patch=this%num_iter_patch, default = 'inactive') - + + this%rah_above_patch(begp:endp) = spval + call hist_addfld1d (fname='RAH_ABOVE', units='s/m', & + avgflag='A', long_name='above-canopy aerodynamical resistance for sensible heat flux', & + ptr_patch=this%rah_above_patch, default='inactive') + + this%rah_below_patch(begp:endp) = spval + call hist_addfld1d (fname='RAH_BELOW', units='s/m', & + avgflag='A', long_name='below-canopy aerodynamical resistance for sensible heat flux', & + ptr_patch=this%rah_below_patch, default='inactive') + + this%raw_above_patch(begp:endp) = spval + call hist_addfld1d (fname='RAW_ABOVE', units='s/m', & + avgflag='A', long_name='above-canopy aerodynamical resistance for water vapour flux', & + ptr_patch=this%raw_above_patch, default='inactive') + + this%raw_below_patch(begp:endp) = spval + call hist_addfld1d (fname='RAW_BELOW', units='s/m', & + avgflag='A', long_name='below-canopy aerodynamical resistance for water vapour flux', & + ptr_patch=this%raw_below_patch, default='inactive') + + this%ustar_patch(begp:endp) = spval + call hist_addfld1d (fname='USTAR', units='m/s', & + avgflag='A', long_name='friction velocity', & + ptr_patch=this%ustar_patch, default='inactive') + + this%um_patch(begp:endp) = spval + call hist_addfld1d (fname='UM', units='m/s', & + avgflag='A', long_name='wind speed including the stability effect', & + ptr_patch=this%um_patch, default='inactive') + + this%uaf_patch(begp:endp) = spval + call hist_addfld1d (fname='UAF', units='m/s', & + avgflag='A', long_name='canopy air wind speed ', & + ptr_patch=this%uaf_patch, default='inactive') + + this%taf_patch(begp:endp) = spval + call hist_addfld1d (fname='TAF', units='K', & + avgflag='A', long_name='canopy air temperature', & + ptr_patch=this%taf_patch, default='inactive') + + this%qaf_patch(begp:endp) = spval + call hist_addfld1d (fname='QAF', units='kg/kg', & + avgflag='A', long_name='canopy air specific humidity', & + ptr_patch=this%qaf_patch, default='inactive') + + this%obu_patch(begp:endp) = spval + call hist_addfld1d (fname='OBU', units='m', & + avgflag='A', long_name='Obukhov length scale', & + ptr_patch=this%obu_patch, default='inactive') + + this%zeta_patch(begp:endp) = spval + call hist_addfld1d (fname='ZETA', units='unitless', & + avgflag='A', long_name='dimensionless stability parameter', & + ptr_patch=this%zeta_patch, default='inactive') + + this%vpd_patch(begp:endp) = spval + call hist_addfld1d (fname='VPD', units='kPa', & + avgflag='A', long_name='vapour pressure deficit', & + ptr_patch=this%vpd_patch, default='inactive') + end subroutine InitHistory !----------------------------------------------------------------------- diff --git a/components/elm/src/biogeophys/LakeFluxesMod.F90 b/components/elm/src/biogeophys/LakeFluxesMod.F90 index 92733834c775..4258b1957500 100644 --- a/components/elm/src/biogeophys/LakeFluxesMod.F90 +++ b/components/elm/src/biogeophys/LakeFluxesMod.F90 @@ -100,8 +100,8 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, real(r8) :: dzsur(bounds%begc:bounds%endc) ! 1/2 the top layer thickness (m) real(r8) :: eg ! water vapor pressure at temperature T [pa] real(r8) :: htvp(bounds%begc:bounds%endc) ! latent heat of vapor of water (or sublimation) [j/kg] - real(r8) :: obu(bounds%begp:bounds%endp) ! monin-obukhov length (m) - real(r8) :: obuold(bounds%begp:bounds%endp) ! monin-obukhov length of previous iteration + real(r8) :: obu(bounds%begp:bounds%endp) ! Obukhov length scale (m) + real(r8) :: obuold(bounds%begp:bounds%endp) ! Obukhov length scale of previous iteration real(r8) :: qsatg(bounds%begc:bounds%endc) ! saturated humidity [kg/kg] real(r8) :: qsatgdT(bounds%begc:bounds%endc) ! d(qsatg)/dT real(r8) :: qstar ! moisture scaling parameter @@ -370,7 +370,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, dthv = dth(p)*(1._r8+0.61_r8*forc_q(t))+0.61_r8*forc_th(t)*dqh(p) zldis(p) = forc_hgt_u_patch(p) - 0._r8 - ! Initialize Monin-Obukhov length and wind speed + ! Initialize Obukhov length scale and wind speed call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg(p), um(p), obu(p)) end do diff --git a/components/elm/src/biogeophys/SurfaceAlbedoMod.F90 b/components/elm/src/biogeophys/SurfaceAlbedoMod.F90 index 073c836c19bc..4aed983b0ae0 100644 --- a/components/elm/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/components/elm/src/biogeophys/SurfaceAlbedoMod.F90 @@ -936,10 +936,8 @@ subroutine SurfaceAlbedo(bounds, & if(use_fates)then #ifndef _OPENACC - call alm_fates%wrap_canopy_radiation(bounds, & - num_vegsol, filter_vegsol, & - coszen_patch(bounds%begp:bounds%endp), & - surfalb_vars) + call alm_fates%wrap_canopy_radiation(bounds,surfalb_vars,nextsw_cday,declinp1) + #endif else diff --git a/components/elm/src/biogeophys/UrbanFluxesMod.F90 b/components/elm/src/biogeophys/UrbanFluxesMod.F90 index 0897b14fba86..efb8abf9bf84 100644 --- a/components/elm/src/biogeophys/UrbanFluxesMod.F90 +++ b/components/elm/src/biogeophys/UrbanFluxesMod.F90 @@ -118,7 +118,7 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, real(r8) :: dqh(bounds%begl:bounds%endl) ! diff of humidity between ref. height and surface real(r8) :: zldis(bounds%begl:bounds%endl) ! reference height "minus" zero displacement height (m) real(r8) :: um(bounds%begl:bounds%endl) ! wind speed including the stablity effect (m/s) - real(r8) :: obu(bounds%begl:bounds%endl) ! Monin-Obukhov length (m) + real(r8) :: obu(bounds%begl:bounds%endl) ! Obukhov length scale (m) real(r8) :: taf_numer(bounds%begl:bounds%endl) ! numerator of taf equation (K m/s) real(r8) :: taf_denom(bounds%begl:bounds%endl) ! denominator of taf equation (m/s) real(r8) :: qaf_numer(bounds%begl:bounds%endl) ! numerator of qaf equation (kg m/kg s) @@ -365,7 +365,7 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, dthv = dth(l)*(1._r8+0.61_r8*forc_q(t))+0.61_r8*forc_th(t)*dqh(l) zldis(l) = forc_hgt_u_patch(lun_pp%pfti(l)) - z_d_town(l) - ! Initialize Monin-Obukhov length and wind speed including convective velocity + ! Initialize Obukhov length scale and wind speed including convective velocity call MoninObukIni(ur(l), thv_g(l), dthv, zldis(l), z_0_town(l), um(l), obu(l)) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 47853d4c1cd8..9035afe2a079 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -406,9 +406,11 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! write out the mesh file to disk, in parallel outfile = 'wholeLnd.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the land mesh file') + if (mlnid >= 0) then + ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the land mesh file') + endif #endif end subroutine lnd_init_mct @@ -1076,6 +1078,7 @@ subroutine lnd_export_moab(EClock, bounds, lnd2atm_vars, lnd2glc_vars) l2x_lm(i,index_l2x_Sl_tref) = lnd2atm_vars%t_ref2m_grc(g) l2x_lm(i,index_l2x_Sl_qref) = lnd2atm_vars%q_ref2m_grc(g) l2x_lm(i,index_l2x_Sl_u10) = lnd2atm_vars%u_ref10m_grc(g) + l2x_lm(i,index_l2x_Sl_u10withgusts)=lnd2atm_vars%u_ref10m_with_gusts_grc(g) ! see commit 5813d4103 l2x_lm(i,index_l2x_Fall_taux) = -lnd2atm_vars%taux_grc(g) l2x_lm(i,index_l2x_Fall_tauy) = -lnd2atm_vars%tauy_grc(g) l2x_lm(i,index_l2x_Fall_lat) = -lnd2atm_vars%eflx_lh_tot_grc(g) @@ -1339,7 +1342,7 @@ subroutine lnd_import_moab(EClock, bounds, atm2lnd_vars, glc2lnd_vars) #endif tagname=trim(seq_flds_x2l_fields)//C_NULL_CHAR ent_type = 0 ! vertices - ierr = iMOAB_GetDoubleTagStorage ( mlnid, tagname, totalmblsimp , ent_type, x2l_lm(1,1) ) + ierr = iMOAB_GetDoubleTagStorage ( mlnid, tagname, totalmblsimp , ent_type, x2l_lm ) if ( ierr > 0) then call endrun('Error: fail to get seq_flds_x2l_fields for land moab instance on component') endif diff --git a/components/elm/src/data_types/ColumnDataType.F90 b/components/elm/src/data_types/ColumnDataType.F90 index 8a027782a232..3f886d04c7de 100644 --- a/components/elm/src/data_types/ColumnDataType.F90 +++ b/components/elm/src/data_types/ColumnDataType.F90 @@ -3370,30 +3370,28 @@ subroutine col_ns_init(this, begc, endc, col_cs) allocate(this%prod100n (begc:endc)) ; this%prod100n (:) = spval allocate(this%totprodn (begc:endc)) ; this%totprodn (:) = spval allocate(this%dyn_nbal_adjustments (begc:endc)) ; this%dyn_nbal_adjustments (:) = spval - if (use_fan) then - allocate(this%tan_g1 (begc:endc)) ; this%tan_g1 (:) = spval - allocate(this%tan_g2 (begc:endc)) ; this%tan_g2 (:) = spval - allocate(this%tan_g3 (begc:endc)) ; this%tan_g3 (:) = spval - allocate(this%tan_s0 (begc:endc)) ; this%tan_s0 (:) = spval - allocate(this%tan_s1 (begc:endc)) ; this%tan_s1 (:) = spval - allocate(this%tan_s2 (begc:endc)) ; this%tan_s2 (:) = spval - allocate(this%tan_s3 (begc:endc)) ; this%tan_s3 (:) = spval - allocate(this%tan_f1 (begc:endc)) ; this%tan_f1 (:) = spval - allocate(this%tan_f2 (begc:endc)) ; this%tan_f2 (:) = spval - allocate(this%tan_f3 (begc:endc)) ; this%tan_f3 (:) = spval - allocate(this%tan_f4 (begc:endc)) ; this%tan_f4 (:) = spval - allocate(this%fert_u1 (begc:endc)) ; this%fert_u1 (:) = spval - allocate(this%fert_u2 (begc:endc)) ; this%fert_u2 (:) = spval - allocate(this%manure_u_grz (begc:endc)) ; this%manure_u_grz (:) = spval - allocate(this%manure_a_grz (begc:endc)) ; this%manure_a_grz (:) = spval - allocate(this%manure_r_grz (begc:endc)) ; this%manure_r_grz (:) = spval - allocate(this%manure_u_app (begc:endc)) ; this%manure_u_app (:) = spval - allocate(this%manure_a_app (begc:endc)) ; this%manure_a_app (:) = spval - allocate(this%manure_r_app (begc:endc)) ; this%manure_r_app (:) = spval - allocate(this%manure_n_stored (begc:endc)) ; this%manure_n_stored (:) = spval - allocate(this%manure_tan_stored (begc:endc)) ; this%manure_tan_stored (:) = spval - allocate(this%fan_grz_fract (begc:endc)) ; this%fan_grz_fract (:) = spval - end if + allocate(this%tan_g1 (begc:endc)) ; this%tan_g1 (:) = spval + allocate(this%tan_g2 (begc:endc)) ; this%tan_g2 (:) = spval + allocate(this%tan_g3 (begc:endc)) ; this%tan_g3 (:) = spval + allocate(this%tan_s0 (begc:endc)) ; this%tan_s0 (:) = spval + allocate(this%tan_s1 (begc:endc)) ; this%tan_s1 (:) = spval + allocate(this%tan_s2 (begc:endc)) ; this%tan_s2 (:) = spval + allocate(this%tan_s3 (begc:endc)) ; this%tan_s3 (:) = spval + allocate(this%tan_f1 (begc:endc)) ; this%tan_f1 (:) = spval + allocate(this%tan_f2 (begc:endc)) ; this%tan_f2 (:) = spval + allocate(this%tan_f3 (begc:endc)) ; this%tan_f3 (:) = spval + allocate(this%tan_f4 (begc:endc)) ; this%tan_f4 (:) = spval + allocate(this%fert_u1 (begc:endc)) ; this%fert_u1 (:) = spval + allocate(this%fert_u2 (begc:endc)) ; this%fert_u2 (:) = spval + allocate(this%manure_u_grz (begc:endc)) ; this%manure_u_grz (:) = spval + allocate(this%manure_a_grz (begc:endc)) ; this%manure_a_grz (:) = spval + allocate(this%manure_r_grz (begc:endc)) ; this%manure_r_grz (:) = spval + allocate(this%manure_u_app (begc:endc)) ; this%manure_u_app (:) = spval + allocate(this%manure_a_app (begc:endc)) ; this%manure_a_app (:) = spval + allocate(this%manure_r_app (begc:endc)) ; this%manure_r_app (:) = spval + allocate(this%manure_n_stored (begc:endc)) ; this%manure_n_stored (:) = spval + allocate(this%manure_tan_stored (begc:endc)) ; this%manure_tan_stored (:) = spval + allocate(this%fan_grz_fract (begc:endc)) ; this%fan_grz_fract (:) = spval allocate(this%fan_totn (begc:endc)) ; this%fan_totn (:) = spval allocate(this%totpftn_beg (begc:endc)) ; this%totpftn_beg (:) = spval allocate(this%totpftn_end (begc:endc)) ; this%totpftn_end (:) = spval @@ -3755,6 +3753,7 @@ subroutine col_ns_init(this, begc, endc, col_cs) this%prod100n(c) = 0._r8 this%totprodn(c) = 0._r8 this%cropseedn_deficit(c) = 0._r8 + this%fan_totn(c) = 0._r8 end if if ( use_fan ) then @@ -4241,6 +4240,9 @@ subroutine col_ns_setvalues ( this, num_column, filter_column, value_column) this%manure_u_app(i) = value_column this%manure_a_app(i) = value_column this%manure_r_app(i) = value_column + this%manure_tan_stored(i) = value_column + this%manure_n_stored(i) = value_column + this%fan_grz_fract(i) = value_column end if this%fan_totn(i) = value_column @@ -8459,35 +8461,33 @@ subroutine col_nf_init(this, begc, endc) allocate(this%decomp_npools_sourcesink (begc:endc,1:nlevdecomp_full,1:ndecomp_pools )) ; this%decomp_npools_sourcesink (:,:,:) = spval allocate(this%externaln_to_decomp_npools (begc:endc,1:nlevdecomp_full, 1:ndecomp_pools )) ; this%externaln_to_decomp_npools (:,:,:) = spval allocate(this%pmnf_decomp_cascade (begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions )) ; this%pmnf_decomp_cascade (:,:,:) = spval - - if (use_fan) then - allocate(this%manure_tan_appl (begc:endc)) ; this%manure_tan_appl (:) = spval - allocate(this%manure_n_appl (begc:endc)) ; this%manure_n_appl (:) = spval - allocate(this%manure_n_grz (begc:endc)) ; this%manure_n_grz (:) = spval - allocate(this%manure_n_mix (begc:endc)) ; this%manure_n_mix (:) = spval - allocate(this%manure_n_barns (begc:endc)) ; this%manure_n_barns (:) = spval - allocate(this%fert_n_appl (begc:endc)) ; this%fert_n_appl (:) = spval - allocate(this%otherfert_n_appl (begc:endc)) ; this%otherfert_n_appl (:) = spval - allocate(this%manure_n_transf (begc:endc)) ; this%manure_n_transf (:) = spval - allocate(this%nh3_barns (begc:endc)) ; this%nh3_barns (:) = spval - allocate(this%nh3_stores (begc:endc)) ; this%nh3_stores (:) = spval - allocate(this%nh3_grz (begc:endc)) ; this%nh3_grz (:) = spval - allocate(this%nh3_manure_app (begc:endc)) ; this%nh3_manure_app (:) = spval - allocate(this%nh3_fert (begc:endc)) ; this%nh3_fert (:) = spval - allocate(this%nh3_otherfert (begc:endc)) ; this%nh3_otherfert (:) = spval - allocate(this%nh3_total (begc:endc)) ; this%nh3_total (:) = spval - allocate(this%manure_no3_to_soil (begc:endc)) ; this%manure_no3_to_soil (:) = spval - allocate(this%fert_no3_to_soil (begc:endc)) ; this%fert_no3_to_soil (:) = spval - allocate(this%manure_nh4_to_soil (begc:endc)) ; this%manure_nh4_to_soil (:) = spval - allocate(this%fert_nh4_to_soil (begc:endc)) ; this%fert_nh4_to_soil (:) = spval - allocate(this%manure_nh4_runoff (begc:endc)) ; this%manure_nh4_runoff (:) = spval - allocate(this%fert_nh4_runoff (begc:endc)) ; this%fert_nh4_runoff (:) = spval - allocate(this%manure_n_to_sminn (begc:endc)) ; this%manure_n_to_sminn (:) = spval - allocate(this%synthfert_n_to_sminn (begc:endc)) ; this%synthfert_n_to_sminn (:) = spval - allocate(this%manure_n_total (begc:endc)) ; this%manure_n_total (:) = spval - allocate(this%fan_totnin (begc:endc)) ; this%fan_totnin (:) = spval - allocate(this%fan_totnout (begc:endc)) ; this%fan_totnout (:) = spval - end if + !FAN + allocate(this%manure_tan_appl (begc:endc)) ; this%manure_tan_appl (:) = spval + allocate(this%manure_n_appl (begc:endc)) ; this%manure_n_appl (:) = spval + allocate(this%manure_n_grz (begc:endc)) ; this%manure_n_grz (:) = spval + allocate(this%manure_n_mix (begc:endc)) ; this%manure_n_mix (:) = spval + allocate(this%manure_n_barns (begc:endc)) ; this%manure_n_barns (:) = spval + allocate(this%fert_n_appl (begc:endc)) ; this%fert_n_appl (:) = spval + allocate(this%otherfert_n_appl (begc:endc)) ; this%otherfert_n_appl (:) = spval + allocate(this%manure_n_transf (begc:endc)) ; this%manure_n_transf (:) = spval + allocate(this%nh3_barns (begc:endc)) ; this%nh3_barns (:) = spval + allocate(this%nh3_stores (begc:endc)) ; this%nh3_stores (:) = spval + allocate(this%nh3_grz (begc:endc)) ; this%nh3_grz (:) = spval + allocate(this%nh3_manure_app (begc:endc)) ; this%nh3_manure_app (:) = spval + allocate(this%nh3_fert (begc:endc)) ; this%nh3_fert (:) = spval + allocate(this%nh3_otherfert (begc:endc)) ; this%nh3_otherfert (:) = spval + allocate(this%nh3_total (begc:endc)) ; this%nh3_total (:) = spval + allocate(this%manure_no3_to_soil (begc:endc)) ; this%manure_no3_to_soil (:) = spval + allocate(this%fert_no3_to_soil (begc:endc)) ; this%fert_no3_to_soil (:) = spval + allocate(this%manure_nh4_to_soil (begc:endc)) ; this%manure_nh4_to_soil (:) = spval + allocate(this%fert_nh4_to_soil (begc:endc)) ; this%fert_nh4_to_soil (:) = spval + allocate(this%manure_nh4_runoff (begc:endc)) ; this%manure_nh4_runoff (:) = spval + allocate(this%fert_nh4_runoff (begc:endc)) ; this%fert_nh4_runoff (:) = spval + allocate(this%manure_n_to_sminn (begc:endc)) ; this%manure_n_to_sminn (:) = spval + allocate(this%synthfert_n_to_sminn (begc:endc)) ; this%synthfert_n_to_sminn (:) = spval + allocate(this%manure_n_total (begc:endc)) ; this%manure_n_total (:) = spval + allocate(this%fan_totnin (begc:endc)) ; this%fan_totnin (:) = spval + allocate(this%fan_totnout (begc:endc)) ; this%fan_totnout (:) = spval !----------------------------------------------------------------------- ! initialize history fields for select members of col_nf @@ -9557,35 +9557,34 @@ subroutine col_nf_setvalues ( this, num_column, filter_column, value_column) ! bgc-interface this%plant_ndemand(i) = value_column - if ( use_fan ) then - this%manure_tan_appl(i) = value_column - this%manure_n_appl(i) = value_column - this%manure_n_grz(i) = value_column - this%manure_n_mix(i) = value_column - this%manure_n_barns(i) = value_column - this%fert_n_appl(i) = value_column - this%otherfert_n_appl(i) = value_column - this%manure_n_transf(i) = value_column - this%nh3_barns(i) = value_column - this%nh3_stores(i) = value_column - this%nh3_grz(i) = value_column - this%nh3_manure_app(i) = value_column - this%nh3_fert(i) = value_column - this%nh3_otherfert(i) = value_column - this%nh3_total(i) = value_column - this%manure_no3_to_soil(i) = value_column - this%fert_no3_to_soil(i) = value_column - this%manure_nh4_to_soil(i) = value_column - this%fert_nh4_to_soil(i) = value_column - this%fert_nh4_to_soil(i) = value_column - this%manure_nh4_runoff(i) = value_column - this%fert_nh4_runoff(i) = value_column - this%manure_n_to_sminn(i) = value_column - this%manure_n_total(i) = value_column - this%synthfert_n_to_sminn(i) = value_column - this%fan_totnin(i) = value_column - this%fan_totnout(i) = value_column - end if + ! FAN + this%manure_tan_appl(i) = value_column + this%manure_n_appl(i) = value_column + this%manure_n_grz(i) = value_column + this%manure_n_mix(i) = value_column + this%manure_n_barns(i) = value_column + this%fert_n_appl(i) = value_column + this%otherfert_n_appl(i) = value_column + this%manure_n_transf(i) = value_column + this%nh3_barns(i) = value_column + this%nh3_stores(i) = value_column + this%nh3_grz(i) = value_column + this%nh3_manure_app(i) = value_column + this%nh3_fert(i) = value_column + this%nh3_otherfert(i) = value_column + this%nh3_total(i) = value_column + this%manure_no3_to_soil(i) = value_column + this%fert_no3_to_soil(i) = value_column + this%manure_nh4_to_soil(i) = value_column + this%fert_nh4_to_soil(i) = value_column + this%fert_nh4_to_soil(i) = value_column + this%manure_nh4_runoff(i) = value_column + this%fert_nh4_runoff(i) = value_column + this%manure_n_to_sminn(i) = value_column + this%manure_n_total(i) = value_column + this%synthfert_n_to_sminn(i) = value_column + this%fan_totnin(i) = value_column + this%fan_totnout(i) = value_column end do do k = 1, ndecomp_pools diff --git a/components/elm/src/dyn_subgrid/dynSubgridAdjustmentsMod.F90 b/components/elm/src/dyn_subgrid/dynSubgridAdjustmentsMod.F90 index 5e2ec82105a0..78395580ccbd 100644 --- a/components/elm/src/dyn_subgrid/dynSubgridAdjustmentsMod.F90 +++ b/components/elm/src/dyn_subgrid/dynSubgridAdjustmentsMod.F90 @@ -837,7 +837,30 @@ subroutine dyn_col_ns_Adjustments(bounds, clump_index, column_state_updater, col smin_no3_vr => col_ns%smin_no3_vr , & prod1n => col_ns%prod1n , & prod10n => col_ns%prod10n , & - prod100n => col_ns%prod100n & + prod100n => col_ns%prod100n , & + tan_g1 => col_ns%tan_g1 , & + tan_g2 => col_ns%tan_g2 , & + tan_g3 => col_ns%tan_g3 , & + tan_s0 => col_ns%tan_s0 , & + tan_s1 => col_ns%tan_s1 , & + tan_s2 => col_ns%tan_s2 , & + tan_s3 => col_ns%tan_s3 , & + tan_f1 => col_ns%tan_f1 , & + tan_f2 => col_ns%tan_f2 , & + tan_f3 => col_ns%tan_f3 , & + tan_f4 => col_ns%tan_f4 , & + fert_u1 => col_ns%fert_u1 , & + fert_u2 => col_ns%fert_u2 , & + manure_u_grz => col_ns%manure_u_grz , & + manure_a_grz => col_ns%manure_a_grz , & + manure_r_grz => col_ns%manure_r_grz , & + manure_u_app => col_ns%manure_u_app , & + manure_a_app => col_ns%manure_a_app , & + manure_r_app => col_ns%manure_r_app , & + manure_tan_stored => col_ns%manure_tan_stored , & + manure_n_stored => col_ns%manure_n_stored , & + fan_grz_fract => col_ns%fan_grz_fract, & + fan_totn => col_ns%fan_totn & ) begc = bounds%begc @@ -921,6 +944,237 @@ subroutine dyn_col_ns_Adjustments(bounds, clump_index, column_state_updater, col col_ns%dyn_nbal_adjustments(begc:endc) = & col_ns%dyn_nbal_adjustments(begc:endc) + & adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = fan_totn(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_g1(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_g2(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_g3(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_s0(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_s1(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_s2(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_s3(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_f1(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_f2(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_f3(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = tan_f4(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = fert_u1(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = fert_u2(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_u_grz(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_a_grz(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_r_grz(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_u_app(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_a_app(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_r_app(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_tan_stored(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = manure_n_stored(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + + call update_column_state_no_special_handling(column_state_updater, & + bounds = bounds, & + clump_index = clump_index, & + var = fan_grz_fract(begc:endc), & + adjustment = adjustment_one_level(begc:endc)) + + col_ns%dyn_nbal_adjustments(begc:endc) = & + col_ns%dyn_nbal_adjustments(begc:endc) + & + adjustment_one_level(begc:endc) + !=======================================================! end associate diff --git a/components/elm/src/external_models/fates b/components/elm/src/external_models/fates index e3e7d2cd86a6..c319e6759a73 160000 --- a/components/elm/src/external_models/fates +++ b/components/elm/src/external_models/fates @@ -1 +1 @@ -Subproject commit e3e7d2cd86a66f8ca0e8f6dc4a823246a2bdb95b +Subproject commit c319e6759a7396246ddd34fc7dd46374e344d4a4 diff --git a/components/elm/src/main/controlMod.F90 b/components/elm/src/main/controlMod.F90 index 55eddd299be1..6b55fc532089 100755 --- a/components/elm/src/main/controlMod.F90 +++ b/components/elm/src/main/controlMod.F90 @@ -272,6 +272,16 @@ subroutine control_init( ) fates_parteh_mode, & fates_seeddisp_cadence, & use_fates_tree_damage, & + use_fates_daylength_factor, & + fates_photosynth_acclimation, & + fates_stomatal_model, & + fates_stomatal_assimilation, & + fates_leafresp_model, & + fates_cstarvation_model, & + fates_regeneration_model, & + fates_hydro_solver, & + fates_radiation_model, & + fates_electron_transport_model, & fates_history_dimlevel namelist /elm_inparm / use_betr @@ -835,6 +845,16 @@ subroutine control_spmd() call mpi_bcast (use_fates_potentialveg, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_fates_ed_prescribed_phys, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_fates_inventory_init, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_fates_daylength_factor, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (fates_photosynth_acclimation, len(fates_photosynth_acclimation), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_stomatal_model, len(fates_stomatal_model) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_stomatal_assimilation, len(fates_stomatal_assimilation) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_leafresp_model, len(fates_leafresp_model) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_cstarvation_model, len(fates_cstarvation_model) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_regeneration_model, len(fates_regeneration_model) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_hydro_solver, len(fates_hydro_solver) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_radiation_model, len(fates_radiation_model) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fates_electron_transport_model, len(fates_electron_transport_model) , MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fates_inventory_ctrl_filename, len(fates_inventory_ctrl_filename), & MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fates_parteh_mode, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1265,6 +1285,16 @@ subroutine control_print () write(iulog, *) ' use_fates_luh = ', use_fates_luh write(iulog, *) ' use_fates_lupft = ', use_fates_lupft write(iulog, *) ' use_fates_potentialveg = ', use_fates_potentialveg + write(iulog, *) ' use_fates_daylength_factor = ', use_fates_daylength_factor + write(iulog, *) ' fates_photosynth_acclimation = ', trim(fates_photosynth_acclimation) + write(iulog, *) ' fates_stomatal_model = ', fates_stomatal_model + write(iulog, *) ' fates_stomatal_assimilation = ', fates_stomatal_assimilation + write(iulog, *) ' fates_leafresp_model = ', fates_leafresp_model + write(iulog, *) ' fates_cstarvation_model = ', fates_cstarvation_model + write(iulog, *) ' fates_regeneration_model = ', fates_regeneration_model + write(iulog, *) ' fates_hydro_solver = ', fates_hydro_solver + write(iulog, *) ' fates_radiation_model = ', fates_radiation_model + write(iulog, *) ' fates_electron_transport_model = ', fates_electron_transport_model write(iulog, *) ' fates_inventory_ctrl_filename = ',fates_inventory_ctrl_filename write(iulog, *) ' fates_seeddisp_cadence = ', fates_seeddisp_cadence write(iulog, *) ' fates_seeddisp_cadence: 0, 1, 2, 3 => off, daily, monthly, or yearly dispersal' diff --git a/components/elm/src/main/elm_driver.F90 b/components/elm/src/main/elm_driver.F90 index 18ecae88e37f..64828ce6d0eb 100644 --- a/components/elm/src/main/elm_driver.F90 +++ b/components/elm/src/main/elm_driver.F90 @@ -1358,8 +1358,8 @@ subroutine elm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! Determine albedos for next time step ! ============================================================================ - if (doalb) then - + if ( doalb ) then + ! Albedos for non-urban columns call t_startf('surfalb') call SurfaceAlbedo(bounds_clump, & diff --git a/components/elm/src/main/elm_varcon.F90 b/components/elm/src/main/elm_varcon.F90 index fa1e876b91c6..705e57ccfd4a 100644 --- a/components/elm/src/main/elm_varcon.F90 +++ b/components/elm/src/main/elm_varcon.F90 @@ -72,6 +72,10 @@ module elm_varcon real(r8) :: tlsai_crit = 2.0_r8 ! critical value of elai+esai for which aerodynamic parameters are maximum real(r8) :: watmin = 0.01_r8 ! minimum soil moisture (mm) + real(r8), parameter :: mm_epsilon = 0.622_r8 ! Molar mass ratio (water:dry air) + ! This is set to 0.622 for bit-for-bit compatibility, but + ! this should be defined as SHR_CONST_MWWV/SHR_CONST_MWDAIR + real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second @@ -81,6 +85,13 @@ module elm_varcon integer , public, parameter :: ispval = -9999 ! special value for int data ! (keep this negative to avoid conflicts with possible valid values) + + !------------------------------------------------------------------ + ! Unit conversion constants + !------------------------------------------------------------------ + + real(r8), parameter :: pa_to_kpa = 0.001_r8 ! Conversion factor (Pa to kPa) [kPa/Pa] + ! These are tunable constants from clm2_3 real(r8) :: zlnd = 0.01_r8 ! Roughness length for soil [m] diff --git a/components/elm/src/main/elm_varctl.F90 b/components/elm/src/main/elm_varctl.F90 index 84e5c4734bfb..8737015f0689 100644 --- a/components/elm/src/main/elm_varctl.F90 +++ b/components/elm/src/main/elm_varctl.F90 @@ -222,6 +222,15 @@ module elm_varctl logical, public :: use_fates = .false. ! true => use ED integer, public :: fates_spitfire_mode = 0 ! 0 for no fire; 1 for constant ignitions character(len=256), public :: fates_harvest_mode = '' ! five different harvest modes; see namelist_definitions + character(len=256), public :: fates_photosynth_acclimation = '' ! nonacclimating, kumarathunge2019 + character(len=256), public :: fates_stomatal_model = '' ! stomatal conductance model, Ball-berry or Medlyn + character(len=256), public :: fates_stomatal_assimilation = '' ! net or gross assimilation modes + character(len=256), public :: fates_leafresp_model = '' ! Leaf maintenance respiration model, Ryan or Atkin + character(len=256), public :: fates_cstarvation_model = '' ! linear or exponential function + character(len=256), public :: fates_regeneration_model = '' ! default, TRS, or TRS without seed dynamics + character(len=256), public :: fates_hydro_solver = '' ! 1D Taylor, 2D Picard, 2D Newton + character(len=256), public :: fates_radiation_model = '' ! Norman or two-stream radiation model + character(len=256), public :: fates_electron_transport_model = '' ! FvCB or JB electron transport model logical, public :: use_fates_fixed_biogeog = .false. ! true => use fixed biogeography mode logical, public :: use_fates_planthydro = .false. ! true => turn on fates hydro logical, public :: use_fates_cohort_age_tracking = .false. ! true => turn on cohort age tracking @@ -234,6 +243,7 @@ module elm_varctl logical, public :: use_fates_luh = .false. ! true => FATES land use transitions mode logical, public :: use_fates_lupft = .false. ! true => FATES land use x pft mode logical, public :: use_fates_potentialveg = .false. ! true => FATES potential veg only + logical, public :: use_fates_daylength_factor = .false. ! true => enable fates to use host land model daylength factor character(len=256), public :: fluh_timeseries = '' ! filename for land use harmonization data character(len=256), public :: flandusepftdat = '' ! filename for fates landuse x pft data character(len=256), public :: fates_inventory_ctrl_filename = '' ! filename for inventory control diff --git a/components/elm/src/main/elmfates_interfaceMod.F90 b/components/elm/src/main/elmfates_interfaceMod.F90 index 8ef2827b5c06..26a3b1b57caf 100644 --- a/components/elm/src/main/elmfates_interfaceMod.F90 +++ b/components/elm/src/main/elmfates_interfaceMod.F90 @@ -58,6 +58,16 @@ module ELMFatesInterfaceMod use elm_varctl , only : use_fates_luh use elm_varctl , only : use_fates_lupft use elm_varctl , only : use_fates_potentialveg + use elm_varctl , only : use_fates_daylength_factor + use elm_varctl , only : fates_photosynth_acclimation + use elm_varctl , only : fates_stomatal_model + use elm_varctl , only : fates_stomatal_assimilation + use elm_varctl , only : fates_leafresp_model + use elm_varctl , only : fates_cstarvation_model + use elm_varctl , only : fates_regeneration_model + use elm_varctl , only : fates_hydro_solver + use elm_varctl , only : fates_radiation_model + use elm_varctl , only : fates_electron_transport_model use elm_varctl , only : flandusepftdat use elm_varctl , only : use_fates_tree_damage use elm_varctl , only : nsrest, nsrBranch @@ -418,6 +428,17 @@ subroutine ELMFatesGlobals2() integer :: pass_num_luh_states integer :: pass_num_luh_transitions integer :: pass_lupftdat + integer :: pass_daylength_factor_switch + integer :: pass_photosynth_acclimation_switch + integer :: pass_stomatal_model + integer :: pass_stomatal_assimilation + integer :: pass_leafresp_model + integer :: pass_cstarvation_model + integer :: pass_regeneration_model + integer :: pass_hydro_solver + integer :: pass_radiation_model + integer :: pass_electron_transport_model + ! ---------------------------------------------------------------------------------- ! FATES lightning definitions ! 1 : use a global constant lightning rate found in fates_params. @@ -599,6 +620,83 @@ subroutine ELMFatesGlobals2() end if call set_fates_ctrlparms('use_cohort_age_tracking',ival=pass_cohort_age_tracking) + if (trim(fates_radiation_model) == 'norman') then + pass_radiation_model = 1 + else if (trim(fates_radiation_model) == 'twostream') then + pass_radiation_model = 2 + end if + call set_fates_ctrlparms('radiation_model',ival=pass_radiation_model) + + if (trim(fates_electron_transport_model) == 'FvCB1980') then + pass_electron_transport_model = 1 + else if (trim(fates_electron_transport_model) == 'JohnsonBerry2021') then + pass_electron_transport_model = 2 + end if + call set_fates_ctrlparms('electron_transport_model',ival=pass_electron_transport_model) + + + if (trim(fates_hydro_solver) == '1D_Taylor') then + pass_hydro_solver = 1 + else if (trim(fates_hydro_solver) == '2D_Picard') then + pass_hydro_solver = 2 + else if (trim(fates_hydro_solver) == '2D_Newton') then + pass_hydro_solver = 3 + end if + call set_fates_ctrlparms('hydr_solver',ival=pass_hydro_solver) + + + if (trim(fates_regeneration_model) == 'default') then + pass_regeneration_model = 1 + else if (trim(fates_regeneration_model) == 'trs') then + pass_regeneration_model = 2 + else if (trim(fates_regeneration_model) == 'trs_no_seed_dyn') then + pass_regeneration_model = 3 + end if + call set_fates_ctrlparms('regeneration_model',ival=pass_regeneration_model) + + + if (trim(fates_cstarvation_model) == 'linear') then + pass_cstarvation_model = 1 + else if (trim(fates_cstarvation_model) == 'exponential') then + pass_cstarvation_model = 2 + end if + call set_fates_ctrlparms('mort_cstarvation_model',ival=pass_cstarvation_model) + + if (trim(fates_leafresp_model) == 'ryan1991') then + pass_leafresp_model = 1 + else if (trim(fates_leafresp_model) == 'atkin2017') then + pass_leafresp_model = 2 + end if + call set_fates_ctrlparms('maintresp_leaf_model',ival=pass_leafresp_model) + + if (trim(fates_stomatal_assimilation) == 'net') then + pass_stomatal_assimilation = 1 + else if (trim(fates_stomatal_assimilation) == 'gross') then + pass_stomatal_assimilation = 2 + end if + call set_fates_ctrlparms('stomatal_assim_model',ival=pass_stomatal_assimilation) + + if (trim(fates_stomatal_model) == 'ballberry1987') then + pass_stomatal_model = 1 + else if (trim(fates_stomatal_model) == 'medlyn2011') then + pass_stomatal_model = 2 + end if + call set_fates_ctrlparms('stomatal_model',ival=pass_stomatal_model) + + if(trim(fates_photosynth_acclimation) == 'kumarathunge2019') then + pass_photosynth_acclimation_switch = 1 + else if(trim(fates_photosynth_acclimation) == 'nonacclimating') then + pass_photosynth_acclimation_switch = 0 + end if + call set_fates_ctrlparms('photosynth_acclimation',ival=pass_photosynth_acclimation_switch) + + if(use_fates_daylength_factor) then + pass_daylength_factor_switch = 1 + else + pass_daylength_factor_switch = 0 + end if + call set_fates_ctrlparms('use_daylength_factor_switch',ival=pass_daylength_factor_switch) + if(use_fates_inventory_init) then pass_inventory_init = 1 else @@ -2671,26 +2769,23 @@ end subroutine wrap_WoodProducts ! ====================================================================================== - subroutine wrap_canopy_radiation(this, bounds_clump, & - num_vegsol, filter_vegsol, coszen, surfalb_inst) + subroutine wrap_canopy_radiation(this, bounds_clump, surfalb_inst,nextsw_cday,declinp1) + use shr_orb_mod, only: shr_orb_cosz ! Arguments class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type), intent(in) :: bounds_clump - ! filter for vegetated pfts with coszen>0 - integer , intent(in) :: num_vegsol - integer , intent(in) :: filter_vegsol(num_vegsol) - ! cosine solar zenith angle for next time step - real(r8) , intent(in) :: coszen( bounds_clump%begp: ) type(surfalb_type) , intent(inout) :: surfalb_inst - + real(r8),intent(in) :: nextsw_cday,declinp1 + ! locals - integer :: s,c,p,ifp,icp,nc + integer :: s,c,p,ifp,icp,nc,g associate(& albgrd_col => surfalb_inst%albgrd_col , & !in albgri_col => surfalb_inst%albgri_col , & !in + coszen_col => surfalb_inst%coszen_col , & !in albd => surfalb_inst%albd_patch , & !out albi => surfalb_inst%albi_patch , & !out fabd => surfalb_inst%fabd_patch , & !out @@ -2704,51 +2799,47 @@ subroutine wrap_canopy_radiation(this, bounds_clump, & do s = 1, this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno - - p = ifp+col_pp%pfti(c) - - if( any(filter_vegsol==p) )then + g = col_pp%gridcell(c) - this%fates(nc)%bc_in(s)%filter_vegzen_pa(ifp) = .true. - this%fates(nc)%bc_in(s)%coszen_pa(ifp) = coszen(p) - this%fates(nc)%bc_in(s)%albgr_dir_rb(:) = albgrd_col(c,:) - this%fates(nc)%bc_in(s)%albgr_dif_rb(:) = albgri_col(c,:) + coszen_col(c) = shr_orb_cosz (nextsw_cday, grc_pp%lat(g), grc_pp%lon(g), declinp1) - if (veg_es%t_veg(p) <= tfrz) then - this%fates(nc)%bc_in(s)%fcansno_pa(ifp) = veg_ws%fwet(p) - else - this%fates(nc)%bc_in(s)%fcansno_pa(ifp) = 0._r8 - end if - + this%fates(nc)%bc_in(s)%coszen = coszen_col(c) + + do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno + + p = ifp+col_pp%pfti(c) + if (veg_es%t_veg(p) <= tfrz) then + this%fates(nc)%bc_in(s)%fcansno_pa(ifp) = veg_ws%fwet(p) else + this%fates(nc)%bc_in(s)%fcansno_pa(ifp) = 0._r8 + end if + end do + + if(coszen_col(c) > 0._r8) then - this%fates(nc)%bc_in(s)%filter_vegzen_pa(ifp) = .false. + this%fates(nc)%bc_in(s)%albgr_dir_rb(:) = albgrd_col(c,:) + this%fates(nc)%bc_in(s)%albgr_dif_rb(:) = albgri_col(c,:) + else - end if + ! This will ensure a crash in FATES if it tries + this%fates(nc)%bc_in(s)%albgr_dir_rb(:) = spval + this%fates(nc)%bc_in(s)%albgr_dif_rb(:) = spval - end do + end if end do - - call FatesNormalizedCanopyRadiation(this%fates(nc)%nsites, & + + call FatesNormalizedCanopyRadiation( & this%fates(nc)%sites, & this%fates(nc)%bc_in, & this%fates(nc)%bc_out) ! Pass FATES BC's back to HLM ! ----------------------------------------------------------------------------------- - do icp = 1,num_vegsol - p = filter_vegsol(icp) - c = veg_pp%column(p) - s = this%f2hmap(nc)%hsites(c) - ! do if structure here and only pass natveg columns - ifp = p-col_pp%pfti(c) - if(.not.this%fates(nc)%bc_in(s)%filter_vegzen_pa(ifp) )then - write(iulog,*) 's,p,ifp',s,p,ifp - write(iulog,*) 'Not all patches on the natveg column were passed to canrad',veg_pp%sp_pftorder_index(p) - call endrun(msg=errMsg(sourcefile, __LINE__)) - else + do s = 1, this%fates(nc)%nsites + c = this%f2hmap(nc)%fcolumn(s) + do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno + p = ifp+col_pp%pfti(c) albd(p,:) = this%fates(nc)%bc_out(s)%albd_parb(ifp,:) albi(p,:) = this%fates(nc)%bc_out(s)%albi_parb(ifp,:) fabd(p,:) = this%fates(nc)%bc_out(s)%fabd_parb(ifp,:) @@ -2756,7 +2847,7 @@ subroutine wrap_canopy_radiation(this, bounds_clump, & ftdd(p,:) = this%fates(nc)%bc_out(s)%ftdd_parb(ifp,:) ftid(p,:) = this%fates(nc)%bc_out(s)%ftid_parb(ifp,:) ftii(p,:) = this%fates(nc)%bc_out(s)%ftii_parb(ifp,:) - end if + end do end do end associate diff --git a/components/elm/src/main/initGridCellsMod.F90 b/components/elm/src/main/initGridCellsMod.F90 index 4a37c8afcaf1..2d8547334eea 100644 --- a/components/elm/src/main/initGridCellsMod.F90 +++ b/components/elm/src/main/initGridCellsMod.F90 @@ -237,7 +237,9 @@ subroutine initGridcells ! By putting this check within the loop over clumps, we ensure that (for example) ! if a clump is responsible for landunit L, then that same clump is also ! responsible for all columns and pfts in L. + !$OMP CRITICAL call elm_ptrs_check(bounds_clump) + !$OMP END CRITICAL ! Set veg_pp%wtlunit, veg_pp%wtgcell and col_pp%wtgcell call compute_higher_order_weights(bounds_clump) diff --git a/components/elm/tools/mkmapdata/mkmapdata.sh b/components/elm/tools/mkmapdata/mkmapdata.sh index d87538ef212d..e93aa90eeb0b 100755 --- a/components/elm/tools/mkmapdata/mkmapdata.sh +++ b/components/elm/tools/mkmapdata/mkmapdata.sh @@ -314,6 +314,7 @@ fi "360x720cru_cruncep" \ "1km-merge-10min_HYDRO1K-merge-nomask" \ "0.5x0.5_GSDTG2000" \ + "0.01x0.01_nomask" \ ) # Set timestamp for names below diff --git a/components/homme/CMakeLists.txt b/components/homme/CMakeLists.txt index 4bbfb3d73acf..25d51398e429 100644 --- a/components/homme/CMakeLists.txt +++ b/components/homme/CMakeLists.txt @@ -314,15 +314,15 @@ MESSAGE(STATUS "CXX Flags = ${CMAKE_CXX_FLAGS}") MESSAGE(STATUS "Linker Flags = ${CMAKE_EXE_LINKER_FLAGS}") SET (HOMMEXX_ENABLE_GPU FALSE) -SET (HOMMEXX_ENABLE_GPU_F90 FALSE) +SET (HOMMEXX_ENABLE_GPU_F90 FALSE) IF (HOMME_USE_KOKKOS) - IF (CUDA_BUILD OR HIP_BUILD OR SYCL_BUILD) + IF (Kokkos_ENABLE_CUDA OR Kokkos_ENABLE_HIP OR Kokkos_ENABLE_SYCL) SET (DEFAULT_VECTOR_SIZE 1) SET (HOMMEXX_ENABLE_GPU TRUE) SET (HOMMEXX_ENABLE_GPU_F90 TRUE) - IF (SYCL_BUILD) + IF (Kokkos_ENABLE_SYCL) SET (DISABLE_TIMERS_IN_FIRST_STEP TRUE) ENDIF() ELSE () diff --git a/components/homme/cmake/HommeMacros.cmake b/components/homme/cmake/HommeMacros.cmake index 486b30b28334..5ead59d677cf 100644 --- a/components/homme/cmake/HommeMacros.cmake +++ b/components/homme/cmake/HommeMacros.cmake @@ -114,7 +114,7 @@ macro(createTestExec execName execType macroNP macroNC ADD_EXECUTABLE(${execName} ${EXEC_SOURCES}) # For SYCL builds it is suggested to use CXX linker with `-fortlib` # for mixed-language setups - IF(SYCL_BUILD) + IF(Kokkos_ENABLE_SYCL) SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE CXX) ELSE() SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE Fortran) diff --git a/components/homme/cmake/SetCompilerFlags.cmake b/components/homme/cmake/SetCompilerFlags.cmake index b1469d455c9b..3d7da0498ba7 100644 --- a/components/homme/cmake/SetCompilerFlags.cmake +++ b/components/homme/cmake/SetCompilerFlags.cmake @@ -83,7 +83,6 @@ IF (${HOMME_USE_CXX}) STRING (FIND "${CXX_COMPILER_VERSION_OUT}" "nvcc" pos) IF (${pos} GREATER -1) SET (CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} --expt-extended-lambda") - SET (CUDA_BUILD TRUE) MESSAGE (STATUS "Found CUDA, with nvcc as C++ backend compiler. Great.") ELSE () MESSAGE ("\n ********************************** WARNING ********************************** ") diff --git a/components/homme/cmake/machineFiles/aurora-aot.cmake b/components/homme/cmake/machineFiles/aurora-aot.cmake index e878d3e1250b..2a9499ab3edc 100644 --- a/components/homme/cmake/machineFiles/aurora-aot.cmake +++ b/components/homme/cmake/machineFiles/aurora-aot.cmake @@ -28,7 +28,6 @@ SET(BUILD_HOMME_THETA_KOKKOS TRUE CACHE BOOL "") SET(USE_TRILINOS OFF CACHE BOOL "") -SET(SYCL_BUILD TRUE CACHE BOOL "") SET(HOMME_ENABLE_COMPOSE TRUE CACHE BOOL "") SET(Kokkos_ARCH_SPR ON CACHE BOOL "") diff --git a/components/homme/cmake/machineFiles/aurora-jit.cmake b/components/homme/cmake/machineFiles/aurora-jit.cmake index 8c35930fdf66..c8658cde323a 100644 --- a/components/homme/cmake/machineFiles/aurora-jit.cmake +++ b/components/homme/cmake/machineFiles/aurora-jit.cmake @@ -25,7 +25,6 @@ set(Kokkos_ROOT $ENV{KOKKOS_HOME} CACHE STRING "") SET(USE_TRILINOS OFF CACHE BOOL "") -SET(SYCL_BUILD TRUE CACHE BOOL "") SET(HOMME_ENABLE_COMPOSE FALSE CACHE BOOL "") SET(CMAKE_CXX_STANDARD 17) diff --git a/components/homme/cmake/machineFiles/crusher-gpumpi.cmake b/components/homme/cmake/machineFiles/crusher-gpumpi.cmake index 0b054b6dd792..32acab56db59 100644 --- a/components/homme/cmake/machineFiles/crusher-gpumpi.cmake +++ b/components/homme/cmake/machineFiles/crusher-gpumpi.cmake @@ -27,10 +27,6 @@ SET(BUILD_HOMME_THETA_KOKKOS TRUE CACHE BOOL "") SET(USE_TRILINOS OFF CACHE BOOL "") -#CUDA_BUILD is set in SetCompilersFlags, after findPackage(Cuda) -#i haven't extend it to hip, set it here instead -SET(HIP_BUILD TRUE CACHE BOOL "") - #uncomment this if using internal kokkos build #SET(Kokkos_ENABLE_SERIAL ON CACHE BOOL "") ####SET(CMAKE_CXX_STANDARD "14" CACHE STRING "") diff --git a/components/homme/cmake/machineFiles/frontier-bfb.cmake b/components/homme/cmake/machineFiles/frontier-bfb.cmake index 15f97742dd7b..921ce70f3342 100644 --- a/components/homme/cmake/machineFiles/frontier-bfb.cmake +++ b/components/homme/cmake/machineFiles/frontier-bfb.cmake @@ -21,8 +21,6 @@ SET (HOMMEXX_BFB_TESTING TRUE CACHE BOOL "") SET(USE_TRILINOS OFF CACHE BOOL "") -SET(HIP_BUILD TRUE CACHE BOOL "") - SET(Kokkos_ENABLE_SERIAL ON CACHE BOOL "") #SET(Kokkos_ENABLE_DEBUG OFF CACHE BOOL "") SET(Kokkos_ARCH_VEGA90A ON CACHE BOOL "") diff --git a/components/homme/cmake/machineFiles/perlmutter-gnu.cmake b/components/homme/cmake/machineFiles/perlmutter-gnu.cmake index a27f83900c1f..0bfe3f74253f 100644 --- a/components/homme/cmake/machineFiles/perlmutter-gnu.cmake +++ b/components/homme/cmake/machineFiles/perlmutter-gnu.cmake @@ -46,7 +46,6 @@ SET(CMAKE_CXX_COMPILER "CC" CACHE STRING "") # Note: No longer need to set MPICH_CXX env variable and perhaps # NVCC_WRAPPER_DEFAULT_COMPILER. Ignore the warning about nvcc_wrapper during # configuration. -SET(CUDA_BUILD TRUE CACHE STRING "") SET(CXXLIB_SUPPORTED_CACHE FALSE CACHE BOOL "") diff --git a/components/homme/cmake/machineFiles/polaris-a100.sh b/components/homme/cmake/machineFiles/polaris-a100.sh index 2b63c61a55e7..127128fbeec3 100644 --- a/components/homme/cmake/machineFiles/polaris-a100.sh +++ b/components/homme/cmake/machineFiles/polaris-a100.sh @@ -30,8 +30,6 @@ SET(USE_QUEUING FALSE CACHE BOOL "") SET(BUILD_HOMME_THETA_KOKKOS TRUE CACHE BOOL "") -SET(CUDA_BUILD TRUE CACHE BOOL "") - #SET(HOMMEXX_BFB_TESTING TRUE CACHE BOOL "") SET(USE_TRILINOS OFF CACHE BOOL "") diff --git a/components/homme/cmake/machineFiles/spot-aot-AB2.cmake b/components/homme/cmake/machineFiles/spot-aot-AB2.cmake index 23fad2361ccf..2ab993b3c80e 100644 --- a/components/homme/cmake/machineFiles/spot-aot-AB2.cmake +++ b/components/homme/cmake/machineFiles/spot-aot-AB2.cmake @@ -30,7 +30,6 @@ SET (NetCDF_C_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12 SET(USE_TRILINOS OFF CACHE BOOL "") -SET(SYCL_BUILD TRUE CACHE BOOL "") SET(HOMME_ENABLE_COMPOSE FALSE CACHE BOOL "") #SET(CMAKE_CXX_STANDARD 17) diff --git a/components/homme/cmake/machineFiles/stampede.cmake b/components/homme/cmake/machineFiles/stampede.cmake deleted file mode 100644 index afcc67944d57..000000000000 --- a/components/homme/cmake/machineFiles/stampede.cmake +++ /dev/null @@ -1,9 +0,0 @@ -# CMake initial cache file for stampede -SET (CMAKE_Fortran_COMPILER mpif90 CACHE FILEPATH "") -SET (CMAKE_C_COMPILER mpicc CACHE FILEPATH "") -SET (CMAKE_CXX_COMPILER mpicxx CACHE FILEPATH "") -SET (NETCDF_DIR $ENV{TACC_NETCDF_DIR} CACHE FILEPATH "") -SET (HDF5_DIR $ENV{TACC_HDF5_DIR} CACHE FILEPATH "") -SET (SZIP_DIR $ENV{TACC_HDF5_DIR} CACHE FILEPATH "") -SET (PNETCDF_DIR $ENV{TACC_PNETCDF_DIR} CACHE FILEPATH "") -SET (USE_MPIEXEC ibrun CACHE FILEPATH "") diff --git a/components/homme/cmake/machineFiles/summit-p9.cmake b/components/homme/cmake/machineFiles/summit-p9.cmake index 9136dc0bfbdc..6ad3fec33c40 100644 --- a/components/homme/cmake/machineFiles/summit-p9.cmake +++ b/components/homme/cmake/machineFiles/summit-p9.cmake @@ -6,7 +6,7 @@ #SET (HOMMEXX_MPI_ON_DEVICE FALSE CACHE BOOL "") -#modules, note no cuda, otherwise CUDA_BUILD=true +#modules, note no cuda #module load cmake/3.6.1 gcc/6.4.0 netlib-lapack/3.6.1 #module load netcdf/4.6.1 netcdf-fortran/4.4.4 #module load hdf5/1.10.3 diff --git a/components/homme/src/share/control_mod.F90 b/components/homme/src/share/control_mod.F90 index 0e0276fbf2f5..0305a0169f0b 100644 --- a/components/homme/src/share/control_mod.F90 +++ b/components/homme/src/share/control_mod.F90 @@ -134,7 +134,7 @@ module control_mod integer , public :: restartfreq integer , public :: runtype integer , public :: timerdetail - integer , public :: numnodes + integer , public :: numnodes character(len=MAX_STRING_LEN) , public :: restartfile character(len=MAX_STRING_LEN) , public :: restartdir diff --git a/components/homme/src/share/cube_mod.F90 b/components/homme/src/share/cube_mod.F90 index 2d8fb1293d25..16107c953686 100644 --- a/components/homme/src/share/cube_mod.F90 +++ b/components/homme/src/share/cube_mod.F90 @@ -83,7 +83,9 @@ module cube_mod public :: CubeElemCount public :: CubeSetupEdgeIndex public :: ref2sphere - +#ifdef MODEL_CESM + public :: dmap_elementlocal +#endif ! public interface to REFERECE element map #if HOMME_QUAD_PREC @@ -514,8 +516,6 @@ subroutine Dmap(D, a,b, corners3D, ref_map, cartp, facenum) endif end subroutine Dmap - - ! ======================================================== ! Dmap: ! @@ -578,8 +578,6 @@ subroutine dmap_equiangular(D, a,b, cartp,facenum ) D(2,2) = tmpD(2,1)*Jp(1,2) + tmpD(2,2)*Jp(2,2) end subroutine dmap_equiangular - - ! ======================================================== ! vmap: ! diff --git a/components/homme/src/share/cxx/Config.hpp b/components/homme/src/share/cxx/Config.hpp index b204b1dbd047..d0499ac8d190 100644 --- a/components/homme/src/share/cxx/Config.hpp +++ b/components/homme/src/share/cxx/Config.hpp @@ -12,7 +12,7 @@ # ifdef HAVE_CONFIG_H # include "config.h.c" # endif -#else +#elif !defined(HOMMEXX_VECTOR_SIZE) // Establish a good candidate vector size for eam builds # ifdef HOMMEXX_ENABLE_GPU # define HOMMEXX_VECTOR_SIZE 1 diff --git a/components/homme/src/share/dimensions_mod.F90 b/components/homme/src/share/dimensions_mod.F90 index 6bd22793409c..61850a9cf9a3 100644 --- a/components/homme/src/share/dimensions_mod.F90 +++ b/components/homme/src/share/dimensions_mod.F90 @@ -4,14 +4,21 @@ module dimensions_mod #ifdef CAM - use constituents, only : qsize_d=>pcnst ! _EXTERNAL -#endif +#ifdef FVM_TRACERS implicit none private -! set MAX number of tracers. actual number of tracers is a run time argument -#ifdef CAM + integer, parameter :: qsize_d =10 ! CAM-SE tracers (currently CAM-SE supports 10 condensate loading tracers) #else + use constituents, only : qsize_d => pcnst ! _EXTERNAL + + implicit none + private +#endif +#endif + +! set MAX number of tracers. actual number of tracers is a run time argument +#ifndef CAM #ifdef QSIZE_D integer, parameter :: qsize_d=QSIZE_D #else @@ -19,23 +26,20 @@ module dimensions_mod #endif #endif - integer, parameter, public :: np = NP - integer :: qsize = 0 integer, parameter, public :: npsq = np*np integer, parameter, public :: nlev=PLEV integer, parameter, public :: nlevp=nlev+1 - integer, parameter, public :: max_elements_attached_to_node = 7 ! RRM meshes + integer, parameter, public :: max_elements_attached_to_node = 7 ! RRM meshes ! defaults for cubed sphere grids: integer, public :: max_corner_elem = 1 ! max_elements_attached_to_node-3 integer, public :: max_neigh_edges = 8 ! 4 + 4*max_corner_elem public :: qsize,qsize_d - integer, public :: ne integer, public :: ne_x,ne_y ! used for planar topology- number of elements in each direction integer, public :: nelem ! total number of elements @@ -43,7 +47,6 @@ module dimensions_mod integer, public :: nelemdmax ! max number of elements on any MPI task integer, public :: nnodes,npart,nmpi_per_node integer, public :: GlobalUniqueCols - public :: set_mesh_dimensions contains diff --git a/components/homme/src/share/element_mod.F90 b/components/homme/src/share/element_mod.F90 index b71d1c29f374..390c8c54fe78 100644 --- a/components/homme/src/share/element_mod.F90 +++ b/components/homme/src/share/element_mod.F90 @@ -43,7 +43,9 @@ module element_mod ! Equ-angular gnomonic projection coordinates type (cartesian2D_t) :: cartp(np,np) ! gnomonic or reference coords of GLL points type (cartesian2D_t) :: corners(4) ! gnomonic or reference coords of element corners - +#ifdef MODEL_CESM + real (kind=real_kind) :: u2qmap(4,2) ! bilinear map from ref element to quad in cubedsphere coordinates +#endif ! 3D cartesian coordinates type (cartesian3D_t) :: corners3D(4) ! Physical coords of corners @@ -140,7 +142,6 @@ module element_mod !integer :: dummy end type element_t - contains function GetColumnIdP(elem,i,j) result(col_id) @@ -295,8 +296,5 @@ subroutine setup_element_pointers(elem) enddo #endif end subroutine setup_element_pointers - - - - + end module element_mod diff --git a/components/homme/src/share/hybrid_mod.F90 b/components/homme/src/share/hybrid_mod.F90 index 148463f1e42f..12dd5fc9cdb4 100644 --- a/components/homme/src/share/hybrid_mod.F90 +++ b/components/homme/src/share/hybrid_mod.F90 @@ -17,6 +17,12 @@ module hybrid_mod integer :: ithr integer :: hthreads integer :: vthreads +#ifdef MODEL_CESM + integer :: nthreads + integer :: ibeg, iend + integer :: kbeg, kend + integer :: qbeg, qend +#endif logical :: masterthread end type diff --git a/components/homme/src/share/hybvcoord_mod.F90 b/components/homme/src/share/hybvcoord_mod.F90 index 4ff7559bd7bb..d9cf71dba072 100644 --- a/components/homme/src/share/hybvcoord_mod.F90 +++ b/components/homme/src/share/hybvcoord_mod.F90 @@ -25,6 +25,10 @@ module hybvcoord_mod real(r8) etam(plev) ! eta-levels at midpoints real(r8) etai(plevp) ! eta-levels at interfaces real(r8) dp0(plev) ! average layer thickness +#ifdef MODEL_CESM + real(r8) hybd(plev) ! difference in b (hybi) across layers + real(r8) prsfac ! log pressure extrapolation factor (time, space independent) +#endif end type public :: hvcoord_init, set_layer_locations diff --git a/components/homme/src/share/interpolate_mod.F90 b/components/homme/src/share/interpolate_mod.F90 index 403d7a00e89c..d61560a644fc 100644 --- a/components/homme/src/share/interpolate_mod.F90 +++ b/components/homme/src/share/interpolate_mod.F90 @@ -102,7 +102,6 @@ module interpolate_mod public :: interpolate_2d public :: interpolate_create - interface interpolate_scalar module procedure interpolate_scalar2d module procedure interpolate_scalar3d @@ -138,6 +137,9 @@ module interpolate_mod integer :: auto_grid = 0 ! 0 = interpolation grid set by namelist ! 1 = grid set via mesh resolution +#ifdef MODEL_CESM + public :: interp_p, itype +#endif contains @@ -1354,8 +1356,6 @@ subroutine interpolate_ce(cart,fld_cube,npts,fld, fillvalue) end subroutine interpolate_ce - - ! ======================================= ! interpolate_scalar ! @@ -1466,8 +1466,6 @@ subroutine interpolate_scalar3d(interpdata,fld_cube,npts,nlev,fld, fillvalue) endif end subroutine interpolate_scalar3d - - ! ======================================= ! interpolate_vector ! @@ -1607,8 +1605,6 @@ subroutine interpolate_vector3d(interpdata,elem,fld_cube,nlev,fld,input_coords,f end subroutine interpolate_vector3d - - #ifndef CAM function var_is_vector_uvar(name) character(len=*), intent(in) :: name diff --git a/components/homme/src/share/namelist_mod.F90 b/components/homme/src/share/namelist_mod.F90 index 8f3eff70e3e1..560a701c5fc0 100644 --- a/components/homme/src/share/namelist_mod.F90 +++ b/components/homme/src/share/namelist_mod.F90 @@ -10,7 +10,7 @@ module namelist_mod use kinds, only: real_kind, iulog use params_mod, only: recursive, sfcurve, SPHERE_COORDS, Z2_NO_TASK_MAPPING use cube_mod, only: rotate_grid -#ifdef CAM +#if defined(CAM) && !defined(MODEL_CESM) use dyn_grid, only: fv_nphys #endif use physical_constants, only: rearth, rrearth, omega @@ -108,7 +108,6 @@ module namelist_mod internal_diagnostics_level, & timestep_make_subcycle_parameters_consistent - !PLANAR setup #if !defined(CAM) && !defined(SCREAM) use control_mod, only: & @@ -184,14 +183,12 @@ module namelist_mod use interpolate_mod, only : set_interp_parameter, get_interp_parameter - !=======================================================================================================! ! This module should contain no global data and should only be used where readnl is called implicit none private - public :: readnl contains diff --git a/components/homme/src/share/physical_constants.F90 b/components/homme/src/share/physical_constants.F90 index b4c9aa10c47a..379bba35c61d 100644 --- a/components/homme/src/share/physical_constants.F90 +++ b/components/homme/src/share/physical_constants.F90 @@ -17,7 +17,6 @@ module physical_constants rearth, & omega, & Rgas => rair, & - cpair, & p0 => pstd, & MWDAIR => mwdry, & Rwater_vapor => rh2o, & @@ -26,6 +25,7 @@ module physical_constants Rd_on_Rv => epsilo, & Cpd_on_Cpv, & rrearth => ra + use shr_const_mod, only: shr_const_cpdair #endif ! ----------------------------- implicit none @@ -41,7 +41,7 @@ module physical_constants public :: g ! m s^-2 public :: omega ! s^-1 public :: Rgas - real (kind=real_kind), public, parameter :: Cp = cpair + real (kind=real_kind), public, parameter :: Cp = shr_const_cpdair ! cpair from the "physconst" module in CAM is not a constant public :: p0 ! Pa public :: MWDAIR public :: Rwater_vapor diff --git a/components/homme/src/share/thread_mod.F90 b/components/homme/src/share/thread_mod.F90 index 97dc61ea186b..22aba9dbbf6c 100644 --- a/components/homme/src/share/thread_mod.F90 +++ b/components/homme/src/share/thread_mod.F90 @@ -16,18 +16,26 @@ module thread_mod implicit none private - integer, public :: NThreads ! total number of threads +#ifdef MODEL_CESM + integer, public, pointer :: NThreads ! total number of threads + ! standalone HOMME: from namelist + ! in CAM: set by driver + integer, public, pointer :: hthreads ! computed based on nthreads, vthreads,nelemd + integer, public, pointer :: vthreads ! not used unless set in namelist +#else + integer, public :: NThreads ! total number of threads ! standalone HOMME: from namelist ! in CAM: set by driver integer, public :: hthreads ! computed based on nthreads, vthreads,nelemd integer, public :: vthreads = 1 ! not used unless set in namelist - +#endif public :: omp_get_thread_num public :: omp_in_parallel public :: omp_set_num_threads public :: omp_get_max_threads public :: omp_get_num_threads public :: omp_get_nested + #ifndef _OPENMP contains diff --git a/components/homme/test/tool/python/HOMME2SCRIP.py b/components/homme/test/tool/python/HOMME2SCRIP.py new file mode 100644 index 000000000000..3c85a0091a7f --- /dev/null +++ b/components/homme/test/tool/python/HOMME2SCRIP.py @@ -0,0 +1,203 @@ +#!/usr/bin/env python3 +#--------------------------------------------------------------------------------------------------- +''' +This is a replacement for the legacy HOMME2SCRIP.ncl tool created for CESM. +Most legacy functionality is reproduced + +Created May, 2025 by Walter Hannah (LLNL) +''' +#--------------------------------------------------------------------------------------------------- +import datetime, os, numpy as np, xarray as xr +user, host = os.getenv('USER'), os.getenv('HOST') +source_code_meta = 'HOMME2SCRIP.py' +output_netcdf_type = 'NETCDF3_64BIT_DATA' +#--------------------------------------------------------------------------------------------------- +class clr:END,RED,GREEN,MAGENTA,CYAN = '\033[0m','\033[31m','\033[32m','\033[35m','\033[36m' +#--------------------------------------------------------------------------------------------------- +verbose_indent = ' '*2 +#--------------------------------------------------------------------------------------------------- +usage = ''' +python HOMME2SCRIP.py -i + -o + --ne + --np + +Purpose: + This script reads a HOMME grid template file and writes out a SCRIP format grid description file of the np4/GLL grid. + + HOMME np4 grid template files are produced by a two step procedure, which first requires running homme_tool, and then this script to convert the output into SCRIP format. This procedure is only needed for np4 files due to their use of vertex data. For cell centered pg2 files, one should instead use TempestRemap to create a grid description file. This is particularly useful when remapping topography data with cube_to_target, which can be much faster than remapping with tools like NCO due to the large size of the input topography data. + +Environment + + This requires libraries such as xarray, which included in the E3SM unified environment: + https://e3sm.org/resources/tools/other-tools/e3sm-unified-environment/ + + Otherwise a simple conda environment can be created: + conda create --name example_env --channel conda-forge xarray numpy netcdf4 + +''' +from optparse import OptionParser +parser = OptionParser(usage=usage) +parser.add_option('--src_file', + dest='src_file', + default=None, + help='Input HOMME grid template file') +parser.add_option('--dst_file', + dest='dst_file', + default=None, + help='Output scrip grid file') +(opts, args) = parser.parse_args() +#--------------------------------------------------------------------------------------------------- +def main(): + #------------------------------------------------------------------------------- + # check for valid input arguments + if opts.src_file is None: raise ValueError(f'{clr.RED}src_file argument was not specified{clr.END}') + if opts.dst_file is None: raise ValueError(f'{clr.RED}dst_file argument was not specified{clr.END}') + + #----------------------------------------------------------------------------- + # print some informative stuff + print() + print(verbose_indent+f'{clr.GREEN}Input arguments:{clr.END}') + print(verbose_indent+f' {clr.CYAN}src_file{clr.END}: {opts.src_file}') + print(verbose_indent+f' {clr.CYAN}dst_file{clr.END}: {opts.dst_file}') + + #----------------------------------------------------------------------------- + # open input file as dataset + ds = xr.open_dataset(opts.src_file) + + #----------------------------------------------------------------------------- + # check for variables we need + if 'lat' not in ds: raise ValueError(f'{clr.RED}required variable missing from input file:{clr.END} lat') + if 'lon' not in ds: raise ValueError(f'{clr.RED}required variable missing from input file:{clr.END} lon') + if 'area' not in ds: raise ValueError(f'{clr.RED}required variable missing from input file:{clr.END} area') + if 'cv_lat' not in ds: raise ValueError(f'{clr.RED}required variable missing from input file:{clr.END} cv_lat') + if 'cv_lon' not in ds: raise ValueError(f'{clr.RED}required variable missing from input file:{clr.END} cv_lon') + + #----------------------------------------------------------------------------- + # remove variables we don't need - keep lev since it holds the corner values + if 'time' in ds: ds = ds.isel(time=0,drop=True) + if 'ilev' in ds: ds = ds.isel(ilev=0,drop=True) + if 'hyam' in ds: ds = ds.drop_vars('hyam') + if 'hybm' in ds: ds = ds.drop_vars('hybm') + if 'hyai' in ds: ds = ds.drop_vars('hyai') + if 'hybi' in ds: ds = ds.drop_vars('hybi') + if 'corners' in ds: ds = ds.drop_vars('corners') + + #----------------------------------------------------------------------------- + # use the number of valid corner locations to determine max corners across grid + num_corners = 0 + kmax = ds.cv_lon['lev'].shape[0] # lev value hold corner values + + for k in range(kmax): + # use max of logitude values to check if any corner values exist for k + max_lon = np.max( np.absolute( ds.cv_lon.isel(lev=k).values ) ) + # if max_lon is zero then no more corners exist and we can use k as max # of corners + if ( max_lon<0.000000001 and num_corners==0): num_corners = k + + print() + print(verbose_indent+f'{clr.GREEN}Unstructured control volumes max number of corners:{clr.END} {num_corners}') + + #----------------------------------------------------------------------------- + # print min/max of coordinates + print() + print(verbose_indent+f'{clr.GREEN}Sanity check for coordinate bounds:{clr.END}') + print(verbose_indent+f' lon min/max: {np.min(ds.lon.values) :8.4f} / {np.max(ds.lon.values) :8.4f}') + print(verbose_indent+f' lat min/max: {np.min(ds.lat.values) :8.4f} / {np.max(ds.lat.values) :8.4f}') + print(verbose_indent+f' cv_lon min/max: {np.min(ds.cv_lon.values):8.4f} / {np.max(ds.cv_lon.values):8.4f}') + print(verbose_indent+f' cv_lat min/max: {np.min(ds.cv_lat.values):8.4f} / {np.max(ds.cv_lat.values):8.4f}') + + #----------------------------------------------------------------------------- + # Create output dataset + ds_out = ds.rename({'ncol' :'grid_size',\ + 'area' :'grid_area',\ + 'lev' :'grid_corners',\ + 'lat' :'grid_center_lat',\ + 'lon' :'grid_center_lon',\ + 'cv_lat':'grid_corner_lat',\ + 'cv_lon':'grid_corner_lon',\ + }).isel(grid_corners=slice(0,num_corners)) + + ds_out['grid_area'] = ds_out['grid_area'].assign_attrs(units='radians^2') + ds_out['grid_area'] = ds_out['grid_area'].assign_attrs(long_name='area weights') + + ds_out['grid_center_lat'] = ds_out['grid_center_lat'].assign_attrs(units='degrees') + ds_out['grid_center_lon'] = ds_out['grid_center_lon'].assign_attrs(units='degrees') + ds_out['grid_corner_lat'] = ds_out['grid_corner_lat'].assign_attrs(units='degrees') + ds_out['grid_corner_lon'] = ds_out['grid_corner_lon'].assign_attrs(units='degrees') + + for v in ds_out.variables: + if 'grid_corners' in ds_out[v].dims: + ds_out[v] = ds_out[v].transpose('grid_size','grid_corners',missing_dims='ignore') + + ds_out.load() + + #----------------------------------------------------------------------------- + def print_corners(lat,lon,num_corners): + for c in range(num_corners): + print(verbose_indent+(' '*6)+f'corner {c} lat/lon: {lat[c]:8.4f} {lon[c]:8.4f}') + return + + #----------------------------------------------------------------------------- + def swap_corners(ds,i): + # 1 2 3 4 -> 1 4 3 2 swap pos 1,3 + tmp_grid_corner_lon = ds.grid_corner_lon[i,:].copy(deep=True) + tmp_grid_corner_lat = ds.grid_corner_lat[i,:].copy(deep=True) + ds.grid_corner_lon[i,1] = tmp_grid_corner_lon[3] + ds.grid_corner_lon[i,3] = tmp_grid_corner_lon[1] + ds.grid_corner_lat[i,1] = tmp_grid_corner_lat[3] + ds.grid_corner_lat[i,3] = tmp_grid_corner_lat[1] + return + + #----------------------------------------------------------------------------- + # Fix orientation at pole points + print() + print(verbose_indent+f'{clr.GREEN}Checking pole coordinates...{clr.END}') + + for i in range(len(ds_out['grid_size'])): + abs_lat = np.absolute( ds_out.grid_center_lat[i].values ) + pole_dist = np.absolute( 90 - abs_lat ) + if ( pole_dist < 1e-9 ): + print() + print(verbose_indent+(' '*2)+f'{clr.GREEN}Pole point identified:{clr.END}') + print(verbose_indent+(' '*4)+f'i :{i:12}') + print(verbose_indent+(' '*4)+f'center lat/lon: {ds_out.grid_center_lat[i].values:8.4f} / {ds_out.grid_center_lon[i].values:8.4f}') + + print(verbose_indent+(' '*4)+f'Original corner indices:') + print_corners( ds_out.grid_corner_lat[i,:].values, ds_out.grid_corner_lon[i,:].values, num_corners ) + + print(verbose_indent+(' '*4)+f'Swapping corner indices 1 & 3...') + swap_corners(ds_out,i) + + print(verbose_indent+(' '*4)+f'Modified corner indices:') + print_corners( ds_out.grid_corner_lat[i,:].values, ds_out.grid_corner_lon[i,:].values, num_corners ) + #----------------------------------------------------------------------------- + # add imask and grid_dims to output datasest + ds_out['grid_imask'] = xr.ones_like(ds_out['grid_size'],dtype=int) + ds_out['grid_dims'] = xr.DataArray([len(ds_out['grid_imask'])],dims=['grid_rank']) + + #----------------------------------------------------------------------------- + # add global attributes + ds_out.attrs['title'] = 'HOMME generated np4 SCRIP grid data' + ds_out.attrs['Conventions'] = 'CF-1.0' + ds_out.attrs['source_code'] = source_code_meta + ds_out.attrs['hostname'] = str(host) + ds_out.attrs['history'] = f'created by {user}, '+datetime.datetime.now().strftime('%Y-%m-%d %H:%M:%S') + ds_out.attrs['src_file'] = opts.src_file + + #----------------------------------------------------------------------------- + # write grid data out to netcdf file + print() + print(verbose_indent+f'{clr.GREEN}Writing output grid data...{clr.END}') + + ds_out.to_netcdf(path=opts.dst_file, mode='w', format=output_netcdf_type) + + #----------------------------------------------------------------------------- + # final print statements + print() + print(verbose_indent+f'{clr.GREEN}Successfully created file:{clr.END} {opts.dst_file}') + print() + +#--------------------------------------------------------------------------------------------------- +if __name__ == '__main__': + main() +#--------------------------------------------------------------------------------------------------- diff --git a/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt b/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt index bc788462ce6e..8719b5fe8b14 100644 --- a/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt +++ b/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt @@ -7,11 +7,11 @@ SET(UTILS_TIMING_BIN_DIR ${HOMME_BINARY_DIR}/utils/cime/CIME/non_py/src/timing) SET(UTILS_TIMING_DIRS ${UTILS_TIMING_SRC_DIR} ${UTILS_TIMING_BIN_DIR}) # Place common CPP definitions here. -# Note: need CUDA_BUILD and HOMMEXX_BFB_TESTING here, since the share +# Note: HOMMEXX_BFB_TESTING here, since the share # unit tests do not include a config.h file SET (COMMON_DEFINITIONS NP=4 NC=4) -IF (CUDA_BUILD OR HIP_BUILD OR SYCL_BUILD) - SET(COMMON_DEFINITIONS ${COMMON_DEFINITIONS} HOMMEXX_ENABLE_GPU_F90) +IF (HOMMEXX_ENABLE_GPU_F90) + SET(COMMON_DEFINITIONS ${COMMON_DEFINITIONS} HOMMEXX_ENABLE_GPU_F90) ENDIF() IF (HOMMEXX_BFB_TESTING) SET(COMMON_DEFINITIONS ${COMMON_DEFINITIONS} HOMMEXX_BFB_TESTING) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 9f0aa9fa405b..84eebe40c483 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -388,9 +388,11 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) ! write out the mesh file to disk, in parallel outfile = 'wholeRof.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) - if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to write the moab runoff mesh file') + if (mrofid >= 0) then + ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to write the moab runoff mesh file') + endif #endif end subroutine rof_init_mct @@ -1260,7 +1262,7 @@ subroutine rof_import_moab( EClock ) ! ! LOCAL VARIABLES - integer :: n2, n, nt, begr, endr, nliq, nfrz + integer :: n2, n, nt, begr, endr, nliq, nfrz, nmud, nsan real(R8) :: tmp1, tmp2 real(R8) :: shum character(CXX) :: tagname ! @@ -1287,7 +1289,7 @@ subroutine rof_import_moab( EClock ) ! populate the array x2r_rm with data from MOAB tags tagname=trim(seq_flds_x2r_fields)//C_NULL_CHAR ent_type = 0 ! vertices, point cloud - ierr = iMOAB_GetDoubleTagStorage ( mrofid, tagname, totalmbls_r , ent_type, x2r_rm(1,1) ) + ierr = iMOAB_GetDoubleTagStorage ( mrofid, tagname, totalmbls_r , ent_type, x2r_rm ) if ( ierr > 0) then call shr_sys_abort(sub//'Error: fail to get seq_flds_a2x_fields for atm physgrid moab mesh') endif @@ -1295,6 +1297,8 @@ subroutine rof_import_moab( EClock ) ! Note that ***runin are fluxes nliq = 0 nfrz = 0 + nmud = 0 + nsan = 0 do nt = 1,nt_rtm if (trim(rtm_tracers(nt)) == 'LIQ') then nliq = nt @@ -1302,9 +1306,27 @@ subroutine rof_import_moab( EClock ) if (trim(rtm_tracers(nt)) == 'ICE') then nfrz = nt endif + if (trim(rtm_tracers(nt)) == 'MUD') then + nmud = nt + endif + if (trim(rtm_tracers(nt)) == 'SAN') then + nsan = nt + endif enddo - if (nliq == 0 .or. nfrz == 0) then - write(iulog,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers + if (nliq == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers LIQ',nliq,rtm_tracers + call shr_sys_abort() + endif + if (nfrz == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers ICE',nfrz,rtm_tracers + call shr_sys_abort() + endif + if (nmud == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers MUD',nmud,rtm_tracers + call shr_sys_abort() + endif + if (nsan == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers SAN',nsan,rtm_tracers call shr_sys_abort() endif @@ -1351,8 +1373,25 @@ subroutine rof_import_moab( EClock ) THeat%forc_vp(n) = shum * THeat%forc_pbot(n) / (0.622_r8 + 0.378_r8 * shum) THeat%coszen(n) = x2r_rm(n2,index_x2r_coszen_str) end if + + + rtmCTL%qsur(n,nmud) = 0.0_r8 + rtmCTL%qsur(n,nsan) = 0.0_r8 + + if (index_x2r_Flrl_inundinf > 0) then + rtmCTL%inundinf(n) = x2r_rm(n2,index_x2r_Flrl_inundinf) * (rtmCTL%area(n)*0.001_r8) + endif + enddo + if(sediflag) then + do n = begr,endr + n2 = n - begr + 1 + rtmCTL%qsur(n,nmud) = x2r_rm(n2,index_x2r_Flrl_rofmud) * (rtmCTL%area(n)) ! kg/m2/s --> kg/s for sediment + rtmCTL%qsur(n,nsan) = 0.0_r8 + enddo + end if + end subroutine rof_import_moab diff --git a/components/mpas-albany-landice/bld/build-namelist b/components/mpas-albany-landice/bld/build-namelist index 98edd98cd95a..249fa0351400 100755 --- a/components/mpas-albany-landice/bld/build-namelist +++ b/components/mpas-albany-landice/bld/build-namelist @@ -55,6 +55,10 @@ OPTIONS -ninst_glc NINST_GLC for this case -mali_prognostic_mode whether MALI should be prognostic, static, or data Options are: FALSE, TRUE + -glc_nzoc number of z-ocean classes [0 | 4 | 30] + -ocn_glc_ismf_coupling methods for ocn/glc ice-shelf melt flux coupling + ['none' | 'data_mpaso' | 'data_mali' | 'internal_mpaso' | + 'tf' | 'coupler'] NOTE: The precedence for setting the values of namelist variables is (highest to lowest): 1. namelist values set by specific command-line options, i.e. (none right now) @@ -100,6 +104,8 @@ my %opts = ( help => 0, ntasks_glc => 0, ninst_glc => 0, mali_prognostic_mode => undef, + glc_nzoc => 0, + ocn_glc_ismf_coupling => undef, ); GetOptions( @@ -119,6 +125,8 @@ GetOptions( "ntasks_glc=i" => \$opts{'ntasks_glc'}, "ninst_glc=i" => \$opts{'ninst_glc'}, "mali_prognostic_mode=s" => \$opts{'mali_prognostic_mode'}, + "glc_nzoc=i" => \$opts{'glc_nzoc'}, + "ocn_glc_ismf_coupling=s" => \$opts{'ocn_glc_ismf_coupling'}, ) or usage(); @@ -154,6 +162,8 @@ $cfgdir = $opts{'cfg_dir'}; my $NINST_GLC = $opts{'ninst_glc'}; my $NTASKS_GLC = $opts{'ntasks_glc'}; my $MALI_PROGNOSTIC_MODE = uc($opts{'mali_prognostic_mode'}); +my $GLC_NZOC = $opts{'glc_nzoc'}; +my $OCN_GLC_ISMF_COUPLING = $opts{'ocn_glc_ismf_coupling'}; my $CIMEROOT; if ( defined $opts{'cimeroot'} ) { @@ -393,6 +403,7 @@ my $START_TOD = "$xmlvars{'START_TOD'}"; my $RUN_REFDATE = "$xmlvars{'RUN_REFDATE'}"; my $CONTINUE_RUN = "$xmlvars{'CONTINUE_RUN'}"; my $MALI_USE_ALBANY = "$xmlvars{'MALI_USE_ALBANY'}"; +my $GLC_NZOC = "$xmlvars{'GLC_NZOC'}"; my $output_r = "./${CASE}.mali.r"; my $output_h = "./${CASE}.mali.h"; @@ -412,6 +423,8 @@ my $ntasks = $NTASKS_GLC / $NINST_GLC; print "MALI build-namelist: glc_grid is $GLC_GRID \n"; print "MALI build-namelist: MALI_PROGNOSTIC_MODE is $MALI_PROGNOSTIC_MODE \n"; print "MALI build-namelist: MALI_USE_ALBANY is $MALI_USE_ALBANY \n"; +print "MALI build-namelist: GLC_NZOC is $GLC_NZOC \n"; +print "MALI build-namelist: OCN_GLC_ISMF_COUPLING is $OCN_GLC_ISMF_COUPLING \n"; (-d $DIN_LOC_ROOT) or mkdir $DIN_LOC_ROOT; if ($print>=2) { print "CESM inputdata root directory: $DIN_LOC_ROOT$eol"; } @@ -540,7 +553,15 @@ add_default($nl, 'config_max_water_fraction'); ################################# if ($MALI_PROGNOSTIC_MODE eq 'PROGNOSTIC') { - add_default($nl, 'config_basal_mass_bal_float'); + if ($OCN_GLC_ISMF_COUPLING eq 'tf') { + add_default($nl, 'config_basal_mass_bal_float'); + } elsif ($OCN_GLC_ISMF_COUPLING eq 'data_mali') { + add_default($nl, 'config_basal_mass_bal_float', 'val'=>"file"); + } elsif ($OCN_GLC_ISMF_COUPLING eq 'coupler') { + add_default($nl, 'config_basal_mass_bal_float', 'val'=>"file"); + } else { + add_default($nl, 'config_basal_mass_bal_float', 'val'=>"none"); + } } else { add_default($nl, 'config_basal_mass_bal_float', 'val'=>"none"); } @@ -561,19 +582,24 @@ add_default($nl, 'config_temperature_profile_variability_amplitude'); add_default($nl, 'config_temperature_profile_variability_period'); add_default($nl, 'config_temperature_profile_variability_phase'); add_default($nl, 'config_temperature_profile_GL_depth_fraction'); -if ($MALI_PROGNOSTIC_MODE eq 'PROGNOSTIC') { +if (($MALI_PROGNOSTIC_MODE eq 'PROGNOSTIC') and ($GLC_NZOC gt 0)) { add_default($nl, 'config_front_mass_bal_grounded'); + add_default($nl, 'config_use_3d_thermal_forcing_for_face_melt'); } else { add_default($nl, 'config_front_mass_bal_grounded', 'val'=>"none"); + add_default($nl, 'config_use_3d_thermal_forcing_for_face_melt', 'val'=>".false."); } -add_default($nl, 'config_use_3d_thermal_forcing_for_face_melt'); add_default($nl, 'config_beta_ocean_thermal_forcing'); add_default($nl, 'config_add_ocean_thermal_forcing'); add_default($nl, 'config_alpha_subglacial_discharge'); add_default($nl, 'config_subglacial_discharge_coefficient'); add_default($nl, 'config_subglacial_discharge_intercept'); add_default($nl, 'config_uniform_face_melt_rate'); -add_default($nl, 'config_ocean_data_extrapolation'); +if (($MALI_PROGNOSTIC_MODE eq 'PROGNOSTIC') and ($GLC_NZOC gt 0)) { + add_default($nl, 'config_ocean_data_extrapolation'); +} else { + add_default($nl, 'config_ocean_data_extrapolation', 'val'=>".false."); +} add_default($nl, 'config_ocean_data_extrap_ncells_extra'); add_default($nl, 'config_invalid_value_TF'); add_default($nl, 'config_weight_value_cell'); @@ -647,6 +673,7 @@ add_default($nl, 'config_year_digits'); add_default($nl, 'config_output_external_velocity_solver_data'); add_default($nl, 'config_write_albany_ascii_mesh'); add_default($nl, 'config_create_all_logs_in_e3sm'); +add_default($nl, 'config_nISMIP6OceanLayers', 'val'=>"$GLC_NZOC"); ################################# # Namelist group: decomposition # diff --git a/components/mpas-albany-landice/bld/build-namelist-section b/components/mpas-albany-landice/bld/build-namelist-section index 14c0732bc2cf..2af1ffa2987b 100644 --- a/components/mpas-albany-landice/bld/build-namelist-section +++ b/components/mpas-albany-landice/bld/build-namelist-section @@ -187,6 +187,7 @@ add_default($nl, 'config_year_digits'); add_default($nl, 'config_output_external_velocity_solver_data'); add_default($nl, 'config_write_albany_ascii_mesh'); add_default($nl, 'config_create_all_logs_in_e3sm'); +add_default($nl, 'config_nISMIP6OceanLayers', 'val'=>"$GLC_NZOC"); ################################# # Namelist group: decomposition # diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml index b437bcdfc830..bc816bb07597 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml @@ -62,8 +62,8 @@ 'none' 1.0e-4 -170.0 -0.1 -.false. +1.0e36 +.true. .false. @@ -80,7 +80,7 @@ 1.0e-2 -'file' +'ismip6' 0.0 0.0 0.0 @@ -99,15 +99,15 @@ 0.0 0.25 'ismip6' -.false. +.true. 1.18 0.0 0.39 3.0e-4 0.15 0.0 -.false. -10 +.true. +5 1.0e36 0.9 @@ -155,6 +155,7 @@ .false. .false. .false. +0 3 diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml index 3ea4ef5e4786..11b8f81b082a 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml @@ -1127,6 +1127,14 @@ Valid values: .true. or .false. Default: Defined in namelist_defaults.xml + +Value for nISMIP6OceanLayers dimension. If the nISMIP6OceanLayers dimension is in an input file, that value will be used instead of the value in this option. This option is only intended to be used for ocean thermal forcing coupling in E3SM, in which case E3SM will set this option, define the values of ismip6shelfMelt_zOcean through the driver, and pass thermal forcing from the ocean model. Note that the default value of zero will result in this dimension not being defined (unless overridden by the value in an input file). + +Valid values: positive values or 0 +Default: Defined in namelist_defaults.xml + + diff --git a/components/mpas-albany-landice/cime_config/buildnml b/components/mpas-albany-landice/cime_config/buildnml index 73653b1ceae0..9cf26ba743f0 100755 --- a/components/mpas-albany-landice/cime_config/buildnml +++ b/components/mpas-albany-landice/cime_config/buildnml @@ -41,6 +41,8 @@ def buildnml(case, caseroot, compname): run_reftod = case.get_value("RUN_REFTOD") mali_use_albany = case.get_value("MALI_USE_ALBANY") mali_prognostic_mode = case.get_value("MALI_PROGNOSTIC_MODE") + glc_nzoc = case.get_value("GLC_NZOC") + ocn_glc_ismf_coupling = case.get_value("OCN_GLC_ISMF_COUPLING") stream_name = 'streams.landice' albany_input_name = 'albany_input.yaml' @@ -69,13 +71,13 @@ def buildnml(case, caseroot, compname): decomp_date += '150910' decomp_prefix += 'mpasli.graph.info.' elif glc_grid == 'mpas.ais8to30km': - grid_date += '20221027' + grid_date += '20250411' grid_prefix += 'ais_8to30km' datamode_date += '20250121' decomp_date += '240507' decomp_prefix += 'mpasli.graph.info.' elif glc_grid == 'mpas.ais4to20km': - grid_date += '20241224' + grid_date += '20250411' grid_prefix += 'ais_4to20km' decomp_date += '240507' decomp_prefix += 'mpasli.graph.info.' @@ -85,7 +87,7 @@ def buildnml(case, caseroot, compname): decomp_date += '150922' decomp_prefix += 'mpasli.graph.info.' elif glc_grid == 'mpas.gis4to40km': - grid_date += '20250214' + grid_date += '20250411' grid_prefix += 'gis_4to40km' decomp_date += '20250214' decomp_prefix += 'mpasli.graph.info.' @@ -176,6 +178,8 @@ def buildnml(case, caseroot, compname): sysmod += " -ntasks_glc '{}'".format(ntasks_glc) sysmod += " -ninst_glc '{}'".format(ninst_glc_real) sysmod += " -mali_prognostic_mode '{}'".format(mali_prognostic_mode) + sysmod += " -glc_nzoc '{}'".format(glc_nzoc) + sysmod += " -ocn_glc_ismf_coupling '{}'".format(ocn_glc_ismf_coupling) run_cmd_no_fail(sysmod, from_dir=maliconf_dir) @@ -256,13 +260,22 @@ def buildnml(case, caseroot, compname): lines.append(' ') lines.append(' ') lines.append(' ') + lines.append(' ') + lines.append(' ') + lines.append(' ') lines.append(' ') lines.append(' ') lines.append(' ') lines.append(' ') + lines.append(' ') lines.append(' ') lines.append(' ') lines.append(' ') + lines.append(' ') + lines.append(' ') + lines.append(' ') + lines.append(' ') + lines.append(' ') lines.append(' ') lines.append(' ') lines.append(' ') diff --git a/components/mpas-albany-landice/cime_config/config_pes.xml b/components/mpas-albany-landice/cime_config/config_pes.xml index 669f942ed022..7e0b56cb5b51 100644 --- a/components/mpas-albany-landice/cime_config/config_pes.xml +++ b/components/mpas-albany-landice/cime_config/config_pes.xml @@ -87,7 +87,7 @@ - + mali: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0 @@ -117,21 +117,6 @@ - - - mali+gcp10: default - - 30 - 30 - 30 - 16 - 16 - 16 - 30 - 30 - - - mali+lawrencium-lr3: default, 2 nodes diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index 57a940552c7e..b26e79712a44 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -52,7 +52,6 @@ module glc_comp_mct use li_core use li_core_interface - implicit none save private ! By default make data private @@ -696,6 +695,11 @@ end subroutine xml_stream_get_attributes ! block_ptr => block_ptr % next ! end do +! initialize ocean z-levels, if necessary +! these are used for ocean thermal forcing coupling + call init_ocean_z_levels(domain, err_tmp) + ierr = ior(ierr,err_tmp) + !----------------------------------------------------------------------- ! ! Calculate initial state in MALI (velocity, upperSurface, masks, etc.) @@ -785,6 +789,7 @@ subroutine glc_run_mct( EClock, cdata_g, x2g_g, g2x_g)!{{{ ! MALI modules use li_time_integration use li_statistics + use li_time_average_coupled implicit none ! @@ -810,7 +815,7 @@ subroutine glc_run_mct( EClock, cdata_g, x2g_g, g2x_g)!{{{ ! Variable related to MALI type (block_type), pointer :: block - type (mpas_pool_type), pointer :: geometryPool + type (mpas_pool_type), pointer :: geometryPool, meshPool, timeAveragingPool integer, pointer :: config_stats_interval !< interval (number oftimesteps) for writing stats logical, pointer :: config_do_restart, config_write_output_on_startup, config_write_stats_on_startup character(len=StrKIND), pointer :: config_restart_timestamp_name @@ -853,13 +858,13 @@ subroutine glc_run_mct( EClock, cdata_g, x2g_g, g2x_g)!{{{ err = ior(err,err_tmp) ! Initialize time average fields -! block_ptr => domain % blocklist -! do while(associated(block_ptr)) -! call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) -! call ocn_time_average_coupled_init(forcingPool) -! block_ptr => block_ptr % next -! end do - + block => domain % blocklist + do while(associated(block)) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'timeAveraging', timeAveragingPool) + call li_time_average_coupled_init(meshPool,timeAveragingPool) + block => block % next + end do ! During integration, time level 1 stores the model state to be solved. ! For a variables with a second time level, it is the previous value. @@ -1385,49 +1390,76 @@ subroutine glc_import_mct(x2g_g, errorCode) message integer :: & - i,n + i, n, iLev type (block_type), pointer :: block type (mpas_pool_type), pointer :: meshPool type (mpas_pool_type), pointer :: geometryPool type (mpas_pool_type), pointer :: thermalPool + type (mpas_pool_type), pointer :: extrapOceanDataPool - integer, pointer :: nCellsSolve + integer, pointer :: nCellsSolve, nISMIP6OceanLayers real (kind=RKIND), dimension(:), pointer :: sfcMassBal,& floatingBasalMassBal,& surfaceTemperature,& basalOceanHeatflx,& - OceanDensity, & - ismip6_2dThermalForcing + OceanDensity + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing + integer, dimension(:,:), pointer :: orig3dOceanMask + real(kind=RKIND), pointer :: config_invalid_value_TF + real(kind=RKIND) :: fractionalMaskVal errorCode = 0 + call mpas_pool_get_config(domain % configs, 'config_invalid_value_TF', config_invalid_value_TF) + n = 0 block => domain % blocklist do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) - call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) - - ! Get variables from pools call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'thermal', thermalPool) + call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) + ! Get dimensions + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_dimension(geometryPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + + ! Get variables from pools call mpas_pool_get_array(geometryPool, 'sfcMassBal', sfcMassBal) call mpas_pool_get_array(geometryPool, 'floatingBasalMassBal',floatingBasalMassBal) call mpas_pool_get_array(thermalPool, 'surfaceTemperature',surfaceTemperature) - call mpas_pool_get_array(geometryPool, 'ismip6_2dThermalForcing', ismip6_2dThermalForcing) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) + call mpas_pool_get_array(extrapOceanDataPool, 'orig3dOceanMask', orig3dOceanMask) ! call mpas_pool_get_array(thermalPool, 'basalOceanHeatflx',basalOceanHeatflx) !call mpas_pool_get_array(geometryPool, 'OceanDensity',OceanDensity) + if (nISMIP6OceanLayers > 0) then + orig3dOceanMask(:,:) = 0 + ismip6shelfMelt_3dThermalForcing(:,:) = 0.0_RKIND + endif do i = 1, nCellsSolve n = n + 1 sfcMassBal(i) = x2g_g % rAttr(index_x2g_Flgl_qice, n) floatingBasalMassBal(i) = x2g_g % rAttr(index_x2g_Fogx_qiceli, n) - if (ocn_c2_glctf) & - ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf2d, n) + if (nISMIP6OceanLayers > 0) then + do iLev = 1, nISMIP6OceanLayers + fractionalMaskVal = x2g_g % rAttr(index_x2g_So_tf3d_mask(iLev), n) + if (fractionalMaskVal > 0.5_RKIND) then + ! Only use MALI grid cells that have at least 50% overlap with MPAS-Ocean cells + ! if valid, mark our integer mask as 1 and scale the TF value by the fractional mask + orig3dOceanMask(iLev,i) = 1 + ismip6shelfMelt_3dThermalForcing(iLev, i) = x2g_g % rAttr(index_x2g_So_tf3d(iLev), n) / fractionalMaskVal + else + ! if not using, insert 0 in mask and bad val in TF field + orig3dOceanMask(iLev,i) = 0 + ismip6shelfMelt_3dThermalForcing(iLev, i) = config_invalid_value_TF + endif + enddo + endif ! surfaceTemperature(i) = x2g_g % rAttr(index_x2g_Sl_tsrf, n) !JW basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogo_qiceh, n) ! basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogx_qicehi, n) @@ -1459,16 +1491,22 @@ subroutine glc_export_mct(g2x_g, errorCode) type (block_type), pointer :: block real (kind=RKIND), pointer :: config_sea_level + character(len=StrKIND), pointer :: config_basal_mass_bal_float type (mpas_pool_type), pointer :: meshPool type (mpas_pool_type), pointer :: geometryPool type (mpas_pool_type), pointer :: thermalPool + type (mpas_pool_type), pointer :: timeAveragingPool integer, pointer :: nCellsSolve, nVertLevels real (kind=RKIND), dimension(:), pointer :: upperSurface real (kind=RKIND), dimension(:), pointer :: layerThicknessFractions real (kind=RKIND), dimension(:), pointer :: thickness + real (kind=RKIND), dimension(:), pointer :: avgBareIceAblationApplied + real (kind=RKIND), dimension(:), pointer :: avgCalvingFlux + real (kind=RKIND), dimension(:), pointer :: avgFaceMeltFlux + real (kind=RKIND), dimension(:), pointer :: avgFloatingBMBFlux real (kind=RKIND), dimension(:,:), pointer :: temperature integer, dimension(:), pointer :: cellMask !------------------------------------------------------------------- @@ -1479,6 +1517,7 @@ subroutine glc_export_mct(g2x_g, errorCode) block => domain % blocklist call mpas_pool_get_config(domain % configs, 'config_sea_level', config_sea_level) + call mpas_pool_get_config(domain % configs, 'config_basal_mass_bal_float', config_basal_mass_bal_float) do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) @@ -1487,26 +1526,36 @@ subroutine glc_export_mct(g2x_g, errorCode) ! Get variables from pools call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) - call mpas_pool_get_subpool(block % structs, 'thermal', thermalPool) + call mpas_pool_get_subpool(block % structs, 'thermal', thermalPool) + call mpas_pool_get_subpool(block % structs, 'timeAveraging', timeAveragingPool) call mpas_pool_get_array(geometryPool, 'upperSurface', upperSurface) call mpas_pool_get_array(meshPool, 'layerThicknessFractions', layerThicknessFractions) call mpas_pool_get_array(geometryPool, 'thickness', Thickness, timeLevel = 1) call mpas_pool_get_array(thermalPool, 'temperature', temperature) + call mpas_pool_get_array(timeAveragingPool, 'avgBareIceAblationApplied', avgBareIceAblationApplied) + call mpas_pool_get_array(timeAveragingPool, 'avgCalvingFlux', avgCalvingFlux) + call mpas_pool_get_array(timeAveragingPool, 'avgFaceMeltFlux', avgFaceMeltFlux) + call mpas_pool_get_array(timeAveragingPool, 'avgFloatingBMBFlux', avgFloatingBMBFlux) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) do i = 1, nCellsSolve n = n + 1 - ! Recuperate runoff routing switch code (originally in glc_route_ice_runoff module in earlier code), - ! and attach to ice calving flux once present... - !call route_ice_runoff(0.0_RKIND, & - ! rofi_to_ocn=Fogg_rofi, & - ! rofi_to_ice=Figg_rofi) - g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0!...and remove these placeholders - g2x_g % rAttr(index_g2x_Figg_rofi,n)=0.0 !...and remove these placeholders - g2x_g % rAttr(index_g2x_Fogg_rofl,n) = 0.0 !Attach to subglacial liquid flux once present + ! Fogg_rofl + g2x_g % rAttr(index_g2x_Fogg_rofl,n) = avgBareIceAblationApplied(i) + ! Figg_rofi + g2x_g % rAttr(index_g2x_Figg_rofi,n) = 0.0 ! placeholder + ! Fogg_rofi + g2x_g % rAttr(index_g2x_Fogg_rofi,n) = avgCalvingFlux(i) + g2x_g % rAttr(index_g2x_Fogg_rofi,n) = g2x_g % rAttr(index_g2x_Fogg_rofi,n) + avgFaceMeltFlux(i) + if (trim(config_basal_mass_bal_float) == 'ismip6') then + ! if MALI is calculating ISMF, add that to rofl + ! In some configurations, ISMF will be calculated in coupler or MPAS-Ocean + g2x_g % rAttr(index_g2x_Fogg_rofi,n) = g2x_g % rAttr(index_g2x_Fogg_rofi,n) + avgFloatingBMBFlux(i) + endif g2x_g % rAttr(index_g2x_Sg_topo, n) = max(0.0, upperSurface(i)) !updated to avoid warning for values below sea level g2x_g % rAttr(index_g2x_Sg_tbot, n) = temperature(nVertlevels,i) - SHR_CONST_TKTRIP @@ -1737,6 +1786,63 @@ subroutine datetime(cdate, ctime)!{{{ end subroutine datetime!}}} + subroutine init_ocean_z_levels(domain, err) + use glc_zocnclass_mod + + implicit none + type (domain_type), pointer, intent(inout) :: domain + integer, intent(out) :: err + + ! local vars + type (block_type), pointer :: block_ptr + type (mpas_pool_type), pointer :: geometryPool + integer, pointer :: nISMIP6OceanLayers + real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_zBndsOcean + integer :: cpl_num_zocn, iLev + + err = 0 + + cpl_num_zocn = glc_get_num_zocn_classes() + + block_ptr => domain % blocklist + call mpas_pool_get_subpool(block_ptr % structs, 'geometry', geometryPool) + call mpas_pool_get_dimension(geometryPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + + ! check that the num z-levels in the coupler matches what MALI was told to use + if (nISMIP6OceanLayers /= cpl_num_zocn) then + call mpas_log_write("nISMIP6OceanLayers=$i does not match glc_get_num_zocn_classes=$i", & + MPAS_LOG_ERR, intArgs=(/nISMIP6OceanLayers, cpl_num_zocn/)) + err = ior(err, 1) + return + endif + call seq_infodata_PutData(infodata, glc_nzoc=cpl_num_zocn) + + block_ptr => domain % blocklist + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'geometry', geometryPool) + if (nISMIP6OceanLayers > 0) then + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) + + + ismip6shelfMelt_zOcean = glc_get_zlevels() + ismip6shelfMelt_zBndsOcean = glc_get_zocnclass_bounds() + + call mpas_log_write("Using $i levels for ismip6shelfMelt_zOcean", intArgs=(/nISMIP6OceanLayers/)) + do iLev = 1, nISMIP6OceanLayers + call mpas_log_write("-- z-level $i: upper=$r, mid=$r, lower=$r", intArgs=(/iLev/), & + realArgs=(/ismip6shelfMelt_zBndsOcean(1,iLev), & + ismip6shelfMelt_zOcean(iLev), & + ismip6shelfMelt_zBndsOcean(2,iLev)/)) + enddo + endif + + block_ptr => block_ptr % next + end do + end subroutine init_ocean_z_levels + + end module glc_comp_mct !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/mpas-albany-landice/driver/glc_cpl_indices.F b/components/mpas-albany-landice/driver/glc_cpl_indices.F index 459b534a7e07..0bd17918ef00 100644 --- a/components/mpas-albany-landice/driver/glc_cpl_indices.F +++ b/components/mpas-albany-landice/driver/glc_cpl_indices.F @@ -10,7 +10,7 @@ module glc_cpl_indices SAVE public - integer , parameter, private:: glc_nec_max = 100 + integer , parameter, private:: glc_nzoc_max = 100 ! Note that, in both the drv -> glc and the glc -> drv fields, index 0 means bare land @@ -22,7 +22,8 @@ module glc_cpl_indices integer, public :: index_x2g_So_htv = 0 !Ice shelf ocean heat transfer velocity integer, public :: index_x2g_So_stv = 0 !Ice shelf ocean salinity transfer velocity integer, public :: index_x2g_So_rhoeff = 0 !Ocean effective pressure - integer, public :: index_x2g_So_tf2d = 0 !Ocean thermal forcing at predefined critical depth + integer, public :: index_x2g_So_tf3d(glc_nzoc_max) = 0 !Ocean thermal forcing at specified z-levels + integer, public :: index_x2g_So_tf3d_mask(glc_nzoc_max) = 0 !mask of ocean thermal forcing at specified z-levels integer, public :: index_x2g_Fogx_qiceli = 0 !Subshelf mass flux integer, public :: index_x2g_Fogx_qicehi = 0 !Subshelf heat flux for the ice sheet @@ -48,14 +49,20 @@ module glc_cpl_indices subroutine glc_cpl_indices_set( ) + use glc_zocnclass_mod + !------------------------------------------------------------- type(mct_aVect) :: g2x ! temporary type(mct_aVect) :: x2g ! temporary - integer :: num - character(len= 2) :: cnum - character(len=64) :: name + + integer :: glc_nzoc + integer :: iLev + character(len=2) :: cnum + character(len=64) :: varname !------------------------------------------------------------- + glc_nzoc = glc_get_num_zocn_classes() + ! create temporary attribute vectors call mct_aVect_init(x2g, rList=seq_flds_x2g_fields, lsize=1) @@ -71,7 +78,17 @@ subroutine glc_cpl_indices_set( ) index_x2g_Fogx_qiceli = mct_avect_indexra(x2g,'Fogx_qiceli',perrwith='quiet') index_x2g_Fogx_qicehi = mct_avect_indexra(x2g,'Fogx_qicehi',perrwith='quiet') index_x2g_So_rhoeff = mct_avect_indexra(x2g,'So_rhoeff',perrwith='quiet') - index_x2g_So_tf2d = mct_avect_indexra(x2g,'So_tf2d',perrwith='quiet') + + if (glc_nzoc > 0) then + do iLev = 1, glc_nzoc + cnum = glc_zocnclass_as_string(iLev) + varname = 'So_tf3d' // cnum + index_x2g_So_tf3d(iLev) = mct_avect_indexra(x2g, trim(varname)) + + varname = 'So_tf3d_mask' // cnum + index_x2g_So_tf3d_mask(iLev) = mct_avect_indexra(x2g, trim(varname)) + enddo + endif !Following block of x2g/g2x vectors are used internally within coupler for subshelf melt flux !calculations (and so do not have directly-related export-side arrays) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 1b0730fe4e29..4f007db8a01b 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -39,7 +39,7 @@ - - + @@ -1243,6 +1246,9 @@ is the value of that variable from the *previous* time level! + @@ -1471,6 +1477,30 @@ is the value of that variable from the *previous* time level! /> + + + + + + + + + + + + diff --git a/components/mpas-albany-landice/src/landice.cmake b/components/mpas-albany-landice/src/landice.cmake index 94a4e85e795a..5012aeb58696 100644 --- a/components/mpas-albany-landice/src/landice.cmake +++ b/components/mpas-albany-landice/src/landice.cmake @@ -47,6 +47,7 @@ list(APPEND RAW_SOURCES core_landice/shared/mpas_li_setup.F core_landice/shared/mpas_li_mesh.F core_landice/shared/mpas_li_config.F + core_landice/shared/mpas_li_time_average_coupled.F ) # analysis members diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F index 4cb0f3e132db..ec28d4d15f69 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F @@ -146,6 +146,7 @@ subroutine li_advection_thickness_tracers(& bedTopography, & ! bed topography sfcMassBal, & ! surface mass balance (potential forcing) sfcMassBalApplied, & ! surface mass balance (actually applied) + bareIceAblationApplied, & ! ablation (melting) of bare ice (actually applied) groundedSfcMassBalApplied, & ! surface mass balance on grounded locations (actually applied) basalMassBal, & ! basal mass balance groundedBasalMassBal, & ! basal mass balance for grounded ice @@ -282,6 +283,7 @@ subroutine li_advection_thickness_tracers(& call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'sfcMassBal', sfcMassBal) call mpas_pool_get_array(geometryPool, 'sfcMassBalApplied', sfcMassBalApplied) + call mpas_pool_get_array(geometryPool, 'bareIceAblationApplied', bareIceAblationApplied) call mpas_pool_get_array(geometryPool, 'groundedSfcMassBalApplied', groundedSfcMassBalApplied) call mpas_pool_get_array(geometryPool, 'basalMassBal', basalMassBal) call mpas_pool_get_array(geometryPool, 'groundedBasalMassBal', groundedBasalMassBal) @@ -606,6 +608,7 @@ subroutine li_advection_thickness_tracers(& bedTopography, & sfcMassBal, & sfcMassBalApplied, & + bareIceAblationApplied, & groundedSfcMassBalApplied, & basalMassBal, & basalMassBalApplied, & @@ -859,6 +862,7 @@ subroutine apply_mass_balance(& bedTopography, & sfcMassBal, & sfcMassBalApplied, & + bareIceAblationApplied, & groundedSfcMassBalApplied, & basalMassBal, & basalMassBalApplied, & @@ -905,6 +909,10 @@ subroutine apply_mass_balance(& real(kind=RKIND), dimension(:), intent(out) :: & sfcMassBalApplied !< Output: surface mass balance actually applied on this time step (kg/m^2/s) + real(kind=RKIND), dimension(:), intent(out) :: & + bareIceAblationApplied !< Output: applied bare ice ablation (melting) occurring on on this time step (kg/m^2/s). + ! Note that this is the value that actually produces runoff sent to coupler (Fogg_rofl) + real(kind=RKIND), dimension(:), intent(out) :: & groundedSfcMassBalApplied !< Output: surface mass balance actually applied to grounded ice on this time step (kg/m^2/s) @@ -1012,11 +1020,15 @@ subroutine apply_mass_balance(& !TODO - If remaining sfcAblat > 0, then keep track of it to conserve energy (?) endif - endif ! sfcMassBal > 0 - ! apply basal mass balance + ! calculate bare ice ablation applied field + bareIceAblationApplied(:) = 0.0_RKIND + where (sfcMassBalApplied < 0.0_RKIND) + bareIceAblationApplied = -1.0_RKIND * sfcMassBalApplied + end where + ! apply basal mass balance if (basalMassBalApplied(iCell) > 0.0_RKIND) then ! basal freeze-on diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F index 0e6ff08df22d..de3e5fc9f2aa 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F @@ -74,6 +74,7 @@ function li_core_init(domain, startTimeStamp) result(err) use li_subglacial_hydro use li_bedtopo use li_advection + use li_time_average_coupled !!! use mpas_tracer_advection !!! use li_global_diagnostics @@ -110,7 +111,7 @@ function li_core_init(domain, startTimeStamp) result(err) logical, pointer :: config_do_restart real (kind=RKIND), pointer :: deltat ! variable in each block real (kind=RKIND) :: dtSeconds ! local variable - type (MPAS_Pool_type), pointer :: meshPool, geometryPool, velocityPool + type (MPAS_Pool_type), pointer :: meshPool, geometryPool, velocityPool, timeAveragingPool type (MPAS_TimeInterval_type) :: timeStepInterval character (len=StrKIND), pointer :: xtime, simulationStartTime real (kind=RKIND), pointer :: daysSinceStart @@ -299,6 +300,7 @@ function li_core_init(domain, startTimeStamp) result(err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'timeAveraging', timeAveragingPool) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) err = ior(err, err_tmp) @@ -324,6 +326,9 @@ function li_core_init(domain, startTimeStamp) result(err) call li_analysis_init(domain, err_tmp) err = ior(err, err_tmp) + ! initialize time averaging of fields sent to coupler + call li_time_average_coupled_init(meshPool,timeAveragingPool) + ! halo update for reconstruction coefficients ! Note: Results on multiple processors may be incorrect without this update diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration.F index d8bd4ae94a67..e6e2ab7d8e51 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration.F @@ -29,6 +29,7 @@ module li_time_integration use li_time_integration_fe_rk use li_setup use li_constants + use li_time_average_coupled implicit none private @@ -100,7 +101,7 @@ subroutine li_timestep(domain, err) !----------------------------------------------------------------- ! Pools pointers type (block_type), pointer :: block - type (mpas_pool_type), pointer :: meshPool + type (mpas_pool_type), pointer :: meshPool, timeAveragingPool, geometryPool character (len=StrKIND), pointer :: xtime real (kind=RKIND), pointer :: daysSinceStart character (len=StrKIND), pointer :: simulationStartTime @@ -159,7 +160,6 @@ subroutine li_timestep(domain, err) block => block % next end do - ! === ! === Perform timestep ! === @@ -175,6 +175,14 @@ subroutine li_timestep(domain, err) end select err = ior(err,err_tmp) + ! === accumulate fluxes for time averaging of fields sent to coupler + block => domain % blocklist + do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'timeAveraging', timeAveragingPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call li_time_average_coupled_accumulate(timeAveragingPool, geometryPool, meshPool) + block => block % next + end do ! === error check if (err > 0) then diff --git a/components/mpas-albany-landice/src/shared/Makefile b/components/mpas-albany-landice/src/shared/Makefile index e0f1828298d9..1b812a81952c 100644 --- a/components/mpas-albany-landice/src/shared/Makefile +++ b/components/mpas-albany-landice/src/shared/Makefile @@ -5,7 +5,8 @@ OBJS = mpas_li_constants.o \ mpas_li_mask.o \ mpas_li_mesh.o \ mpas_li_config.o \ - mpas_li_setup.o + mpas_li_setup.o \ + mpas_li_time_average_coupled.o all: $(OBJS) @@ -19,6 +20,8 @@ mpas_li_mesh.o: mpas_li_config.o: +mpas_li_time_average_coupled.o: + clean: $(RM) *.o *.mod *.f90 @# Certain systems with intel compilers generate *.i files diff --git a/components/mpas-albany-landice/src/shared/mpas_li_time_average_coupled.F b/components/mpas-albany-landice/src/shared/mpas_li_time_average_coupled.F new file mode 100644 index 000000000000..292438058747 --- /dev/null +++ b/components/mpas-albany-landice/src/shared/mpas_li_time_average_coupled.F @@ -0,0 +1,143 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! \file mpas_li_time_average_coupled.F +! +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.io/license.html +! +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! li_time_average_coupled +! +!> \brief MALI time averager for coupling +!> \author Stephen Price and Matthew Hoffman, modified +!> after similarly named subroutine for MPAS Ocean +!> written by Doug Jacobsen. +!> \date 04 March 2025 +!> \details +!> This module contains subroutines for time averaging of MALI fluxes +!> for use in coupling to E3SM. +! +!------------------------------------------------------------------------------- + +module li_time_average_coupled + + use mpas_kind_types + use mpas_derived_types + use mpas_pool_routines + + implicit none + save + public + + contains + +!*********************************************************************** +! +! routine li_time_average_coupled_init +! +!> \brief Coupled time averager initialization +!> \author Stephen Price +!> \date 04 March 2025 +!> \details +!> This routine initializes the coupled time averaging fields +! +!----------------------------------------------------------------------- + subroutine li_time_average_coupled_init(meshPool,timeAveragingPool) + + type (mpas_pool_type), intent(in) :: meshPool + type (mpas_pool_type), intent(inout) :: timeAveragingPool + + real (kind=RKIND), dimension(:), pointer :: avgBareIceAblationApplied, avgCalvingFlux, & + avgFaceMeltFlux, avgFloatingBMBFlux + + integer, pointer :: nCells + + real (kind=RKIND), pointer :: timeAccumulatedCoupled + + integer :: iCell + + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + + call mpas_pool_get_array(timeAveragingPool, 'timeAccumulatedCoupled', timeAccumulatedCoupled) + call mpas_pool_get_array(timeAveragingPool, 'avgBareIceAblationApplied', avgBareIceAblationApplied) + call mpas_pool_get_array(timeAveragingPool, 'avgCalvingFlux', avgCalvingFlux) + call mpas_pool_get_array(timeAveragingPool, 'avgFaceMeltFlux', avgFaceMeltFlux) + call mpas_pool_get_array(timeAveragingPool, 'avgFloatingBMBFlux', avgFloatingBMBFlux) + + do iCell = 1, nCells + avgBareIceAblationApplied(iCell) = 0.0_RKIND + avgCalvingFlux(iCell) = 0.0_RKIND + avgFaceMeltFlux(iCell) = 0.0_RKIND + avgFloatingBMBFlux(iCell) = 0.0_RKIND + end do + + timeAccumulatedCoupled = 0.0_RKIND + + end subroutine li_time_average_coupled_init + +!*********************************************************************** +! +! routine li_time_average_coupled_accumulate +! +!> \brief Coupled time averager accumulation +!> \author Stephen Price +!> \date 04 March 2025 +!> \details +!> This routine accumulates the coupled time averaging fields +! +!----------------------------------------------------------------------- + subroutine li_time_average_coupled_accumulate(timeAveragingPool, geometryPool, meshPool) + + use li_setup + + type (mpas_pool_type), intent(inout) :: timeAveragingPool + type (mpas_pool_type), intent(in) :: geometryPool + type (mpas_pool_type), intent(in) :: meshPool + + real (kind=RKIND), dimension(:), pointer :: bareIceAblationApplied, avgBareIceAblationApplied, & + calvingThickness, avgCalvingFlux, & + faceMeltingThickness, avgFaceMeltFlux, avgFloatingBMBFlux, & + floatingBasalMassBalApplied + integer, pointer :: nCells + + real (kind=RKIND), pointer :: timeAccumulatedCoupled, rhoi, deltat + + integer :: iCell + + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) + call mpas_pool_get_array(meshPool, 'deltat', deltat) + call mpas_pool_get_array(timeAveragingPool, 'timeAccumulatedCoupled', timeAccumulatedCoupled) + call mpas_pool_get_array(geometryPool, 'bareIceAblationApplied', bareIceAblationApplied) + call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) + call mpas_pool_get_array(geometryPool, 'faceMeltingThickness', faceMeltingThickness) + call mpas_pool_get_array(geometryPool, 'floatingBasalMassBalApplied', floatingBasalMassBalApplied) + call mpas_pool_get_array(timeAveragingPool, 'avgBareIceAblationApplied', avgBareIceAblationApplied) + call mpas_pool_get_array(timeAveragingPool, 'avgCalvingFlux', avgCalvingFlux) + call mpas_pool_get_array(timeAveragingPool, 'avgFaceMeltFlux', avgFaceMeltFlux) + call mpas_pool_get_array(timeAveragingPool, 'avgFloatingBMBFlux', avgFloatingBMBFlux) + + do iCell = 1, nCells + + avgBareIceAblationApplied(iCell) = ( avgBareIceAblationApplied(iCell) * timeAccumulatedCoupled & + + bareIceAblationApplied(iCell) * deltat ) / ( timeAccumulatedCoupled + deltat ) + + avgCalvingFlux(iCell) = ( avgCalvingFlux(iCell) * timeAccumulatedCoupled & + + calvingThickness(iCell) * deltat * (rhoi / deltat) ) / ( timeAccumulatedCoupled + deltat ) + + avgFaceMeltFlux(iCell) = ( avgFaceMeltFlux(iCell) * timeAccumulatedCoupled & + + faceMeltingThickness(iCell) * deltat * (rhoi / deltat) ) / ( timeAccumulatedCoupled + deltat ) + + avgFloatingBMBFlux(iCell) = ( avgFloatingBMBFlux(iCell) * timeAccumulatedCoupled & + + floatingBasalMassBalApplied(iCell) * deltat) / ( timeAccumulatedCoupled + deltat ) + end do + + timeAccumulatedCoupled = timeAccumulatedCoupled + deltat + + end subroutine li_time_average_coupled_accumulate + +end module li_time_average_coupled diff --git a/components/mpas-framework/src/framework/mpas_io.F b/components/mpas-framework/src/framework/mpas_io.F index 8a962e460c6e..881e73d2ae1a 100644 --- a/components/mpas-framework/src/framework/mpas_io.F +++ b/components/mpas-framework/src/framework/mpas_io.F @@ -134,7 +134,7 @@ subroutine MPAS_io_init(ioContext, io_task_count, io_task_stride, io_system, ier io_task_stride, & ! stride PIO_rearr_box, & ! rearr ioContext % pio_iosystem) ! iosystem - + end if call pio_seterrorhandling(ioContext % pio_iosystem, PIO_BCAST_ERROR) @@ -149,7 +149,7 @@ end subroutine MPAS_io_init !> \brief Set master PIO io type !> \author Doug Jacobsen !> \date 10/18/2013 -!> \details +!> \details !> This routine sets the master io type for use with PIO. ! !----------------------------------------------------------------------- @@ -177,7 +177,7 @@ end subroutine MPAS_io_set_iotype !> \brief Unset master PIO io type !> \author Doug Jacobsen !> \date 10/18/2013 -!> \details +!> \details !> This routine sets the master io type for use with PIO to it's default !> "unset" value. ! @@ -197,7 +197,7 @@ subroutine MPAS_io_unset_iotype(ioContext, ierr) end subroutine MPAS_io_unset_iotype - + type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioContext, clobber_file, truncate_file, ierr) implicit none @@ -233,7 +233,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon if (mode /= MPAS_IO_READ .and. & mode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_INVALID_MODE - return + return end if if (ioformat /= MPAS_IO_NETCDF .and. & ioformat /= MPAS_IO_NETCDF4 .and. & @@ -242,11 +242,11 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon ioformat /= MPAS_IO_ADIOS .and. & ioformat /= MPAS_IO_ADIOSC) then if (present(ierr)) ierr = MPAS_IO_ERR_INVALID_FORMAT - return + return end if if (len(filename) > 1024) then if (present(ierr)) ierr = MPAS_IO_ERR_LONG_FILENAME - return + return end if MPAS_io_open % filename = filename @@ -308,7 +308,7 @@ type (MPAS_IO_Handle_type) function MPAS_io_open(filename, mode, ioformat, ioCon if (present(ierr)) ierr = MPAS_IO_ERR_WOULD_CLOBBER return end if - + if (exists .and. (.not. local_truncate)) then pio_ierr = PIO_openfile(ioContext % pio_iosystem, MPAS_io_open % pio_file, pio_iotype, trim(filename), PIO_write) MPAS_io_open % preexisting_file = .true. @@ -382,14 +382,14 @@ subroutine MPAS_io_inq_unlimited_dim(handle, dimname, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % iomode /= MPAS_IO_READ) then ! We could eventually handle this for write mode, too... if (present(ierr)) ierr = MPAS_IO_ERR_WRONG_MODE return end if - pio_ierr = PIO_inq_dimname(handle % pio_file, handle % pio_unlimited_dimid, dimname) + pio_ierr = PIO_inq_dimname(handle % pio_file, handle % pio_unlimited_dimid, dimname) if (pio_ierr /= PIO_noerr) then if (present(ierr)) ierr = MPAS_IO_ERR_NO_UNLIMITED_DIM dimname = ' ' @@ -418,7 +418,7 @@ subroutine MPAS_io_inq_dim(handle, dimname, dimsize, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -463,7 +463,7 @@ subroutine MPAS_io_inq_dim(handle, dimname, dimsize, ierr) dimsize = -1 return end if - + ! Keep dimension information for future reference if (.not. associated(handle % dimlist_head)) then handle % dimlist_head => new_dimlist_node @@ -500,15 +500,15 @@ subroutine MPAS_io_def_dim(handle, dimname, dimsize, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if @@ -519,7 +519,7 @@ subroutine MPAS_io_def_dim(handle, dimname, dimsize, ierr) do while (associated(dim_cursor)) if (trim(dimname) == trim(dim_cursor % dimhandle % dimname)) then - ! The second half of the test below avoids raising errors in the case where + ! The second half of the test below avoids raising errors in the case where ! we are writing to an already existing file, in which case the dimlen for the ! unlimited dimension in the file will generally not be MPAS_IO_UNLIMITED_DIM if ((dimsize /= dim_cursor % dimhandle % dimsize) .and. & @@ -625,7 +625,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -651,7 +651,7 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz allocate(new_fieldlist_node) nullify(new_fieldlist_node % next) allocate(new_fieldlist_node % fieldhandle) - + new_fieldlist_node % fieldhandle % fieldname = fieldname ! Get variable ID @@ -689,6 +689,12 @@ subroutine MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsiz else if (new_fieldlist_node % fieldhandle % field_type == PIO_char) then new_fieldlist_node % fieldhandle % field_type = MPAS_IO_CHAR !!!!!!!! PIO DOES NOT SUPPORT LOGICAL !!!!!!!! + else + call mpas_log_write('ERROR: Unsupported field type $i in variable: ' // & + trim(fieldname) // ' in file: ' // trim(handle % filename) // '. MPAS supports ' // & + 'double and single floats, 32-bit integers and char only ($i, $i, $i, $i).', & + intArgs=(/new_fieldlist_node % fieldhandle % field_type, PIO_double, PIO_real, PIO_int, PIO_char/), & + messageType=MPAS_LOG_CRIT) end if ! Get number of dimensions @@ -852,15 +858,15 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if @@ -936,9 +942,9 @@ subroutine MPAS_io_def_var(handle, fieldname, fieldtype, dimnames, precision, ie return end if end do - + ! TODO: Can we get the dimension sizes to see whether they match those from the file? - + end if return @@ -1058,11 +1064,11 @@ subroutine MPAS_io_get_var_indices(handle, fieldname, indices, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if - ! + ! ! Check whether the field has been defined ! field_cursor => handle % fieldlist_head @@ -1102,7 +1108,7 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) integer :: pio_type integer :: ndims integer (kind=MPAS_IO_OFFSET_KIND) :: pd, indx - integer :: i + integer :: i integer :: early_return, early_return_global integer (kind=MPAS_IO_OFFSET_KIND) :: i1, i2, i3, i4, i5 integer, dimension(:), pointer :: dimlist @@ -1115,11 +1121,11 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if ! call mpas_log_write('Assigning $i indices for '//trim(fieldname), intArgs=(/size(indices)/) ) - ! + ! ! Check whether the field has been defined ! field_cursor => handle % fieldlist_head @@ -1176,10 +1182,10 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) decomp_cursor => decomp_cursor % next cycle DECOMP_LOOP end if - end do - + end do + ! OK, we have a match... just use this decomposition for the field and return - field_cursor % fieldhandle % decomp => decomp_cursor % decomphandle + field_cursor % fieldhandle % decomp => decomp_cursor % decomphandle !call mpas_log_write('Found a matching decomposition that we can use') early_return = 1 exit DECOMP_LOOP @@ -1209,10 +1215,10 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) decomp_cursor => decomp_cursor % next cycle DECOMP_LOOP end if - end do - + end do + ! OK, we have a match... just use this decomposition for the field and return - field_cursor % fieldhandle % decomp => decomp_cursor % decomphandle + field_cursor % fieldhandle % decomp => decomp_cursor % decomphandle !call mpas_log_write('Found a matching decomposition that we can use (aside from record dimension)') early_return = 1 exit DECOMP_LOOP @@ -1221,9 +1227,9 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) decomp_cursor => decomp_cursor % next end do DECOMP_LOOP - ! + ! ! If all tasks have set early_return to 1, then we have a usable decomposition and can return - ! + ! call mpas_dmpar_min_int(handle % ioContext % dminfo, early_return, early_return_global) if (early_return_global == 1) then return @@ -1238,7 +1244,7 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) ! ndims = field_cursor % fieldhandle % ndims if (field_cursor % fieldhandle % has_unlimited_dim) ndims = ndims - 1 - + allocate(new_decomp) nullify(new_decomp % next) @@ -1273,7 +1279,7 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) dimlist(ndims) = size(indices) pd = pd * int(dimlist(ndims),MPAS_IO_OFFSET_KIND) - allocate(compdof(pd)) + allocate(compdof(pd)) indx = 1 if (ndims == 5) then @@ -1411,7 +1417,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if ! call mpas_log_write('Reading '// trim(fieldname)) @@ -1443,7 +1449,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr #endif start1(1) = handle % frame_number count1(1) = 1 - + start2(1) = 1 start2(2) = handle % frame_number count2(2) = 1 @@ -2249,7 +2255,7 @@ logical function MPAS_io_would_clobber_records(handle, ierr) if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE MPAS_io_would_clobber_records = .false. - return + return end if if (handle % frame_number <= handle % preexisting_records) then @@ -2318,7 +2324,7 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (.not. handle % data_mode) then @@ -2361,7 +2367,7 @@ subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArr #endif start1(1) = handle % frame_number count1(1) = 1 - + start2(1) = 1 start2(2) = handle % frame_number count2(2) = 1 @@ -3169,7 +3175,7 @@ subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -3308,7 +3314,7 @@ subroutine MPAS_io_get_att_int1d(handle, attName, attValue, fieldname, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -3462,7 +3468,7 @@ subroutine MPAS_io_get_att_real0d(handle, attName, attValue, fieldname, precisio ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -3636,7 +3642,7 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -3822,7 +3828,7 @@ subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if @@ -3959,19 +3965,19 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if - allocate(new_attlist_node) + allocate(new_attlist_node) nullify(new_attlist_node % next) allocate(new_attlist_node % attHandle) new_attlist_node % attHandle % attName = attName @@ -3996,7 +4002,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, attlist_cursor % atthandle % attValueInt /= attValue) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) end if return end if @@ -4011,7 +4017,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, if (.not. associated(field_cursor)) then if (present(ierr)) ierr = MPAS_IO_ERR_UNDEFINED_VAR deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) return end if @@ -4040,7 +4046,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, attlist_cursor % atthandle % attValueInt /= attValue) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) end if return end if @@ -4070,7 +4076,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, end if end if - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) if (pio_ierr /= PIO_noerr) then if (present(ierr)) ierr = MPAS_IO_ERR_PIO return @@ -4107,19 +4113,19 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if - allocate(new_attlist_node) + allocate(new_attlist_node) nullify(new_attlist_node % next) allocate(new_attlist_node % attHandle) new_attlist_node % attHandle % attName = attName @@ -4145,11 +4151,11 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, size(attlist_cursor % atthandle % attValueIntA) /= size(attValue)) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) ! else if (attlist_cursor % atthandle % attValueIntA(:) /= attValue(:)) then ! array sizes should match based on previous if-test ! if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT ! deallocate(new_attlist_node % attHandle) -! deallocate(new_attlist_node) +! deallocate(new_attlist_node) end if return end if @@ -4164,7 +4170,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, if (.not. associated(field_cursor)) then if (present(ierr)) ierr = MPAS_IO_ERR_UNDEFINED_VAR deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) return end if @@ -4193,7 +4199,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, size(attlist_cursor % atthandle % attValueIntA) /= size(attValue)) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) ! else if (attlist_cursor % atthandle % attValueIntA /= attValue) then ! else if (attlist_cursor % atthandle % attValueIntA /= attValue) then ! else if (attlist_cursor % atthandle % attValueIntA /= attValue) then @@ -4227,7 +4233,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, end if end if - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) if (pio_ierr /= PIO_noerr) then if (present(ierr)) ierr = MPAS_IO_ERR_PIO return @@ -4268,19 +4274,19 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if - allocate(new_attlist_node) + allocate(new_attlist_node) nullify(new_attlist_node % next) allocate(new_attlist_node % attHandle) new_attlist_node % attHandle % attName = attName @@ -4310,7 +4316,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, attlist_cursor % atthandle % attValueReal /= attValue) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) end if return end if @@ -4325,7 +4331,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, if (.not. associated(field_cursor)) then if (present(ierr)) ierr = MPAS_IO_ERR_UNDEFINED_VAR deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) return end if @@ -4354,7 +4360,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, attlist_cursor % atthandle % attValueReal /= attValue) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) end if return end if @@ -4387,13 +4393,13 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, if ((new_attlist_node % attHandle % precision == MPAS_IO_SINGLE_PRECISION) .and. & (MPAS_IO_NATIVE_PRECISION /= MPAS_IO_SINGLE_PRECISION)) then singleVal = real(attValueLocal,R4KIND) - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal) else if ((new_attlist_node % attHandle % precision == MPAS_IO_DOUBLE_PRECISION) .and. & (MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then doubleVal = real(attValueLocal,R8KIND) - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal) else - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) end if if (pio_ierr /= PIO_noerr) then @@ -4436,19 +4442,19 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if - allocate(new_attlist_node) + allocate(new_attlist_node) nullify(new_attlist_node % next) allocate(new_attlist_node % attHandle) new_attlist_node % attHandle % attName = attName @@ -4479,11 +4485,11 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, size(attlist_cursor % atthandle % attValueRealA) /= size(attValue)) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) ! else if (attlist_cursor % atthandle % attValueIntA(:) /= attValue(:)) then ! array sizes should match based on previous if-test ! if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT ! deallocate(new_attlist_node % attHandle) -! deallocate(new_attlist_node) +! deallocate(new_attlist_node) end if return end if @@ -4498,7 +4504,7 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, if (.not. associated(field_cursor)) then if (present(ierr)) ierr = MPAS_IO_ERR_UNDEFINED_VAR deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) return end if @@ -4527,7 +4533,7 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, size(attlist_cursor % atthandle % attValueRealA) /= size(attValue)) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) ! else if (attlist_cursor % atthandle % attValueIntA /= attValue) then ! else if (attlist_cursor % atthandle % attValueIntA /= attValue) then ! else if (attlist_cursor % atthandle % attValueIntA /= attValue) then @@ -4565,16 +4571,16 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, (MPAS_IO_NATIVE_PRECISION /= MPAS_IO_SINGLE_PRECISION)) then allocate(singleVal(size(attValueLocal))) singleVal(:) = real(attValueLocal(:),R4KIND) - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal) deallocate(singleVal) else if ((new_attlist_node % attHandle % precision == MPAS_IO_DOUBLE_PRECISION) .and. & (MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then allocate(doubleVal(size(attValueLocal))) doubleVal(:) = real(attValueLocal(:),R8KIND) - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal) deallocate(doubleVal) else - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) end if if (pio_ierr /= PIO_noerr) then if (present(ierr)) ierr = MPAS_IO_ERR_PIO @@ -4623,19 +4629,19 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if if (handle % data_mode) then if (present(ierr)) ierr = MPAS_IO_ERR_DATA_MODE - return + return end if if (handle % iomode /= MPAS_IO_WRITE) then if (present(ierr)) ierr = MPAS_IO_ERR_NOWRITE - return + return end if - allocate(new_attlist_node) + allocate(new_attlist_node) nullify(new_attlist_node % next) allocate(new_attlist_node % attHandle) new_attlist_node % attHandle % attName = attName @@ -4660,7 +4666,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i trim(attlist_cursor % atthandle % attValueText) /= trim(attValue)) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) end if return end if @@ -4675,7 +4681,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i if (.not. associated(field_cursor)) then if (present(ierr)) ierr = MPAS_IO_ERR_UNDEFINED_VAR deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) return end if @@ -4704,7 +4710,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i trim(attlist_cursor % atthandle % attValueText) /= trim(attValue)) then if (present(ierr)) ierr = MPAS_IO_ERR_REDEF_ATT deallocate(new_attlist_node % attHandle) - deallocate(new_attlist_node) + deallocate(new_attlist_node) end if return end if @@ -4734,15 +4740,15 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i end if end if - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) if (pio_ierr /= PIO_noerr) then if (present(ierr)) ierr = MPAS_IO_ERR_PIO ! - ! If we are working with a pre-existing file and the text attribute is larger than in the file, we need + ! If we are working with a pre-existing file and the text attribute is larger than in the file, we need ! to enter define mode before writing the attribute. Note the PIO_redef documentation: - ! 'Entering and leaving netcdf define mode causes a file sync operation to occur, + ! 'Entering and leaving netcdf define mode causes a file sync operation to occur, ! these operations can be very expensive in parallel systems.' ! if (handle % preexisting_file .and. .not. handle % data_mode) then @@ -4751,7 +4757,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i return end if - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) if (pio_ierr /= PIO_noerr) then return end if @@ -4817,7 +4823,7 @@ subroutine MPAS_io_sync(handle, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if call PIO_syncfile(handle % pio_file) @@ -4842,18 +4848,18 @@ subroutine MPAS_io_close(handle, ierr) ! Sanity checks if (.not. handle % initialized) then if (present(ierr)) ierr = MPAS_IO_ERR_UNINIT_HANDLE - return + return end if ! Deallocate memory associated with the file fieldlist_ptr => handle % fieldlist_head do while (associated(fieldlist_ptr)) - fieldlist_del => fieldlist_ptr + fieldlist_del => fieldlist_ptr fieldlist_ptr => fieldlist_ptr % next attlist_ptr => fieldlist_del % fieldhandle % attlist_head do while (associated(attlist_ptr)) - attlist_del => attlist_ptr + attlist_del => attlist_ptr attlist_ptr => attlist_ptr % next if (attlist_del % atthandle % attType == MPAS_ATT_INTA) deallocate(attlist_del % atthandle % attValueIntA) if (attlist_del % atthandle % attType == MPAS_ATT_REALA) deallocate(attlist_del % atthandle % attValueRealA) @@ -4871,7 +4877,7 @@ subroutine MPAS_io_close(handle, ierr) dimlist_ptr => handle % dimlist_head do while (associated(dimlist_ptr)) - dimlist_del => dimlist_ptr + dimlist_del => dimlist_ptr dimlist_ptr => dimlist_ptr % next deallocate(dimlist_del % dimhandle) end do @@ -4880,7 +4886,7 @@ subroutine MPAS_io_close(handle, ierr) attlist_ptr => handle % attlist_head do while (associated(attlist_ptr)) - attlist_del => attlist_ptr + attlist_del => attlist_ptr attlist_ptr => attlist_ptr % next if (attlist_del % atthandle % attType == MPAS_ATT_INTA) deallocate(attlist_del % atthandle % attValueIntA) if (attlist_del % atthandle % attType == MPAS_ATT_REALA) deallocate(attlist_del % atthandle % attValueRealA) @@ -5007,5 +5013,5 @@ subroutine MPAS_io_err_mesg(ierr, fatal) if (fatal .and. (ierr /= MPAS_IO_NOERR)) call mpas_log_write('ERROR In MPAS_IO', MPAS_LOG_CRIT) end subroutine MPAS_io_err_mesg - + end module mpas_io diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index 14e95edfc014..457078f1314a 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -51,9 +51,6 @@ OPTIONS -ocn_iceberg variable for defining if the ocn model is expecting coupling fields for icebergs from the seaice model Options are: false, true - -ocn_ismf variable for defining how the ocn model will handle ice shelf melt - fluxes - Options are: none, data, internal, coupled -ocn_sgr variable for defining how the ocn model will handle subglacial runoff Options are: none, data @@ -72,6 +69,10 @@ OPTIONS -ninst_ocn NINST_OCN for this case -ocn_tidal_mixing variable for defining if to run with parameterized tidal mixing Options are: false, true. Default is false + -glc_nzoc number of z-ocean classes for indirect glc-ocn coupling [0 | 4 | 30] + -ocn_glc_ismf_coupling methods for ocn/glc ice-shelf melt flux coupling + ['none' | 'data_mpaso' | 'data_mali' | 'internal_mpaso' | + 'tf' | 'coupler'] NOTE: The precedence for setting the values of namelist variables is (highest to lowest): 1. namelist values set by specific command-line options, i.e. (none right now) @@ -113,7 +114,6 @@ my %opts = ( help => 0, ocn_grid => undef, ocn_forcing => undef, ocn_iceberg => undef, - ocn_ismf => undef, ocn_sgr => undef, decomp_prefix => undef, date_stamp => undef, @@ -126,6 +126,8 @@ my %opts = ( help => 0, ntasks_ocn => 0, ninst_ocn => 0, ocn_tidal_mixing => undef, + glc_nzoc => 0, + ocn_glc_ismf_coupling => undef, ); GetOptions( @@ -140,7 +142,6 @@ GetOptions( "ocn_grid=s" => \$opts{'ocn_grid'}, "ocn_forcing=s" => \$opts{'ocn_forcing'}, "ocn_iceberg=s" => \$opts{'ocn_iceberg'}, - "ocn_ismf=s" => \$opts{'ocn_ismf'}, "ocn_sgr=s" => \$opts{'ocn_sgr'}, "decomp_prefix=s" => \$opts{'decomp_prefix'}, "date_stamp=s" => \$opts{'date_stamp'}, @@ -154,6 +155,8 @@ GetOptions( "ninst_ocn=i" => \$opts{'ninst_ocn'}, "preview" => \$opts{'preview'}, "ocn_tidal_mixing=s" => \$opts{'ocn_tidal_mixing'}, + "glc_nzoc=i" => \$opts{'glc_nzoc'}, + "ocn_glc_ismf_coupling=s" => \$opts{'ocn_glc_ismf_coupling'}, ) or usage(); # Give usage message. @@ -184,7 +187,6 @@ my $inst_string = $opts{'inst_string'}; my $OCN_GRID = $opts{'ocn_grid'}; my $OCN_FORCING = $opts{'ocn_forcing'}; my $OCN_ICEBERG = $opts{'ocn_iceberg'}; -my $OCN_ISMF = $opts{'ocn_ismf'}; my $OCN_SGR = $opts{'ocn_sgr'}; my $decomp_prefix = $opts{'decomp_prefix'}; my $date_stamp = $opts{'date_stamp'}; @@ -196,6 +198,8 @@ my $ice_bgc = $opts{'ice_bgc'}; my $NINST_OCN = $opts{'ninst_ocn'}; my $NTASKS_OCN = $opts{'ntasks_ocn'}; my $OCN_TIDAL_MIXING = $opts{'ocn_tidal_mixing'}; +my $GLC_NZOC = $opts{'glc_nzoc'}; +my $OCN_GLC_ISMF_COUPLING = $opts{'ocn_glc_ismf_coupling'}; $cfgdir = $opts{'cfg_dir'}; my $CIMEROOT; @@ -463,6 +467,8 @@ my $ntasks = $NTASKS_OCN / $NINST_OCN; print "MPASO build-namelist: ocn_grid is $OCN_GRID \n"; print "MPASO build-namelist: ocn_forcing is $OCN_FORCING \n"; print "MPASO build-namelist: ocn_tidal_mixing is $OCN_TIDAL_MIXING \n"; +print "MPASO build-namelist: GLC_NZOC is $GLC_NZOC \n"; +print "MPASO build-namelist: OCN_GLC_ISMF_COUPLING is $OCN_GLC_ISMF_COUPLING \n"; (-d $DIN_LOC_ROOT) or mkdir $DIN_LOC_ROOT; if ($print>=2) { print "CIME inputdata root directory: $DIN_LOC_ROOT$eol"; } @@ -736,15 +742,24 @@ if ($OCN_ICEBERG eq 'true') { # (true for JRA). When atm active, we assume liquid runoff corresonds to precip # or snow melt so we do not remove it. In either case, the energy for melting # doesn't come from the ocean. -if (($OCN_ISMF ne 'none') && ($OCN_FORCING ne 'active_atm')) { +if (( ($OCN_GLC_ISMF_COUPLING eq 'coupler') + || ($OCN_GLC_ISMF_COUPLING eq 'internal_mpaso') + || ($OCN_GLC_ISMF_COUPLING eq 'data_mpaso') + ) + && ($OCN_FORCING ne 'active_atm')) +{ add_default($nl, 'config_remove_ais_river_runoff', 'val'=>".true."); } else { add_default($nl, 'config_remove_ais_river_runoff', 'val'=>".false."); } add_default($nl, 'config_scale_dismf_by_removed_ice_runoff'); add_default($nl, 'config_ais_ice_runoff_history_days'); -add_default($nl, 'config_glc_thermal_forcing_coupling_mode'); -add_default($nl, 'config_2d_thermal_forcing_depth'); +add_default($nl, 'config_n_glc_z_levels', 'val'=>"$GLC_NZOC"); +if ($GLC_NZOC gt 0) { + add_default($nl, 'config_glc_thermal_forcing_coupling_mode', 'val'=>"3d"); +} else { + add_default($nl, 'config_glc_thermal_forcing_coupling_mode'); +} ###################################### # Namelist group: shortwaveRadiation # @@ -805,11 +820,11 @@ add_default($nl, 'config_frazil_sea_ice_reference_salinity'); add_default($nl, 'config_frazil_maximum_freezing_temperature'); add_default($nl, 'config_frazil_use_surface_pressure'); -if ($OCN_ISMF eq 'coupled') { +if ($OCN_GLC_ISMF_COUPLING eq 'coupler') { add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); -} elsif ($OCN_ISMF eq 'internal') { +} elsif ($OCN_GLC_ISMF_COUPLING eq 'internal_mpaso') { add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); -} elsif ($OCN_ISMF eq 'data') { +} elsif ($OCN_GLC_ISMF_COUPLING eq 'data_mpaso') { add_default($nl, 'config_frazil_under_land_ice', 'val'=>".false."); } else { add_default($nl, 'config_frazil_under_land_ice'); @@ -819,13 +834,13 @@ if ($OCN_ISMF eq 'coupled') { # Namelist group: land_ice_fluxes # ################################### -if ($OCN_ISMF eq 'coupled') { +if ($OCN_GLC_ISMF_COUPLING eq 'coupler') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"coupled"); add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); -} elsif ($OCN_ISMF eq 'internal') { +} elsif ($OCN_GLC_ISMF_COUPLING eq 'internal_mpaso') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"standalone"); add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); -} elsif ($OCN_ISMF eq 'data') { +} elsif ($OCN_GLC_ISMF_COUPLING eq 'data_mpaso') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"data"); add_default($nl, 'config_frazil_under_land_ice', 'val'=>".false."); } else { @@ -1213,7 +1228,11 @@ if ($OCN_ICEBERG eq 'true') { add_default($nl, 'config_use_freshwaterTracers_icebergFreshWaterFlux', 'val'=>".false."); } # When there are land ice fluxes, use freshwater tracer -if (($OCN_ISMF ne 'none')) { +if ( ($OCN_GLC_ISMF_COUPLING eq 'coupler') + || ($OCN_GLC_ISMF_COUPLING eq 'internal_mpaso') + || ($OCN_GLC_ISMF_COUPLING eq 'data_mpaso') + || ($OCN_GLC_ISMF_COUPLING eq 'tf') + ) { add_default($nl, 'config_use_freshwaterTracers_landIceFreshwaterFlux', 'val'=>".true."); } else { add_default($nl, 'config_use_freshwaterTracers_landIceFreshwaterFlux', 'val'=>".false."); diff --git a/components/mpas-ocean/bld/build-namelist-section b/components/mpas-ocean/bld/build-namelist-section index 23ad36a868e0..c1a2e634dcd6 100644 --- a/components/mpas-ocean/bld/build-namelist-section +++ b/components/mpas-ocean/bld/build-namelist-section @@ -242,8 +242,8 @@ add_default($nl, 'config_remove_ais_river_runoff'); add_default($nl, 'config_remove_ais_ice_runoff'); add_default($nl, 'config_scale_dismf_by_removed_ice_runoff'); add_default($nl, 'config_ais_ice_runoff_history_days'); +add_default($nl, 'config_n_glc_z_levels'); add_default($nl, 'config_glc_thermal_forcing_coupling_mode'); -add_default($nl, 'config_2d_thermal_forcing_depth'); ###################################### # Namelist group: shortwaveRadiation # diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index 2a8ed57abc18..fcb9bcb7f114 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -377,8 +377,8 @@ .false. .false. 731 +0 'off' -300.0 'jerlov' diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index 23130f5947d2..a455ff88869a 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1295,19 +1295,19 @@ Valid values: Any positive integer Default: Defined in namelist_defaults.xml - -If and how MPAS-Ocean sends thermal forcing to GLC (MALI) in E3SM. This is used for ocean coupling with a melt parameterization for grounded marine ice-cliffs in MALI. This is primarily relevant to the Greenland Ice Sheet, but also relevant to the Antarctic Ice Sheet. 'none' means no coupling of thermal forcing. '2d' means thermal forcing at a prescribed depth is passed to GLC. That depth is controlled by 'config_2d_thermal_forcing_depth', and the resulting thermal forcing field is calculated in the field 'avgThermalForcingAtCritDepth'. +The number of z-levels to use for passing ocean properties to GLC for indirect ice-sheet/ocean coupling. This option is only intended to be used for ocean thermal forcing coupling in E3SM, in which case E3SM will set this option, define the values of ismip6shelfMelt_zOcean through the driver, and pass thermal forcing from the ocean model. Note that the default value of zero will result in this dimension not being defined (unless overridden by the value in an input file). -Valid values: 'off', '2d' +Valid values: Any positive integer or zero Default: Defined in namelist_defaults.xml - -Depth at which to pass 2d thermal forcing to the coupler for use in the GLC component. Note that mapping files for this field must be created with a mask to exclude ocean grid cells shallower than this value and thus must be regenerated if this value is changed. +If and how MPAS-Ocean sends thermal forcing to GLC (MALI) in E3SM. This is used for ocean coupling with a melt parameterization for grounded marine ice-cliffs in MALI. This is primarily relevant to the Greenland Ice Sheet, but also relevant to the Antarctic Ice Sheet. 'none' means no coupling of thermal forcing. '3d' means thermal forcing is passed at multiple z-levels. -Valid values: any non-negative value +Valid values: 'off', '3d' Default: Defined in namelist_defaults.xml diff --git a/components/mpas-ocean/cime_config/buildnml b/components/mpas-ocean/cime_config/buildnml index 01b95824b45d..30682163e965 100755 --- a/components/mpas-ocean/cime_config/buildnml +++ b/components/mpas-ocean/cime_config/buildnml @@ -34,11 +34,12 @@ def buildnml(case, caseroot, compname): ocn_mask = case.get_value("MASK_GRID") ocn_forcing = case.get_value("MPASO_FORCING") ocn_iceberg = case.get_value("MPASO_ICEBERG") - ocn_ismf = case.get_value("MPASO_ISMF") ocn_sgr = case.get_value("MPASO_SGR") ocn_bgc = case.get_value("MPASO_BGC") ocn_wave = case.get_value("MPASO_WAVE") ocn_tidal_mixing = case.get_value("MPASO_TIDAL_MIXING") + glc_nzoc = case.get_value("GLC_NZOC") + ocn_glc_ismf_coupling = case.get_value("OCN_GLC_ISMF_COUPLING") ocn_co2_type = case.get_value("OCN_CO2_TYPE") atm_co2_const_val = case.get_value("CCSM_CO2_PPMV") ice_bgc = case.get_value("MPASI_BGC") @@ -138,7 +139,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': logger.warning("WARNING: The specified compset is requesting ocean ICs spunup from a G-case") logger.warning(" But no file available for this grid.") - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_paolo2023.oQU240wLI.20240404.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.oQU240wLI.20240221.nc' @@ -277,7 +278,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': ic_date = '230220' ic_prefix = 'mpaso.SOwISC12to60E2r4.rstFromG-anvil' - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_adusumilli2020.SOwISC12to60E2r4.230516.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.SOwISC12to60E2r4.20210114.nc' @@ -294,7 +295,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': ic_date = '20230913' # changed to same as decomp_date, but the spun up file does not yet exist ic_prefix = 'mpaso.FRISwISC08to60E3r1.rstFromG-anvil' # the spun up file does not yet exist - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_adusumilli2020.FRISwISC08to60E3r1.20230913.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.FRISwISC08to60E3r1.20230913.nc' @@ -309,7 +310,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': ic_date = '20230913' # changed to same as decomp_date, but the spun up file does not yet exist ic_prefix = 'mpaso.FRISwISC04to60E3r1.rstFromG-anvil' # the spun up file does not yet exist - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_adusumilli2020.FRISwISC04to60E3r1.20230913.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.FRISwISC04to60E3r1.20230913.nc' @@ -324,7 +325,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': ic_date = '20230914' # changed to same as decomp_date, but the spun up file does not yet exist ic_prefix = 'mpaso.FRISwISC02to60E3r1.rstFromG-anvil' # the spun up file does not yet exist - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_adusumilli2020.FRISwISC02to60E3r1.20230914.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.FRISwISC02to60E3r1.20230914.nc' @@ -339,7 +340,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': ic_date = '20230915' # changed to same as decomp_date, but the spun up file does not yet exist ic_prefix = 'mpaso.FRISwISC01to60E3r1.rstFromG-anvil' # the spun up file does not yet exist - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_adusumilli2020.FRISwISC01to60E3r1.20230915.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.FRISwISC01to60E3r1.20230915.nc' @@ -354,7 +355,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': ic_date = '230220' ic_prefix = 'mpaso.ECwISC30to60E2r1.rstFromG-anvil' - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_adusumilli2020.ECwISC30to60E2r1.230429.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.ECwISC30to60E2r1.20240221.nc' @@ -375,7 +376,7 @@ def buildnml(case, caseroot, compname): ic_date = '20231215' ic_prefix = 'mpaso.IcoswISC30E3r5.20231120+MARBL_ICfromOMIP_64levels' eco_forcing_file = 'ecoForcingSurfaceMonthly.IcoswISC30E3r5.20231215.nc' - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_paolo2023.IcoswISC30E3r5.20240805.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.IcoswISC30E3r5.20231120.nc' @@ -403,7 +404,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': logger.warning("WARNING: The specified compset is requesting ocean ICs spunup from a G-case") logger.warning(" But no file available for this grid.") - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_paolo2023.RRSwISC6to18E3r5.20240327.nc' elif ocn_grid == 'SOwISC12to30E3r3': @@ -414,9 +415,9 @@ def buildnml(case, caseroot, compname): ic_date = '20240829' ic_prefix = 'mpaso.SOwISC12to30E3r3' if ocn_ic_mode == 'spunup': - ic_date = '20241023' - ic_prefix = 'mpaso.SOwISC12to30E3r3.interpFrom2p1-anvil' - if ocn_ismf == 'data': + ic_date = '20240829' + ic_prefix = 'mpaso.SOwISC12to30E3r3.rstFromG-chrysalis' + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_paolo2023.SOwISC12to30E3r3.20241017.nc' elif ocn_grid == 'SOwISC12to30E3r4': @@ -429,7 +430,7 @@ def buildnml(case, caseroot, compname): if ocn_ic_mode == 'spunup': logger.warning("WARNING: The specified compset is requesting ocean ICs spunup from a G-case") logger.warning(" But no file available for this grid.") - if ocn_ismf == 'data': + if ocn_glc_ismf_coupling == 'data_mpaso': data_ismf_file = 'prescribed_ismf_paolo2023.SOwISC12to30E3r4.20250121.nc' #-------------------------------------------------------------------- @@ -532,11 +533,12 @@ def buildnml(case, caseroot, compname): sysmod += " -ocn_grid '{}'".format(ocn_mask) sysmod += " -ocn_forcing '{}'".format(ocn_forcing) sysmod += " -ocn_iceberg '{}'".format(ocn_iceberg) - sysmod += " -ocn_ismf '{}'".format(ocn_ismf) sysmod += " -ocn_sgr '{}'".format(ocn_sgr) sysmod += " -ocn_bgc '{}'".format(ocn_bgc) sysmod += " -ocn_wave '{}'".format(ocn_wave) sysmod += " -ocn_tidal_mixing '{}'".format(ocn_tidal_mixing) + sysmod += " -glc_nzoc '{}'".format(glc_nzoc) + sysmod += " -ocn_glc_ismf_coupling '{}'".format(ocn_glc_ismf_coupling) sysmod += " -ocn_co2_type '{}'".format(ocn_co2_type) sysmod += " -atm_co2_const_val '{}'".format(atm_co2_const_val) sysmod += " -ice_bgc '{}'".format(ice_bgc) diff --git a/components/mpas-ocean/cime_config/config_component.xml b/components/mpas-ocean/cime_config/config_component.xml index ee55bf415d92..16cafe628bc6 100644 --- a/components/mpas-ocean/cime_config/config_component.xml +++ b/components/mpas-ocean/cime_config/config_component.xml @@ -65,21 +65,6 @@ Option to describe the MPASO iceberg coupling - - char - none,data,internal,coupled - none - - none - data - internal - coupled - - case_comp - env_case.xml - Option to describe how MPASO will handle ice shelf melt fluxes - - char diff --git a/components/mpas-ocean/cime_config/config_pes.xml b/components/mpas-ocean/cime_config/config_pes.xml index 38ec194586bd..47dde826349c 100644 --- a/components/mpas-ocean/cime_config/config_pes.xml +++ b/components/mpas-ocean/cime_config/config_pes.xml @@ -72,7 +72,7 @@ - + mpas-ocean: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0 @@ -102,21 +102,6 @@ - - - mpas-ocean+gcp10: default - - 30 - 30 - 30 - 16 - 16 - 16 - 30 - 30 - - - mpas-ocean+lawrencium-lr3: default, 2 nodes @@ -448,7 +433,7 @@ - + mpas-ocean: SO RRM, compset=DATM+MPASO, 8 nodes, 128x1 ~3.3 sypd 128 diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README deleted file mode 100644 index bd801c44f8af..000000000000 --- a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README +++ /dev/null @@ -1,12 +0,0 @@ -This testdef is used to test a stealth feature that enables coupling between -OCN and GLC for Greenland, which passes ocean thermal forcing from OCN to GLC -and uses that in a parameterization for marine melting of grounded vertical -cliffs. - -It changes one mpaso namelist variable, - config_glc_thermal_forcing_coupling_mode -from its default value to '2d'. -This tests the ocn/glc TF coupling. - -It also specified that DATM forcing should be restricted to 1958. -This allows JRA1p5 forcing to be used without a large input data requirement. diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands deleted file mode 100644 index 1d43ad8c5baf..000000000000 --- a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands +++ /dev/null @@ -1,4 +0,0 @@ -./xmlchange DATM_CLMNCEP_YR_START=1958 -./xmlchange DATM_CLMNCEP_YR_END=1958 -./xmlchange DROF_STRM_YR_START=1958 -./xmlchange DROF_STRM_YR_END=1958 diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso deleted file mode 100644 index 0e1378620836..000000000000 --- a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso +++ /dev/null @@ -1 +0,0 @@ -config_glc_thermal_forcing_coupling_mode = '2d' diff --git a/components/mpas-ocean/driver/mpaso_cpl_indices.F b/components/mpas-ocean/driver/mpaso_cpl_indices.F index cc2f00a57356..9c2d735b648b 100644 --- a/components/mpas-ocean/driver/mpaso_cpl_indices.F +++ b/components/mpas-ocean/driver/mpaso_cpl_indices.F @@ -8,6 +8,8 @@ module mpaso_cpl_indices SAVE public ! By default make data private + integer , parameter, private:: glc_nzoc_max = 100 + ! ocn -> drv integer :: index_o2x_So_t @@ -37,7 +39,9 @@ module mpaso_cpl_indices integer :: index_o2x_So_htv !ocean heat-transfer velocity integer :: index_o2x_So_stv !ocean salt-transfer velocity integer :: index_o2x_So_rhoeff !ocean effective density - integer :: index_o2x_So_tf2d !ocean thermal forcing at predefined critical depth + integer :: index_o2x_So_tf3d(glc_nzoc_max) !ocean thermal forcing at predefined z-levels + integer :: index_o2x_So_tf3d_mask(glc_nzoc_max) !mask ofocean thermal forcing at predefined z-levels + ! ocn -> drv (BGC) @@ -174,9 +178,18 @@ module mpaso_cpl_indices subroutine mpaso_cpl_indices_set( ) use seq_flds_mod, only : wav_ocn_coup + use glc_zocnclass_mod + type(mct_aVect) :: o2x ! temporary type(mct_aVect) :: x2o ! temporary + integer :: glc_nzoc + integer :: iLev + character(len=2) :: cnum + character(len=64) :: varname + + glc_nzoc = glc_get_num_zocn_classes() + ! Determine attribute vector indices ! create temporary attribute vectors @@ -210,7 +223,16 @@ subroutine mpaso_cpl_indices_set( ) index_o2x_So_htv = mct_avect_indexra(o2x,'So_htv') index_o2x_So_stv = mct_avect_indexra(o2x,'So_stv') index_o2x_So_rhoeff = mct_avect_indexra(o2x,'So_rhoeff') - index_o2x_So_tf2d = mct_avect_indexra(o2x,'So_tf2d',perrWith='quiet') + if (glc_nzoc > 0) then + do iLev = 1, glc_nzoc + cnum = glc_zocnclass_as_string(iLev) + varname = 'So_tf3d' // cnum + index_o2x_So_tf3d(iLev) = mct_avect_indexra(o2x, trim(varname)) + + varname = 'So_tf3d_mask' // cnum + index_o2x_So_tf3d_mask(iLev) = mct_avect_indexra(o2x, trim(varname)) + enddo + endif index_o2x_So_algae1 = mct_avect_indexra(o2x,'So_algae1',perrWith='quiet') index_o2x_So_algae2 = mct_avect_indexra(o2x,'So_algae2',perrWith='quiet') diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index ba3aae3b4ac3..c9465ca51983 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -109,8 +109,6 @@ module ocn_comp_mct integer :: nsend, nrecv - logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on - character(len=StrKIND) :: runtype, coupleTimeStamp type(seq_infodata_type), pointer :: infodata @@ -228,7 +226,6 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ logical, pointer :: config_use_surface_salinity_monthly_restoring logical, pointer :: config_scale_dismf_by_removed_ice_runoff character (len=StrKIND), pointer :: config_land_ice_flux_mode - character (len=StrKIND), pointer :: config_glc_thermal_forcing_coupling_mode ! ssh coupling interval initialization integer, pointer :: index_avgZonalSSHGradient, index_avgMeridionalSSHGradient @@ -312,8 +309,6 @@ end subroutine xml_stream_get_attributes ! Determine coupling type call seq_infodata_GetData(infodata, cpl_seq_option=cpl_seq_option) - ! Determine if ocn to glc thermal forcing coupling is on - call seq_infodata_GetData(infodata, ocn_c2_glctf=ocn_c2_glctf) !----------------------------------------------------------------------- ! @@ -907,15 +902,10 @@ end subroutine xml_stream_get_attributes call seq_infodata_PutData(infodata, rmean_rmv_ice_runoff=runningMeanRemovedIceRunoff) end if - call mpas_pool_get_config(domain % configs, 'config_glc_thermal_forcing_coupling_mode', config_glc_thermal_forcing_coupling_mode) - if ( trim(config_glc_thermal_forcing_coupling_mode) == 'off' ) then - call seq_infodata_PutData(infodata, ocn_c2_glctf=.false.) - else if ( trim(config_glc_thermal_forcing_coupling_mode) == '2d' ) then - call seq_infodata_PutData(infodata, ocn_c2_glctf=.true.) - else - call mpas_log_write('ERROR: unknown config_glc_thermal_forcing_coupling_mode: ' // & - trim(config_glc_thermal_forcing_coupling_mode), MPAS_LOG_CRIT) - end if + ! initialize glc z-levels, if necessary + ! these are used for ocn-glc thermal forcing coupling + call init_glc_z_levels(domain, ierr_local) + ierr = ior(ierr, ierr_local) !----------------------------------------------------------------------- ! @@ -2360,9 +2350,6 @@ subroutine ocn_import_mct(x2o_o, errorCode)!{{{ end if if ( iceRunoffFluxField % isActive ) then iceRunoffFlux(i) = x2o_o % rAttr(index_x2o_Foxx_rofi, n) - if(iceRunoffFlux(n) < 0.0_RKIND) then - call shr_sys_abort ('Error: incoming rofi_F is negative') - end if if (config_remove_ais_ice_runoff) then if (latCell(i) < -0.99483767345_RKIND) then ! 57S in radians removedIceRunoffFlux(i) = iceRunoffFlux(i) @@ -2880,10 +2867,11 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ ! !----------------------------------------------------------------------- - integer :: i, n + integer :: i, n, iLevel integer, pointer :: nCellsSolve, index_temperatureSurfaceValue, index_salinitySurfaceValue, & index_avgZonalSurfaceVelocity, index_avgMeridionalSurfaceVelocity, & - index_avgZonalSSHGradient, index_avgMeridionalSSHGradient + index_avgZonalSSHGradient, index_avgMeridionalSSHGradient, & + nGlcZLevels type (block_type), pointer :: block_ptr @@ -2917,12 +2905,13 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ avgRemovedRiverRunoffFlux, & avgRemovedIceRunoffFlux, & avgLandIceHeatFlux, & - avgRemovedIceRunoffHeatFlux, & - avgThermalForcingAtCritDepth + avgRemovedIceRunoffHeatFlux real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & avgSSHGradient, avgOceanSurfacePhytoC, & - avgOceanSurfaceDOC, layerThickness + avgOceanSurfaceDOC, layerThickness, & + avgThermalForcingAtZLevels, & + avgThermalForcingAtZLevelsMask real (kind=RKIND) :: surfaceFreezingTemp @@ -2941,6 +2930,8 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ logical :: keepFrazil + logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on + ! get configure options call mpas_pool_get_package(domain % packages, 'frazilIceActive', frazilIceActive) @@ -2959,6 +2950,9 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers_sea_ice_coupling', & config_use_MacroMoleculesTracers_sea_ice_coupling) + ! Determine if ocn to glc thermal forcing coupling is on + call seq_infodata_GetData(infodata, ocn_c2_glctf=ocn_c2_glctf) + n = 0 block_ptr => domain % blocklist do while(associated(block_ptr)) @@ -3004,8 +2998,10 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffFlux', avgRemovedIceRunoffFlux) call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffHeatFlux', avgRemovedIceRunoffHeatFlux) endif - if (trim(config_glc_thermal_forcing_coupling_mode) == '2d') then - call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtCritDepth', avgThermalForcingAtCritDepth) + if (trim(config_glc_thermal_forcing_coupling_mode) == '3d') then + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtZLevels', avgThermalForcingAtZLevels) + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtZLevelsMask', avgThermalForcingAtZLevelsMask) + call mpas_pool_get_dimension(forcingPool, 'nGlcZLevels', nGlcZLevels) endif ! BGC fields @@ -3168,8 +3164,21 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ o2x_o % rAttr(index_o2x_So_stv, n) = landIceTracerTransferVelocities(indexSaltTrans,i) o2x_o % rAttr(index_o2x_So_rhoeff, n) = 0.0_RKIND endif - if (trim(config_glc_thermal_forcing_coupling_mode) == '2d' .and. ocn_c2_glctf) then - o2x_o % rAttr(index_o2x_So_tf2d, n) = avgThermalForcingAtCritDepth(i) + if (trim(config_glc_thermal_forcing_coupling_mode) == '3d') then + do iLevel = 1, nGlcZLevels + if (avgThermalForcingAtZLevelsMask(ilevel, i) > 0.9_RKIND) then + ! Only use this time average if it is available almost all the time + ! Otherwise the time average is not representative. + o2x_o % rAttr(index_o2x_So_tf3d(iLevel), n) = avgThermalForcingAtZLevels(ilevel, i) / & + avgThermalForcingAtZLevelsMask(ilevel, i) + ! Consider this ocean cell valid (no need to continue carrying the time averaging fraction) + o2x_o % rAttr(index_o2x_So_tf3d_mask(iLevel), n) = 1.0_RKIND + else + ! If we're not using this location, set value and mask to zero + o2x_o % rAttr(index_o2x_So_tf3d(iLevel), n) = 0.0_RKIND + o2x_o % rAttr(index_o2x_So_tf3d_mask(iLevel), n) = 0.0_RKIND + endif + enddo endif @@ -3383,6 +3392,53 @@ subroutine datetime(cdate, ctime)!{{{ end subroutine datetime!}}} + + subroutine init_glc_z_levels(domain, err) + use glc_zocnclass_mod + + implicit none + type (domain_type), pointer, intent(inout) :: domain + integer, intent(out) :: err + + ! local vars + type (block_type), pointer :: block_ptr + type (mpas_pool_type), pointer :: forcingPool + integer, pointer :: nGlcZLevels + real (kind=RKIND), dimension(:), pointer :: glcZLevels + integer :: cpl_num_zocn, iLev + + err = 0 + + block_ptr => domain % blocklist + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + call mpas_pool_get_dimension(forcingPool, 'nGlcZLevels', nGlcZLevels) + if (nGlcZLevels > 0) then + call mpas_pool_get_array(forcingPool, 'glcZLevels', glcZLevels) + + cpl_num_zocn = glc_get_num_zocn_classes() + + ! check that the num z-levels in the coupler matches what MALI was told to use + if (nGlcZLevels /= cpl_num_zocn) then + call mpas_log_write("nGlcZLevels=$i does not match glc_get_num_zocn_classes=$i", & + MPAS_LOG_ERR, intArgs=(/nGlcZLevels, cpl_num_zocn/)) + err = ior(err, 1) + endif + + glcZLevels = glc_get_zlevels() + + call mpas_log_write("Using $i levels for glcZLevels", intArgs=(/nGlcZLevels/)) + do iLev = 1, nGlcZLevels + call mpas_log_write("-- z-level $i: $r", intArgs=(/iLev/), & + realArgs=(/glcZLevels(iLev)/)) + enddo + endif + + block_ptr => block_ptr % next + end do + end subroutine init_glc_z_levels + + #ifdef HAVE_MOAB @@ -3636,7 +3692,7 @@ subroutine ocn_import_moab(Eclock, errorCode)!{{{ ent_type = 1 ! cells ! get all tags in one method tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( MPOID, tagname, totalmbls_r , ent_type, x2o_om(1, 1) ) + ierr = iMOAB_GetDoubleTagStorage ( MPOID, tagname, totalmbls_r , ent_type, x2o_om ) if ( ierr /= 0 ) then write(ocnLogUnit,*) 'Fail to get MOAB fields ' endif diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index f7ff1ea8293d..31c2e8978b1d 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -116,6 +116,9 @@ + @@ -822,13 +825,13 @@ description="The number of days over for which the history of removed AIS runoff is stored. The default is 731 days (2 years + 1 day)." possible_values="Any positive integer" /> - - @@ -1731,6 +1734,7 @@ + @@ -4072,8 +4076,14 @@ description="The time-averaged effective ocean density within ice shelves based on Archimedes' principle." packages="landIceCouplingPKG" /> - + + config_2d_thermal_forcing_depth) then - iLevelCritDepth = iLevel - exit - end if - end do - !$omp parallel - !$omp do schedule(runtime) - ! calculate thermal forcing at identified level for each cell - do iCell = 1, nCells - ! ignore cells that are too shallow - if (iLevelCritDepth <= maxLevelCell(iCell)) then - ! this uses the level shallower than the reference level. could interpolate instead - ! note: assuming no LandIce cavity, but we may want to support that - freezingTemp = ocn_freezing_temperature(salinity=activeTracers(indexSalinity, iLevelCritDepth, iCell), & - pressure=pressure(iLevelCritDepth, iCell), inLandIceCavity=.false.) - avgThermalForcingAtCritDepth(iCell) = ( avgThermalForcingAtCritDepth(iCell) * nAccumulatedCoupled & - + activeTracers(indexTemperature, iLevelCritDepth, iCell) - freezingTemp ) / ( nAccumulatedCoupled + 1) - end if - end do - !$omp end do - !$omp end parallel + if (trim(config_glc_thermal_forcing_coupling_mode) == '3d') then + call accumulate_glc_3d_thermal_forcing(statePool, forcingPool, timeLevel) endif ! accumulate BGC coupling fields if necessary @@ -584,4 +549,132 @@ subroutine ocn_time_average_coupled_accumulate(statePool, forcingPool, timeLevel end subroutine ocn_time_average_coupled_accumulate!}}} + +!*********************************************************************** +! +! routine accumulate_glc_3d_thermal_forcing +! +!> \brief Coupled time averager accumulation for 3D thermal forcing +!> \author Xylar Asay-Davis +!> \date 03/05/2025 +!> \details +!> This routine accumulated the coupled time average of the 3D thermal +!> forcing +! +!----------------------------------------------------------------------- + subroutine accumulate_glc_3d_thermal_forcing(statePool, forcingPool, timeLevel)!{{{ + use ocn_constants, only: & + latent_heat_fusion_mks + + type (mpas_pool_type), intent(in) :: statePool + type (mpas_pool_type), intent(inout) :: forcingPool + integer, intent(in) :: timeLevel + + integer :: iCell + real (kind=RKIND), dimension(:,:), pointer :: avgThermalForcingAtZLevels + real (kind=RKIND), dimension(:,:), pointer :: avgThermalForcingAtZLevelsMask + real (kind=RKIND), dimension(:), pointer :: glcZLevels + real (kind=RKIND), dimension(:), pointer :: ssh + + type (mpas_pool_type), pointer :: tracersPool + + real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers + integer, pointer :: indexTemperature, indexSalinity, nGlcZLevels, & + nCells, nAccumulatedCoupled + integer :: iLevel, iLevelGlc, iLevelAbove, iLevelBelow + + real (kind=RKIND) :: freezingTemp, glcz, zMin, zMax, zAbove, zBelow, & + alpha, salin, temp, press + + call mpas_pool_get_dimension(forcingPool, 'nCells', nCells) + call mpas_pool_get_dimension(forcingPool, 'nGlcZLevels', nGlcZLevels) + + call mpas_pool_get_array(forcingPool, 'nAccumulatedCoupled', nAccumulatedCoupled) + + call mpas_pool_get_array(forcingPool, 'glcZLevels', glcZLevels) + call mpas_pool_get_array(statePool, 'ssh', ssh, timeLevel) + + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtZLevels', avgThermalForcingAtZLevels) + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtZLevelsMask', avgThermalForcingAtZLevelsMask) + call mpas_pool_get_subpool(statePool, 'tracers', tracersPool) + call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel) + call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature) + call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity) + + !$omp parallel + !$omp do collapse(2) schedule(runtime) & + !$omp private(iLevelGlc, iCell, glcz, zMin, zMax, iLevelAbove, & + !$omp iLevelBelow, zAbove, zBelow, alpha, salin, & + !$omp temp, press, freezingTemp) + do iLevelGlc = 1, nGlcZLevels + do iCell = 1, nCells + ! calculate thermal forcing at identified level for each cell + glcz = glcZLevels(iLevelGlc) + + if (glcz > ssh(iCell) .or. glcz < -bottomDepth(iCell) .or. & + minLevelCell(iCell) > maxLevelCell(iCell)) then + ! mask out glc levels that are too shallow or too deep + avgThermalForcingAtZLevels(iLevelGlc, iCell) = & + ( avgThermalForcingAtZLevels(iLevelGlc, iCell) * nAccumulatedCoupled & + + 0.0_RKIND) / (nAccumulatedCoupled + 1) + avgThermalForcingAtZLevelsMask(iLevelGlc, iCell) = & + ( avgThermalForcingAtZLevelsMask(iLevelGlc, iCell) * nAccumulatedCoupled & + + 0.0_RKIND) / ( nAccumulatedCoupled + 1) + cycle + end if + + ! find which zMid values glcz lies between and the linear + ! interpolation factor alpha between them + + zMin = zMid(minLevelCell(iCell), iCell) + zMax = zMid(maxLevelCell(iCell), iCell) + if (glcz > zMin .or. minLevelCell(iCell) == maxLevelCell(iCell)) then + ! above the middle of the top level so no interpolation + iLevelAbove = minLevelCell(iCell) + iLevelBelow = minLevelCell(iCell) + alpha = 0.0_RKIND + else if (glcz < zMax) then + ! below the middle of the bottom level so no interpolation + iLevelAbove = maxLevelCell(iCell) + iLevelBelow = maxLevelCell(iCell) + alpha = 0.0_RKIND + else + do iLevel = minLevelCell(iCell), maxLevelCell(iCell) - 1 + iLevelAbove = iLevel + iLevelBelow = iLevel + 1 + zAbove = zMid(iLevelAbove, iCell) + zBelow = zMid(iLevelBelow, iCell) + if (glcz >= zBelow) then + exit + end if + end do + alpha = (glcz - zAbove) / (zBelow - zAbove) + end if + + ! linearly interpolate salinity, temperature, and pressure + salin = activeTracers(indexSalinity, iLevelAbove, iCell) * (1.0_RKIND - alpha) & + + activeTracers(indexSalinity, iLevelBelow, iCell) * alpha + + temp = activeTracers(indexTemperature, iLevelAbove, iCell) * (1.0_RKIND - alpha) & + + activeTracers(indexTemperature, iLevelBelow, iCell) * alpha + + press = pressure(iLevelAbove, iCell) * (1.0_RKIND - alpha) & + + pressure(iLevelBelow, iCell) * alpha + + freezingTemp = ocn_freezing_temperature(salinity=salin, pressure=press, & + inLandIceCavity=.true.) + + avgThermalForcingAtZLevels(iLevelGlc, iCell) = & + ( avgThermalForcingAtZLevels(iLevelGlc, iCell) * nAccumulatedCoupled & + + temp - freezingTemp ) / ( nAccumulatedCoupled + 1) + avgThermalForcingAtZLevelsMask(iLevelGlc, iCell) = & + ( avgThermalForcingAtZLevelsMask(iLevelGlc, iCell) * nAccumulatedCoupled & + + 1.0_RKIND) / ( nAccumulatedCoupled + 1) + end do + end do + !$omp end do + !$omp end parallel + + end subroutine accumulate_glc_3d_thermal_forcing!}}} + end module ocn_time_average_coupled diff --git a/components/mpas-seaice/bld/build-namelist b/components/mpas-seaice/bld/build-namelist index 87831cc94b03..abd1b1864653 100755 --- a/components/mpas-seaice/bld/build-namelist +++ b/components/mpas-seaice/bld/build-namelist @@ -509,14 +509,12 @@ add_default($nl, 'config_load_balance_timers'); if ($CONTINUE_RUN eq 'TRUE') { add_default($nl, 'config_do_restart', 'val'=>".true."); add_default($nl, 'config_do_restart_hbrine', 'val'=>".true."); - add_default($nl, 'config_do_restart_zsalinity', 'val'=>".true."); add_default($nl, 'config_do_restart_bgc', 'val'=>".true."); add_default($nl, 'config_do_restart_snow_density', 'val'=>".true."); add_default($nl, 'config_do_restart_snow_grain_radius', 'val'=>".true."); } else { add_default($nl, 'config_do_restart', 'val'=>".false."); add_default($nl, 'config_do_restart_hbrine', 'val'=>".false."); - add_default($nl, 'config_do_restart_zsalinity', 'val'=>".false."); add_default($nl, 'config_do_restart_bgc', 'val'=>".false."); add_default($nl, 'config_do_restart_snow_density', 'val'=>".false."); add_default($nl, 'config_do_restart_snow_grain_radius', 'val'=>".false."); @@ -585,9 +583,6 @@ add_default($nl, 'config_include_pond_freshwater_feedback'); add_default($nl, 'config_use_test_ice_shelf'); add_default($nl, 'config_testing_system_test'); -add_default($nl, 'config_use_congelation_basal_melt'); -add_default($nl, 'config_use_lateral_melt'); -add_default($nl, 'config_use_latent_processes'); add_default($nl, 'config_limit_air_temperatures'); ################################### @@ -629,11 +624,7 @@ add_default($nl, 'config_recover_tracer_means_check'); # Namelist group: column_package # ################################## -if ($ice_bgc eq 'ice_bgc') { - add_default($nl, 'config_column_physics_type', 'val'=>"column_package"); -} else { - add_default($nl, 'config_column_physics_type'); -} +add_default($nl, 'config_column_physics_type'); add_default($nl, 'config_use_column_shortwave'); add_default($nl, 'config_use_column_vertical_thermodynamics'); if ($ice_bgc eq 'ice_bgc') { @@ -652,7 +643,6 @@ add_default($nl, 'config_use_column_snow_tracers'); add_default($nl, 'config_use_ice_age'); add_default($nl, 'config_use_first_year_ice'); add_default($nl, 'config_use_level_ice'); -add_default($nl, 'config_use_cesm_meltponds'); add_default($nl, 'config_use_level_meltponds'); add_default($nl, 'config_use_topo_meltponds'); add_default($nl, 'config_use_aerosols'); @@ -665,8 +655,6 @@ add_default($nl, 'config_use_floe_size_distribution'); # Namelist group: biogeochemistry # ################################### -add_default($nl, 'config_use_vertical_zsalinity'); -add_default($nl, 'config_use_shortwave_bioabsorption'); add_default($nl, 'config_use_skeletal_biochemistry'); if ($ice_bgc eq 'ice_bgc') { add_default($nl, 'config_use_vertical_biochemistry', 'val'=>".true."); @@ -681,6 +669,8 @@ if ($ice_bgc eq 'ice_bgc') { add_default($nl, 'config_use_humics', 'val'=>".true."); add_default($nl, 'config_use_DON', 'val'=>".true."); add_default($nl, 'config_use_iron', 'val'=>".true."); + add_default($nl, 'config_use_shortwave_bioabsorption', 'val'=>".true."); + add_default($nl, 'config_use_zaerosols', 'val'=>".true."); add_default($nl, 'config_couple_biogeochemistry_fields'); } else { add_default($nl, 'config_use_vertical_biochemistry', 'val'=>".false."); @@ -695,21 +685,20 @@ if ($ice_bgc eq 'ice_bgc') { add_default($nl, 'config_use_humics', 'val'=>".false."); add_default($nl, 'config_use_DON', 'val'=>".false."); add_default($nl, 'config_use_iron', 'val'=>".false."); + add_default($nl, 'config_use_shortwave_bioabsorption'); + add_default($nl, 'config_use_zaerosols'); add_default($nl, 'config_couple_biogeochemistry_fields', 'val'=>".false."); } +add_default($nl, 'config_use_atm_dust_file'); add_default($nl, 'config_use_chlorophyll'); +add_default($nl, 'config_use_iron_solubility_file'); add_default($nl, 'config_use_macromolecules'); add_default($nl, 'config_use_modal_aerosols'); -add_default($nl, 'config_use_zaerosols'); -add_default($nl, 'config_use_atm_dust_file'); -add_default($nl, 'config_use_iron_solubility_file'); add_default($nl, 'config_skeletal_bgc_flux_type'); add_default($nl, 'config_scale_initial_vertical_bgc'); add_default($nl, 'config_biogrid_bottom_molecular_sublayer'); add_default($nl, 'config_biogrid_top_molecular_sublayer'); add_default($nl, 'config_bio_gravity_drainage_length_scale'); -add_default($nl, 'config_zsalinity_molecular_sublayer'); -add_default($nl, 'config_zsalinity_gravity_drainage_scale'); add_default($nl, 'config_snow_porosity_at_ice_surface'); add_default($nl, 'config_new_ice_fraction_biotracer'); add_default($nl, 'config_fraction_biotracer_in_frazil'); @@ -891,6 +880,7 @@ add_default($nl, 'config_rapid_mode_aspect_ratio'); add_default($nl, 'config_slow_mode_drainage_strength'); add_default($nl, 'config_slow_mode_critical_porosity'); add_default($nl, 'config_macro_drainage_timescale'); +add_default($nl, 'config_congelation_freezing_method'); add_default($nl, 'config_congelation_ice_porosity'); ####################### @@ -946,6 +936,7 @@ if ($iceberg_mode eq 'data') { } else { add_default($nl, 'config_use_data_icebergs', 'val'=>"false"); } +add_default($nl, 'config_iceberg_temperature'); add_default($nl, 'config_scale_dib_by_removed_ice_runoff'); add_default($nl, 'config_salt_flux_coupling_type'); add_default($nl, 'config_ice_ocean_drag_coefficient'); diff --git a/components/mpas-seaice/bld/build-namelist-section b/components/mpas-seaice/bld/build-namelist-section index 90dd6ce39f21..6342a6b1a865 100644 --- a/components/mpas-seaice/bld/build-namelist-section +++ b/components/mpas-seaice/bld/build-namelist-section @@ -44,21 +44,18 @@ add_default($nl, 'config_load_balance_timers'); if ($CONTINUE_RUN eq 'TRUE') { add_default($nl, 'config_do_restart', 'val'=>".true."); add_default($nl, 'config_do_restart_hbrine', 'val'=>".true."); - add_default($nl, 'config_do_restart_zsalinity', 'val'=>".true."); add_default($nl, 'config_do_restart_bgc', 'val'=>".true."); add_default($nl, 'config_do_restart_snow_density', 'val'=>".true."); add_default($nl, 'config_do_restart_snow_grain_radius', 'val'=>".true."); } else { add_default($nl, 'config_do_restart', 'val'=>".false."); add_default($nl, 'config_do_restart_hbrine', 'val'=>".false."); - add_default($nl, 'config_do_restart_zsalinity', 'val'=>".false."); add_default($nl, 'config_do_restart_bgc', 'val'=>".false."); add_default($nl, 'config_do_restart_snow_density', 'val'=>".false."); add_default($nl, 'config_do_restart_snow_grain_radius', 'val'=>".false."); } add_default($nl, 'config_restart_timestamp_name'); add_default($nl, 'config_do_restart_hbrine'); -add_default($nl, 'config_do_restart_zsalinity'); add_default($nl, 'config_do_restart_bgc'); add_default($nl, 'config_do_restart_snow_density'); add_default($nl, 'config_do_restart_snow_grain_radius'); @@ -121,9 +118,6 @@ add_default($nl, 'config_include_pond_freshwater_feedback'); add_default($nl, 'config_use_test_ice_shelf'); add_default($nl, 'config_testing_system_test'); -add_default($nl, 'config_use_congelation_basal_melt'); -add_default($nl, 'config_use_lateral_melt'); -add_default($nl, 'config_use_latent_processes'); add_default($nl, 'config_limit_air_temperatures'); ################################### @@ -180,7 +174,6 @@ add_default($nl, 'config_use_column_snow_tracers'); add_default($nl, 'config_use_ice_age'); add_default($nl, 'config_use_first_year_ice'); add_default($nl, 'config_use_level_ice'); -add_default($nl, 'config_use_cesm_meltponds'); add_default($nl, 'config_use_level_meltponds'); add_default($nl, 'config_use_topo_meltponds'); add_default($nl, 'config_use_aerosols'); @@ -195,7 +188,6 @@ add_default($nl, 'config_use_floe_size_distribution'); add_default($nl, 'config_couple_biogeochemistry_fields'); add_default($nl, 'config_use_brine'); -add_default($nl, 'config_use_vertical_zsalinity'); add_default($nl, 'config_use_vertical_biochemistry'); add_default($nl, 'config_use_shortwave_bioabsorption'); add_default($nl, 'config_use_vertical_tracers'); @@ -220,8 +212,6 @@ add_default($nl, 'config_scale_initial_vertical_bgc'); add_default($nl, 'config_biogrid_bottom_molecular_sublayer'); add_default($nl, 'config_biogrid_top_molecular_sublayer'); add_default($nl, 'config_bio_gravity_drainage_length_scale'); -add_default($nl, 'config_zsalinity_molecular_sublayer'); -add_default($nl, 'config_zsalinity_gravity_drainage_scale'); add_default($nl, 'config_snow_porosity_at_ice_surface'); add_default($nl, 'config_new_ice_fraction_biotracer'); add_default($nl, 'config_fraction_biotracer_in_frazil'); @@ -403,6 +393,7 @@ add_default($nl, 'config_rapid_mode_aspect_ratio'); add_default($nl, 'config_slow_mode_drainage_strength'); add_default($nl, 'config_slow_mode_critical_porosity'); add_default($nl, 'config_macro_drainage_timescale'); +add_default($nl, 'config_congelation_freezing_method'); add_default($nl, 'config_congelation_ice_porosity'); ####################### @@ -451,6 +442,7 @@ add_default($nl, 'config_ocean_heat_transfer_type'); add_default($nl, 'config_sea_freezing_temperature_type'); add_default($nl, 'config_ocean_surface_type'); add_default($nl, 'config_use_data_icebergs'); +add_default($nl, 'config_iceberg_temperature'); add_default($nl, 'config_scale_dib_by_removed_ice_runoff'); add_default($nl, 'config_salt_flux_coupling_type'); add_default($nl, 'config_ice_ocean_drag_coefficient'); diff --git a/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml b/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml index 898714242c8d..bc34e085ccf8 100644 --- a/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml +++ b/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml @@ -61,7 +61,6 @@ false 'rpointer.ice' false -false false false false @@ -144,9 +143,6 @@ false false -true -true -true true @@ -219,7 +215,6 @@ false false true -false true false false @@ -231,7 +226,6 @@ false false -false false false false @@ -256,8 +250,6 @@ 0.006 0.006 20. -0.0 -0.028 -0.3 1.0 0.80 @@ -461,6 +453,7 @@ 'mushy' 'free' false +-4.0 false 'constant' 0.00536 diff --git a/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml b/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml index f411be9043a8..4412698d5072 100644 --- a/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml +++ b/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml @@ -245,14 +245,6 @@ Valid values: true or false Default: Defined in namelist_defaults.xml - -Restart the z-salinity tracer - -Valid values: false -Default: Defined in namelist_defaults.xml - - Restart the ice biogeochemistry @@ -564,30 +556,6 @@ Valid values: true or false Default: Defined in namelist_defaults.xml - -If true congelation and basal melt processes are active. - -Valid values: true or false -Default: Defined in namelist_defaults.xml - - - -If true lateral melt process is active. - -Valid values: true or false -Default: Defined in namelist_defaults.xml - - - -If true latent heat processes are active. - -Valid values: true or false -Default: Defined in namelist_defaults.xml - - If true limit air temperatures above @@ -809,7 +777,7 @@ Default: Defined in namelist_defaults.xml category="column_package" group="column_package"> Set column physics library. -Valid values: 'icepack' and 'column_package' +Valid values: 'icepack' Default: Defined in namelist_defaults.xml @@ -888,14 +856,6 @@ Valid values: true or false Default: Defined in namelist_defaults.xml - -If true use the cesm meltponds tracers. - -Valid values: true or false -Default: Defined in namelist_defaults.xml - - If true use the level ice meltponds tracers. @@ -971,14 +931,6 @@ Valid values: true or false Default: Defined in namelist_defaults.xml - -Use z-salinity (with Bitz and Lipscomb 1999 thermodynamics) - -Valid values: false -Default: Defined in namelist_defaults.xml - - Turn on the reaction terms for vertical biological tracers @@ -1171,22 +1123,6 @@ Valid values: Sets the gravity drainage length scale in the biological transport Default: Defined in namelist_defaults.xml - -Sets the ice/ocean molecular sublayer for the z-salinity model - -Valid values: zero or positive real number less than 1 -Default: Defined in namelist_defaults.xml - - - -Sets the gravity drainage length scale in the z-salinity model - -Valid values: positive real number less than 1 -Default: Defined in namelist_defaults.xml - - Specifies the snow porosity (volume of air/total volume) at the ice surface @@ -2489,7 +2425,7 @@ Default: Defined in namelist_defaults.xml -Method used for congelation freezing. +Method for congelation ice freezing. Valid values: 'one-step', 'two-step' Default: Defined in namelist_defaults.xml @@ -2694,6 +2630,14 @@ Valid values: true or false Default: Defined in namelist_defaults.xml + +Initial temperature of icebergs. + +Valid values: Any real number. +Default: Defined in namelist_defaults.xml + + Whether to scale data iceberg fluxes by the running mean of removed ice runoff diff --git a/components/mpas-seaice/cime_config/config_pes.xml b/components/mpas-seaice/cime_config/config_pes.xml index c781aaa74121..280b04862632 100644 --- a/components/mpas-seaice/cime_config/config_pes.xml +++ b/components/mpas-seaice/cime_config/config_pes.xml @@ -101,7 +101,7 @@ - + seaice: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0 @@ -131,21 +131,6 @@ - - - seaice+gcp10: default - - 30 - 30 - 30 - 16 - 16 - 16 - 30 - 30 - - - seaice+lawrencium-lr3: default, 2 nodes diff --git a/components/mpas-seaice/docs/dev-guide/index.md b/components/mpas-seaice/docs/dev-guide/index.md index be53365c8a04..ee7f85c58229 100644 --- a/components/mpas-seaice/docs/dev-guide/index.md +++ b/components/mpas-seaice/docs/dev-guide/index.md @@ -60,19 +60,17 @@ The following examples describe how to use the script for development in Icepack ### Set up and run baselines -Create a file containing modified namelist options. The file ``nset01.nlk`` in this example creates baselines for two types of column physics and turns off the ``snicar_ad`` radiation scheme. +Create a file containing modified namelist options. The file ``nset01.nlk`` in this example turns off the ``snicar_ad`` radiation scheme. ```text $ less nset01.nlk [mpassi] -config_column_physics_type = {'column_package','icepack'} config_use_snicar_ad = {.false.} ``` Notes: - A .nlk file without any config settings will create a baseline using default settings. -- The ``column_package`` option is still available but is no longer being supported in MPAS-seaice. Fetch E3SM (choose any name for the directory baselines01): @@ -92,7 +90,7 @@ Submit: ./E3SM-Polar-Developer.sh -s baselines01 -k nset01.nlk -e -q ``` -Examine the diagnostic output (compares the icepack run with the column_package run in this example): +Examine the diagnostic output: ```text ./E3SM-Polar-Developer.sh -s baselines01 -k nset01.nlk -e -a -v diff --git a/components/mpas-seaice/docs/index.md b/components/mpas-seaice/docs/index.md index e4239d697fd7..4f3e34ed4fff 100644 --- a/components/mpas-seaice/docs/index.md +++ b/components/mpas-seaice/docs/index.md @@ -37,7 +37,6 @@ Code structure within the ``mpas-seaice/``component-level directory: | ``driver`` | coupling modules | | ``src`` | source code for the model physics and output | | ``src/analysis_members`` | source code for model output | -| ``src/column`` | source code for the (original) ``column_package`` | | ``src/icepack`` | link to the icepack submodule | | ``src/model_forward`` | top-level mpas-seaice modules | | ``src/shared`` | dynamics and general-purpose modules (e.g. mesh, constants) | diff --git a/components/mpas-seaice/docs/tech-guide/index.md b/components/mpas-seaice/docs/tech-guide/index.md index 6ba000120ff2..baca580da887 100644 --- a/components/mpas-seaice/docs/tech-guide/index.md +++ b/components/mpas-seaice/docs/tech-guide/index.md @@ -54,8 +54,6 @@ With advanced physics and biogeochemistry (BGC) options, MPAS-Seaice can be conf ## Column Physics -The Icepack software has replaced the original ``colpkg`` column physics code in MPAS-seaice. The ``config_column_physics_type = 'column_package'`` option is still available but is no longer being supported in MPAS-seaice. - Because of the strong thermal gradients between the (cold) atmosphere and (relatively warm) oceans in polar regions, a large portion of the physics in sea ice models can be described in a vertical column, without reference to neighboring grid cells. MPAS-Seaice shares the same column physics code as CICE through the Icepack library (Hunke et al., 2018), which is maintained by the CICE Consortium. This code includes several options for simulating sea ice thermodynamics, mechanical redistribution (ridging) and associated area and thickness changes. In addition, the model supports a number of tracers, including thickness, enthalpy, ice age, first-year ice area, deformed ice area and volume, melt ponds, snow properties and biogeochemistry. Icepack is implemented in MPAS-seaice as a git submodule. Icepack consists of three independent parts, the column physics code, the Icepack driver that supports stand-alone testing of the column physics code, and the Icepack scripts that build and test the Icepack model. E3SM uses only the column physics code, which is called for each ocean grid cell. Icepack’s own driver and testing scripts are used when preparing new developments to be merged back to the CICE Consortium’s Icepack repository. diff --git a/components/mpas-seaice/docs/user-guide/index.md b/components/mpas-seaice/docs/user-guide/index.md index 21fbca2c32df..a09a060cf4f3 100644 --- a/components/mpas-seaice/docs/user-guide/index.md +++ b/components/mpas-seaice/docs/user-guide/index.md @@ -44,8 +44,6 @@ Related namelist variables are grouped according to their application. ## Icepack -The Icepack software has replaced the original ``colpkg`` column physics code in MPAS-seaice. The ``column_package`` option is still available but is no longer being supported in MPAS-seaice. - Full documentation for E3SM's version of Icepack can be found in [E3SM's Icepack readthedocs](). The most up-to-date documentation from the CICE Consortium's main Icepack repository is [here](). The MPAS-seaice driver for Icepack is diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index d4d96d8636cc..2576624cac61 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -54,8 +54,6 @@ module ice_comp_mct ! MPASSI modules use seaice_analysis_driver - use seaice_column, only: seaice_column_reinitialize_fluxes, & !colpkg - seaice_column_coupling_prep use seaice_icepack, only: seaice_icepack_reinitialize_fluxes, & seaice_icepack_coupling_prep use seaice_constants, only: coupleAlarmID, & @@ -77,8 +75,6 @@ module ice_comp_mct use seaice_mesh, only: seaice_latlon_vector_rotation_backward use seaice_time_integration use seaice_error, only: seaice_check_critical_error - - use ice_colpkg, only: colpkg_sea_freezing_temperature use icepack_intfc, only: icepack_sea_freezing_temperature ! @@ -494,8 +490,6 @@ end subroutine xml_stream_get_attributes tempLogicalConfig = .true. call mpas_pool_get_config(domain % configs, "config_do_restart_snow_grain_radius", tempLogicalConfig) tempLogicalConfig = .true. - call mpas_pool_get_config(domain % configs, "config_do_restart_zsalinity", tempLogicalConfig) - tempLogicalConfig = .true. call mpas_pool_get_config(domain % configs, "config_do_restart_bgc", tempLogicalConfig) tempLogicalConfig = .true. @@ -842,8 +836,6 @@ end subroutine xml_stream_get_attributes call MPAS_pool_get_config(domain % configs, "config_column_physics_type", tempCharConfig) if (trim(tempCharConfig) == "icepack") then call seaice_icepack_coupling_prep(domain) - else if (trim(tempCharConfig) == "column_package") then - call seaice_column_coupling_prep(domain) endif ! config_column_physics_type call MPAS_pool_get_config(domain % configs, "config_use_floe_size_distribution", tempLogicalConfig) @@ -1220,11 +1212,9 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ call shr_file_setLogUnit (iceLogUnit) ! reinitialize fluxes - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_reinitialize_fluxes(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_reinitialize_fluxes(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type ! Import state from coupler call ice_import_mct(x2i_i, ierr) @@ -2346,11 +2336,9 @@ subroutine ice_import_mct(x2i_i, errorCode)!{{{ seaSurfaceTemperature(i) = x2i_i % rAttr(index_x2i_So_t, n) seaSurfaceSalinity(i) = x2i_i % rAttr(index_x2i_So_s, n) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then seaFreezingTemperature(i) = icepack_sea_freezing_temperature(seaSurfaceSalinity(i)) - else if (trim(config_column_physics_type) == "column_package") then - seaFreezingTemperature(i) = colpkg_sea_freezing_temperature(seaSurfaceSalinity(i)) - endif ! config_column_physics_type +! endif ! config_column_physics_type uOceanVelocity(i) = x2i_i % rAttr(index_x2i_So_u, n) vOceanVelocity(i) = x2i_i % rAttr(index_x2i_So_v, n) @@ -3167,10 +3155,6 @@ subroutine frazil_mass(freezingPotential, frazilMassFlux, seaSurfaceSalinity) ! the frazil mass based on the freezingPotential according to sea ice model thermodynamics, ! ! !USES: - use ice_mushy_physics, only: & - liquidus_temperature_mush, & - enthalpy_mush - use icepack_intfc, only: & icepack_liquidus_temperature, & icepack_enthalpy_mush @@ -3210,13 +3194,10 @@ subroutine frazil_mass(freezingPotential, frazilMassFlux, seaSurfaceSalinity) Si0new = seaSurfaceSalinity**2 / (4.0_RKIND*seaiceFrazilSalinityReduction) endif - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then Ti = icepack_liquidus_temperature(Si0new/seaiceFrazilIcePorosity) qi0new = icepack_enthalpy_mush(Ti, Si0new) - else if (trim(config_column_physics_type) == "column_package") then - Ti = liquidus_temperature_mush(Si0new/seaiceFrazilIcePorosity) - qi0new = enthalpy_mush(Ti, Si0new) - endif ! config_column_physics_type +! endif ! config_column_physics_type else qi0new = -seaiceDensityIce*seaiceLatentHeatMelting @@ -3569,6 +3550,7 @@ subroutine ice_export_moab(EClock) i2x_im(n, index_i2x_Si_t) = Tsrf i2x_im(n, index_i2x_Si_bpress) = basalPressure i2x_im(n, index_i2x_Si_u10) = atmosReferenceSpeed10m(i) + i2x_im(n, index_i2x_Si_u10withgusts) = atmosReferenceSpeed10m(i) ! see commit 5813d4103 i2x_im(n, index_i2x_Si_tref) = atmosReferenceTemperature2m(i) i2x_im(n, index_i2x_Si_qref) = atmosReferenceHumidity2m(i) i2x_im(n, index_i2x_Si_snowh) = snowVolumeCell(i) / ailohi @@ -3906,7 +3888,7 @@ subroutine ice_import_moab(Eclock)!{{{ ent_type = 1 ! cells ! set all tags in one method tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( MPSIID, tagname, totalmblr , ent_type, x2i_im(1, 1) ) + ierr = iMOAB_GetDoubleTagStorage ( MPSIID, tagname, totalmblr , ent_type, x2i_im ) if ( ierr /= 0 ) then write(iceLogUnit,*) 'Fail to get seq_flds_x2i_fields ' endif @@ -3990,7 +3972,7 @@ subroutine ice_import_moab(Eclock)!{{{ seaSurfaceTemperature(i) = x2i_im(n,index_x2i_So_t) seaSurfaceSalinity(i) = x2i_im(n,index_x2i_So_s) - seaFreezingTemperature(i) = colpkg_sea_freezing_temperature(seaSurfaceSalinity(i)) + seaFreezingTemperature(i) = icepack_sea_freezing_temperature(seaSurfaceSalinity(i)) uOceanVelocity(i) = x2i_im(n,index_x2i_So_u) vOceanVelocity(i) = x2i_im(n,index_x2i_So_v) diff --git a/components/mpas-seaice/src/Makefile b/components/mpas-seaice/src/Makefile index 620610b1c339..4653a2348fcd 100644 --- a/components/mpas-seaice/src/Makefile +++ b/components/mpas-seaice/src/Makefile @@ -1,9 +1,9 @@ .SUFFIXES: .F .o -.PHONY: column_package icepack model_forward analysis_members shared +.PHONY: icepack model_forward analysis_members shared all: core_seaice -core_seaice: icepack column_package shared analysis_members model_forward +core_seaice: icepack shared analysis_members model_forward ar -ru libdycore.a `find . -type f -name "*.o"` gen_includes: @@ -21,19 +21,16 @@ post_build: cp default_inputs/* $(ROOT_DIR)/default_inputs/. ( cd $(ROOT_DIR)/default_inputs; for FILE in `ls -1`; do if [ ! -e ../$$FILE ]; then cp $$FILE ../.; fi; done ) -column_package: - (cd column; $(MAKE)) - icepack: $(MAKE) -f ../../Makefile.icepack --directory=icepack/columnphysics -shared: column_package icepack +shared: icepack (cd shared; $(MAKE)) -analysis_members: column_package icepack shared +analysis_members: icepack shared (cd analysis_members; $(MAKE)) -model_forward: column_package icepack shared analysis_members +model_forward: icepack shared analysis_members (cd model_forward; $(MAKE)) clean: diff --git a/components/mpas-seaice/src/Registry.xml b/components/mpas-seaice/src/Registry.xml index 80014f87df1e..232aa795d386 100644 --- a/components/mpas-seaice/src/Registry.xml +++ b/components/mpas-seaice/src/Registry.xml @@ -416,10 +416,6 @@ description="Restart the brine height tracer needed for vertical bgc" possible_values="true or false" /> - - - - - - - - + - @@ -2726,7 +2693,6 @@ - @@ -3249,11 +3215,6 @@ units="kg m-3" packages="pkgTracerZAerosols" /> - @@ -3839,11 +3800,6 @@ description="Cell average aerosol for each type in snow and ice bio-grid layer" packages="pkgTracerZAerosols" /> - @@ -5917,26 +5873,6 @@ units="m2" description="Fluid permeability on the interfaceBiologyGrid" /> - - - - - - - @@ -140,7 +139,6 @@ - @@ -212,7 +210,6 @@ - @@ -283,7 +280,6 @@ - @@ -422,8 +418,6 @@ - - @@ -630,9 +624,6 @@ - - - @@ -703,7 +694,6 @@ - @@ -842,8 +832,6 @@ - - diff --git a/components/mpas-seaice/src/analysis_members/mpas_seaice_pond_diagnostics.F b/components/mpas-seaice/src/analysis_members/mpas_seaice_pond_diagnostics.F index 006c48bc8e49..75596b7abbac 100644 --- a/components/mpas-seaice/src/analysis_members/mpas_seaice_pond_diagnostics.F +++ b/components/mpas-seaice/src/analysis_members/mpas_seaice_pond_diagnostics.F @@ -283,7 +283,6 @@ subroutine seaice_compute_pond_diagnostics(domain, instance, timeLevel, err)!{{{ meltPondDepthCategory logical, pointer :: & - config_use_cesm_meltponds, & config_use_level_meltponds, & config_use_topo_meltponds @@ -322,42 +321,10 @@ subroutine seaice_compute_pond_diagnostics(domain, instance, timeLevel, err)!{{{ call MPAS_pool_get_dimension(block % dimensions, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_config(block % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) call MPAS_pool_get_config(block % configs, "config_use_level_meltponds", config_use_level_meltponds) call MPAS_pool_get_config(block % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - if (config_use_cesm_meltponds) then - ! cesm ponds - - ! meltPondArea - apond - if (meltPondArea % isActive) then - do iCell = 1, nCellsSolve - meltPondArea % array(iCell) = pondAreaCell(iCell) - enddo ! iCell - endif ! is active - - ! meltPondAreaFinalArea - apond_ai - if (meltPondAreaFinalArea % isActive) then - do iCell = 1, nCellsSolve - meltPondAreaFinalArea % array(iCell) = pondAreaCell(iCell) * iceAreaCell(iCell) - enddo ! iCell - endif ! is active - - ! meltPondDepth - hpond - if (meltPondDepth % isActive) then - do iCell = 1, nCellsSolve - meltPondDepth % array(iCell) = pondAreaCell(iCell) * pondDepthCell(iCell) - enddo ! iCell - endif ! is active - - ! meltPondDepthFinalArea - hpond_ai - if (meltPondDepthFinalArea % isActive) then - do iCell = 1, nCellsSolve - meltPondDepthFinalArea % array(iCell) = pondAreaCell(iCell) * pondDepthCell(iCell) * iceAreaCell(iCell) - enddo ! iCell - endif ! is active - - else if (config_use_level_meltponds) then + if (config_use_level_meltponds) then ! level melt ponds ! meltPondArea - apond diff --git a/components/mpas-seaice/src/analysis_members/mpas_seaice_temperatures.F b/components/mpas-seaice/src/analysis_members/mpas_seaice_temperatures.F index 9c6136e807d8..9e8193424edc 100644 --- a/components/mpas-seaice/src/analysis_members/mpas_seaice_temperatures.F +++ b/components/mpas-seaice/src/analysis_members/mpas_seaice_temperatures.F @@ -218,10 +218,6 @@ end subroutine seaice_precompute_temperatures!}}} subroutine seaice_compute_temperatures(domain, instance, timeLevel, err)!{{{ - use ice_colpkg, only: & - colpkg_ice_temperature, & - colpkg_snow_temperature - use icepack_intfc, only: & icepack_ice_temperature, & icepack_snow_temperature @@ -319,7 +315,7 @@ subroutine seaice_compute_temperatures(domain, instance, timeLevel, err)!{{{ ! compute temperatures - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCellsSolve do iCategory = 1, nCategories @@ -349,37 +345,7 @@ subroutine seaice_compute_temperatures(domain, instance, timeLevel, err)!{{{ enddo ! iCategory enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - - do iCell = 1, nCellsSolve - do iCategory = 1, nCategories - - ! check if ice present - if (iceAreaCategory(1,iCategory,iCell) > 1e-11_RKIND) then - - ! ice layers - do iIceLayer = 1, nIceLayers - iceTemperature(iIceLayer, iCategory, iCell) = & - colpkg_ice_temperature(iceEnthalpy(iIceLayer,iCategory,iCell), & - iceSalinity(iIceLayer,iCategory,iCell)) - enddo ! iIceLayer - - ! snow layers - if (snowVolumeCategory(1,iCategory,iCell) > 1e-11_RKIND) then - - do iSnowLayer = 1, nSnowLayers - snowTemperature(iSnowLayer, iCategory, iCell) = & - colpkg_snow_temperature(snowEnthalpy(iSnowLayer,iCategory,iCell)) - enddo ! iIceLayer - - endif ! snowVolumeCategory - - endif ! iceAreaCategory - - enddo ! iCategory - enddo ! iCell - - endif ! config_column_physics_type +! endif ! config_column_physics_type block => block % next enddo diff --git a/components/mpas-seaice/src/column/.gitignore b/components/mpas-seaice/src/column/.gitignore deleted file mode 100644 index 66bec23b4383..000000000000 --- a/components/mpas-seaice/src/column/.gitignore +++ /dev/null @@ -1 +0,0 @@ -ice_constants_colpkg.F90 diff --git a/components/mpas-seaice/src/column/Makefile b/components/mpas-seaice/src/column/Makefile deleted file mode 100644 index c938731957af..000000000000 --- a/components/mpas-seaice/src/column/Makefile +++ /dev/null @@ -1,117 +0,0 @@ -.SUFFIXES: .F90 .o - -OBJS = ice_colpkg.o \ - ice_kinds_mod.o \ - ice_warnings.o \ - ice_colpkg_shared.o \ - ice_constants_colpkg.o \ - ice_therm_shared.o \ - ice_orbital.o \ - ice_mushy_physics.o \ - ice_therm_mushy.o \ - ice_atmo.o \ - ice_age.o \ - ice_firstyear.o \ - ice_flux_colpkg.o \ - ice_meltpond_cesm.o \ - ice_meltpond_lvl.o \ - ice_meltpond_topo.o \ - ice_therm_vertical.o \ - ice_therm_bl99.o \ - ice_therm_0layer.o \ - ice_itd.o \ - ice_colpkg_tracers.o \ - ice_therm_itd.o \ - ice_shortwave.o \ - ice_mechred.o \ - ice_aerosol.o \ - ice_brine.o \ - ice_algae.o \ - ice_zbgc.o \ - ice_zbgc_shared.o \ - ice_snow.o - -all: $(OBJS) - -ifneq "$(ESM)" "" -ice_constants_colpkg.F90: - cp constants/cesm/ice_constants_colpkg.F90 . -else -ice_constants_colpkg.F90: - cp constants/cice/ice_constants_colpkg.F90 . -endif - -ice_colpkg.o: ice_kinds_mod.o ice_constants_colpkg.o ice_warnings.o ice_colpkg_shared.o ice_therm_shared.o ice_orbital.o ice_atmo.o ice_age.o ice_firstyear.o ice_flux_colpkg.o ice_meltpond_cesm.o ice_meltpond_lvl.o ice_meltpond_topo.o ice_therm_vertical.o ice_itd.o ice_therm_itd.o ice_shortwave.o ice_mechred.o ice_colpkg_tracers.o ice_atmo.o ice_mushy_physics.o ice_zbgc.o ice_zbgc_shared.o ice_aerosol.o ice_algae.o ice_brine.o ice_zsalinity.o ice_snow.o - -ice_kinds_mod.o: - -ice_warnings.o: ice_kinds_mod.o - -ice_constants_colpkg.o: ice_constants_colpkg.F90 ice_kinds_mod.o - -ice_colpkg_shared.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_mushy_physics.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_therm_shared.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_orbital.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_therm_mushy.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_therm_shared.o ice_mushy_physics.o ice_colpkg_tracers.o - -ice_atmo.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_tracers.o - -ice_age.o: ice_kinds_mod.o - -ice_firstyear.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_flux_colpkg.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_meltpond_cesm.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_meltpond_lvl.o: ice_kinds_mod.o ice_constants_colpkg.o ice_therm_shared.o - -ice_meltpond_topo.o: ice_kinds_mod.o ice_constants_colpkg.o ice_therm_shared.o - -ice_therm_vertical.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_therm_shared.o ice_therm_bl99.o ice_therm_0layer.o ice_therm_mushy.o ice_mushy_physics.o - -ice_therm_bl99.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_therm_shared.o - -ice_therm_0layer.o: ice_kinds_mod.o ice_constants_colpkg.o ice_therm_bl99.o - -ice_itd.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_tracers.o ice_therm_shared.o ice_zbgc_shared.o - -ice_colpkg_tracers.o: ice_kinds_mod.o ice_constants_colpkg.o - -ice_therm_itd.o: ice_kinds_mod.o ice_constants_colpkg.o ice_itd.o ice_colpkg_tracers.o ice_therm_shared.o ice_therm_shared.o ice_mushy_physics.o ice_zbgc.o ice_zbgc_shared.o - -ice_shortwave.o: ice_kinds_mod.o ice_constants_colpkg.o ice_orbital.o - -ice_mechred.o: ice_kinds_mod.o ice_constants_colpkg.o ice_itd.o ice_colpkg_tracers.o - -ice_aerosol.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_colpkg_tracers.o ice_zbgc_shared.o - -ice_algae.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_colpkg_tracers.o ice_zbgc_shared.o ice_aerosol.o ice_warnings.o - -ice_brine.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_colpkg_tracers.o ice_zbgc_shared.o ice_therm_mushy.o ice_mushy_physics.o ice_therm_shared.o - -ice_zbgc.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o ice_colpkg_tracers.o ice_zbgc_shared.o ice_therm_shared.o ice_itd.o - -ice_zbgc_shared.o: ice_kinds_mod.o ice_constants_colpkg.o ice_colpkg_shared.o - -ice_snow.o: ice_kinds_mod.o ice_constants_colpkg.o ice_warnings.o ice_therm_vertical.o ice_colpkg_shared.o - - -.F90.o: - $(RM) $@ $*.mod -ifeq "$(GEN_F90)" "true" - $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90 - - $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -else - $(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F90 $(CPPINCLUDES) $(FCINCLUDES) -endif - -clean: - $(RM) *.o *.mod *.i90 - rm -f ice_constants_colpkg.F90 diff --git a/components/mpas-seaice/src/column/REVISION b/components/mpas-seaice/src/column/REVISION deleted file mode 100644 index c1c0d3e9ce55..000000000000 --- a/components/mpas-seaice/src/column/REVISION +++ /dev/null @@ -1 +0,0 @@ -r1230 diff --git a/components/mpas-seaice/src/column/constants/cesm/ice_constants_colpkg.F90 b/components/mpas-seaice/src/column/constants/cesm/ice_constants_colpkg.F90 deleted file mode 100644 index 0d2683e9e373..000000000000 --- a/components/mpas-seaice/src/column/constants/cesm/ice_constants_colpkg.F90 +++ /dev/null @@ -1,170 +0,0 @@ -! SVN:$Id: ice_constants_colpkg.F90 1326 2015-11-18 23:41:52Z afrobert@nps.edu $ -!======================================================================= -! -! This module defines a variety of physical and numerical constants -! used in the column package -! -! author Elizabeth C. Hunke, LANL - - module ice_constants_colpkg - - use ice_kinds_mod - use shr_const_mod - - implicit none - save - public - - !----------------------------------------------------------------- - ! physical constants - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter :: & - secday = SHR_CONST_CDAY ,&! seconds in calendar day - rhos = 330.0_dbl_kind ,&! density of snow (kg/m^3) - rhoi = SHR_CONST_RHOICE ,&! density of ice (kg/m^3) - rhow = SHR_CONST_RHOSW ,&! density of seawater (kg/m^3) - cp_air = SHR_CONST_CPDAIR ,&! specific heat of air (J/kg/K) - - ! (Briegleb JGR 97 11475-11485 July 1992) - !emissivity= 0.95_dbl_kind ,&! emissivity of snow and ice - ! Emissivity has been changed to unity here so that coupling is - ! physically correct - instantaneous radiative coupling in CIME - emissivity= 1.0_dbl_kind ,&! emissivity of snow and ice - - cp_ice = SHR_CONST_CPICE ,&! specific heat of fresh ice (J/kg/K) - cp_ocn = SHR_CONST_CPSW ,&! specific heat of ocn (J/kg/K) - ! freshwater value needed for enthalpy - depressT = 0.054_dbl_kind ,&! Tf:brine salinity ratio (C/ppt) - - albocn = 0.06_dbl_kind ,&! ocean albedo - gravit = SHR_CONST_G ,&! gravitational acceleration (m/s^2) - viscosity_dyn = 1.79e-3_dbl_kind, & ! dynamic viscosity of brine (kg/m/s) - Tocnfrz = -1.8_dbl_kind ,&! freezing temp of seawater (C), used - ! as Tsfcn for open water only when - ! tfrz_option is 'minus1p8' or null - rhofresh = SHR_CONST_RHOFW ,&! density of fresh water (kg/m^3) - zvir = SHR_CONST_ZVIR ,&! rh2o/rair - 1.0 - vonkar = SHR_CONST_KARMAN,&! von Karman constant - cp_wv = SHR_CONST_CPWV ,&! specific heat of water vapor (J/kg/K) - stefan_boltzmann = SHR_CONST_STEBOL,&! W/m^2/K^4 - Tffresh = SHR_CONST_TKFRZ ,&! freezing temp of fresh ice (K) - Lsub = SHR_CONST_LATSUB,&! latent heat, sublimation freshwater (J/kg) - Lvap = SHR_CONST_LATVAP,&! latent heat, vaporization freshwater (J/kg) - Lfresh = SHR_CONST_LATICE,&! latent heat of melting of fresh ice (J/kg) - Timelt = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ,&! melting temp. ice top surface (C) - Tsmelt = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ,&! melting temp. snow top surface (C) - ice_ref_salinity = SHR_CONST_ICE_REF_SAL ,&! (psu) -! ocn_ref_salinity = SHR_CONST_OCN_REF_SAL ,&! (psu) - - iceruf = 0.0005_dbl_kind ,&! ice surface roughness (m) - cprho = cp_ocn*rhow ,&! for ocean mixed layer (J kg / K m^3) - - ! for ice strength - Cf = 17._dbl_kind ,&! ratio of ridging work to PE change in ridging - Cp = 0.5_dbl_kind*gravit*(rhow-rhoi)*rhoi/rhow ,&! proport const for PE - Pstar = 2.75e4_dbl_kind ,&! constant in Hibler strength formula - ! (kstrength = 0) - Cstar = 20._dbl_kind ,&! constant in Hibler strength formula - ! (kstrength = 0) - - ! (Ebert, Schramm and Curry JGR 100 15965-15975 Aug 1995) - kappav = 1.4_dbl_kind ,&! vis extnctn coef in ice, wvlngth<700nm (1/m) - !kappan = 17.6_dbl_kind,&! vis extnctn coef in ice, wvlngth<700nm (1/m) - - ! kice is not used for mushy thermo - kice = 2.03_dbl_kind ,&! thermal conductivity of fresh ice(W/m/deg) - ! kseaice is used only for zero-layer thermo - kseaice= 2.00_dbl_kind ,&! thermal conductivity of sea ice (W/m/deg) - ! (used in zero layer thermodynamics option) - zref = 10._dbl_kind ,&! reference height for stability (m) - hs_min = 1.e-4_dbl_kind ,&! min snow thickness for computing zTsn (m) - snowpatch = 0.005_dbl_kind , & ! parameter for fractional snow area (m) -!tcx note cice snowpatch = 0.02 - - ! biogeochemistry - R_gC2molC = SHR_CONST_MWC, & ! molar mass of carbon - sk_l = 0.03_dbl_kind ! (m) skeletal layer thickness - - integer (kind=int_kind), parameter, public :: & - nspint = 3 ,& ! number of solar spectral intervals - nspint_5bd = 5 ! number of solar spectral intervals with config_use_snicar_ad - - ! weights for albedos - ! 4 Jan 2007 BPB Following are appropriate for complete cloud - ! in a summer polar atmosphere with 1.5m bare sea ice surface: - ! .636/.364 vis/nir with only 0.5% direct for each band. - real (kind=dbl_kind), parameter :: & ! currently used only - awtvdr = 0.00318_dbl_kind, &! visible, direct ! for history and - awtidr = 0.00182_dbl_kind, &! near IR, direct ! diagnostics - awtvdf = 0.63282_dbl_kind, &! visible, diffuse - awtidf = 0.36218_dbl_kind ! near IR, diffuse - - real (kind=dbl_kind), parameter :: & - qqqice = 11637800._dbl_kind ,&! for qsat over ice - TTTice = 5897.8_dbl_kind ,&! for qsat over ice - qqqocn = 627572.4_dbl_kind ,&! for qsat over ocn - TTTocn = 5107.4_dbl_kind ! for qsat over ocn - - ! orbital parameters - integer (kind=int_kind) :: iyear_AD ! Year to calculate orbit for - real(kind=dbl_kind),public :: eccen ! Earth's orbital eccentricity - real(kind=dbl_kind),public :: obliqr ! Earth's obliquity in radians - real(kind=dbl_kind),public :: lambm0 ! Mean longitude of perihelion at the - ! vernal equinox (radians) - real(kind=dbl_kind),public :: mvelpp ! Earth's moving vernal equinox longitude - ! of perihelion + pi (radians) - real(kind=dbl_kind),public :: obliq ! obliquity in degrees - real(kind=dbl_kind),public :: mvelp ! moving vernal equinox long - real(kind=dbl_kind),public :: decln ! solar declination angle in radians - real(kind=dbl_kind),public :: eccf ! earth orbit eccentricity factor - logical(kind=log_kind),public :: log_print ! Flags print of status/error - - ! snow parameters - real (kind=dbl_kind), parameter, public :: & - rhosmin = 100.0_dbl_kind ! minimum snow density (kg/m^3) - - !----------------------------------------------------------------- - ! numbers used in column package - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter :: & - c0 = 0.0_dbl_kind, & - c1 = 1.0_dbl_kind, & - c1p5 = 1.5_dbl_kind, & - c2 = 2.0_dbl_kind, & - c3 = 3.0_dbl_kind, & - c4 = 4.0_dbl_kind, & - c5 = 5.0_dbl_kind, & - c6 = 6.0_dbl_kind, & - c8 = 8.0_dbl_kind, & - c10 = 10.0_dbl_kind, & - c15 = 15.0_dbl_kind, & - c16 = 16.0_dbl_kind, & - c20 = 20.0_dbl_kind, & - c25 = 25.0_dbl_kind, & - c100 = 100.0_dbl_kind, & - c1000= 1000.0_dbl_kind, & - p001 = 0.001_dbl_kind, & - p01 = 0.01_dbl_kind, & - p1 = 0.1_dbl_kind, & - p2 = 0.2_dbl_kind, & - p4 = 0.4_dbl_kind, & - p5 = 0.5_dbl_kind, & - p6 = 0.6_dbl_kind, & - p05 = 0.05_dbl_kind, & - p15 = 0.15_dbl_kind, & - p25 = 0.25_dbl_kind, & - p75 = 0.75_dbl_kind, & - p333 = c1/c3, & - p666 = c2/c3, & - puny = 1.0e-11_dbl_kind, & - bignum = 1.0e+30_dbl_kind, & - pi = SHR_CONST_PI ,&! pi - pih = p5*pi - -!======================================================================= - - end module ice_constants_colpkg - -!======================================================================= diff --git a/components/mpas-seaice/src/column/constants/cice/ice_constants_colpkg.F90 b/components/mpas-seaice/src/column/constants/cice/ice_constants_colpkg.F90 deleted file mode 100644 index db8fa4ad362e..000000000000 --- a/components/mpas-seaice/src/column/constants/cice/ice_constants_colpkg.F90 +++ /dev/null @@ -1,161 +0,0 @@ -! SVN:$Id: ice_constants_colpkg.F90 1012 2015-06-26 12:34:09Z eclare $ -!======================================================================= -! -! This module defines a variety of physical and numerical constants -! used in the column package -! -! author Elizabeth C. Hunke, LANL - - module ice_constants_colpkg - - use ice_kinds_mod - - implicit none - save - private - - !----------------------------------------------------------------- - ! physical constants - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter, public :: & - secday = 86400.0_dbl_kind ,&! seconds in calendar day - rhos = 330.0_dbl_kind ,&! density of snow (kg/m^3) - rhoi = 917.0_dbl_kind ,&! density of ice (kg/m^3) - rhow = 1026.0_dbl_kind ,&! density of seawater (kg/m^3) - cp_air = 1005.0_dbl_kind ,&! specific heat of air (J/kg/K) - ! (Briegleb JGR 97 11475-11485 July 1992) - emissivity= 0.95_dbl_kind ,&! emissivity of snow and ice -!echmod emissivity= 0.985_dbl_kind ,&! emissivity of snow and ice - cp_ice = 2106._dbl_kind ,&! specific heat of fresh ice (J/kg/K) - cp_ocn = 4218._dbl_kind ,&! specific heat of ocn (J/kg/K) - ! freshwater value needed for enthalpy - depressT = 0.054_dbl_kind ,&! Tf:brine salinity ratio (C/ppt) - albocn = 0.06_dbl_kind ,&! ocean albedo - gravit = 9.80616_dbl_kind ,&! gravitational acceleration (m/s^2) - viscosity_dyn = 1.79e-3_dbl_kind, & ! dynamic viscosity of brine (kg/m/s) - Tocnfrz = -1.8_dbl_kind ,&! freezing temp of seawater (C), used - ! as Tsfcn for open water only when - ! tfrz_option is 'minus1p8' or null - rhofresh = 1000.0_dbl_kind ,&! density of fresh water (kg/m^3) - zvir = 0.606_dbl_kind ,&! rh2o/rair - 1.0 - vonkar = 0.4_dbl_kind ,&! von Karman constant - cp_wv = 1.81e3_dbl_kind ,&! specific heat of water vapor (J/kg/K) - stefan_boltzmann = 567.0e-10_dbl_kind,&! W/m^2/K^4 - Tffresh = 273.15_dbl_kind ,&! freezing temp of fresh ice (K) - Lsub = 2.835e6_dbl_kind ,&! latent heat, sublimation freshwater (J/kg) - Lvap = 2.501e6_dbl_kind ,&! latent heat, vaporization freshwater (J/kg) - Lfresh = Lsub-Lvap ,&! latent heat of melting of fresh ice (J/kg) - Timelt = 0.0_dbl_kind ,&! melting temperature, ice top surface (C) - Tsmelt = 0.0_dbl_kind ,&! melting temperature, snow top surface (C) - ice_ref_salinity = 4._dbl_kind ,&! (ppt) - ! ocn_ref_salinity = 34.7_dbl_kind,&! (ppt) - iceruf = 0.0005_dbl_kind ,&! ice surface roughness (m) - cprho = cp_ocn*rhow ,&! for ocean mixed layer (J kg / K m^3) - - ! for ice strength - Cp = 0.5_dbl_kind*gravit*(rhow-rhoi)*rhoi/rhow ,&! proport const for PE - Pstar = 2.75e4_dbl_kind ,&! constant in Hibler strength formula - ! (kstrength = 0) - Cstar = 20._dbl_kind ,&! constant in Hibler strength formula - ! (kstrength = 0) - - ! (Ebert, Schramm and Curry JGR 100 15965-15975 Aug 1995) - kappav = 1.4_dbl_kind ,&! vis extnctn coef in ice, wvlngth<700nm (1/m) - !kappan = 17.6_dbl_kind,&! vis extnctn coef in ice, wvlngth<700nm (1/m) - - ! kice is not used for mushy thermo - kice = 2.03_dbl_kind ,&! thermal conductivity of fresh ice(W/m/deg) - ! kseaice is used only for zero-layer thermo - kseaice= 2.00_dbl_kind ,&! thermal conductivity of sea ice (W/m/deg) - ! (used in zero layer thermodynamics option) - zref = 10._dbl_kind ,&! reference height for stability (m) - hs_min = 1.e-4_dbl_kind ,&! min snow thickness for computing zTsn (m) - snowpatch = 0.02_dbl_kind, & ! parameter for fractional snow area (m) - - ! biogeochemistry - R_gC2molC = 12.0107 , & ! molar mass of carbon - sk_l = 0.03_dbl_kind ! (m) skeletal layer thickness - - integer (kind=int_kind), parameter, public :: & - nspint = 3 ,& ! number of solar spectral intervals - nspint_5bd = 5 ! number of solar spectral intervals used in SNICAR - - ! weights for albedos - ! 4 Jan 2007 BPB Following are appropriate for complete cloud - ! in a summer polar atmosphere with 1.5m bare sea ice surface: - ! .636/.364 vis/nir with only 0.5% direct for each band. - real (kind=dbl_kind), parameter, public :: & ! currently used only - awtvdr = 0.00318_dbl_kind, &! visible, direct ! for history and - awtidr = 0.00182_dbl_kind, &! near IR, direct ! diagnostics - awtvdf = 0.63282_dbl_kind, &! visible, diffuse - awtidf = 0.36218_dbl_kind ! near IR, diffuse - - real (kind=dbl_kind), parameter, public :: & - qqqice = 11637800._dbl_kind ,&! for qsat over ice - TTTice = 5897.8_dbl_kind ,&! for qsat over ice - qqqocn = 627572.4_dbl_kind ,&! for qsat over ocn - TTTocn = 5107.4_dbl_kind ! for qsat over ocn - - ! orbital parameters - integer (kind=int_kind), public :: iyear_AD ! Year to calculate orbit for - real(kind=dbl_kind),public :: eccen ! Earth's orbital eccentricity - real(kind=dbl_kind),public :: obliqr ! Earth's obliquity in radians - real(kind=dbl_kind),public :: lambm0 ! Mean longitude of perihelion at the - ! vernal equinox (radians) - real(kind=dbl_kind),public :: mvelpp ! Earth's moving vernal equinox longitude - ! of perihelion + pi (radians) - real(kind=dbl_kind),public :: obliq ! obliquity in degrees - real(kind=dbl_kind),public :: mvelp ! moving vernal equinox long - real(kind=dbl_kind),public :: decln ! solar declination angle in radians - real(kind=dbl_kind),public :: eccf ! earth orbit eccentricity factor - logical(kind=log_kind),public :: log_print ! Flags print of status/error - - ! snow parameters - real (kind=dbl_kind), parameter, public :: & - rhosmin = 100.0_dbl_kind ! minimum snow density (kg/m^3) - - !----------------------------------------------------------------- - ! numbers used in column package - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter, public :: & - c0 = 0.0_dbl_kind, & - c1 = 1.0_dbl_kind, & - c1p5 = 1.5_dbl_kind, & - c2 = 2.0_dbl_kind, & - c3 = 3.0_dbl_kind, & - c4 = 4.0_dbl_kind, & - c5 = 5.0_dbl_kind, & - c6 = 6.0_dbl_kind, & - c8 = 8.0_dbl_kind, & - c10 = 10.0_dbl_kind, & - c15 = 15.0_dbl_kind, & - c16 = 16.0_dbl_kind, & - c20 = 20.0_dbl_kind, & - c25 = 25.0_dbl_kind, & - c100 = 100.0_dbl_kind, & - c1000= 1000.0_dbl_kind, & - p001 = 0.001_dbl_kind, & - p01 = 0.01_dbl_kind, & - p1 = 0.1_dbl_kind, & - p2 = 0.2_dbl_kind, & - p4 = 0.4_dbl_kind, & - p5 = 0.5_dbl_kind, & - p6 = 0.6_dbl_kind, & - p05 = 0.05_dbl_kind, & - p15 = 0.15_dbl_kind, & - p25 = 0.25_dbl_kind, & - p75 = 0.75_dbl_kind, & - p333 = c1/c3, & - p666 = c2/c3, & - puny = 1.0e-11_dbl_kind, & - bignum = 1.0e+30_dbl_kind, & - pi = 3.14159265358979323846_dbl_kind, & - pih = p5*pi - -!======================================================================= - - end module ice_constants_colpkg - -!======================================================================= diff --git a/components/mpas-seaice/src/column/documentation/ACMECollabAgreement_CICE_Hunke_Jul2015.pdf b/components/mpas-seaice/src/column/documentation/ACMECollabAgreement_CICE_Hunke_Jul2015.pdf deleted file mode 100644 index 146cc091f6a6..000000000000 Binary files a/components/mpas-seaice/src/column/documentation/ACMECollabAgreement_CICE_Hunke_Jul2015.pdf and /dev/null differ diff --git a/components/mpas-seaice/src/column/documentation/DocForChanges.pdf b/components/mpas-seaice/src/column/documentation/DocForChanges.pdf deleted file mode 100644 index 9087cd0ea159..000000000000 Binary files a/components/mpas-seaice/src/column/documentation/DocForChanges.pdf and /dev/null differ diff --git a/components/mpas-seaice/src/column/documentation/DocForChanges.rtf b/components/mpas-seaice/src/column/documentation/DocForChanges.rtf deleted file mode 100644 index 8a20d91b71d6..000000000000 --- a/components/mpas-seaice/src/column/documentation/DocForChanges.rtf +++ /dev/null @@ -1,228 +0,0 @@ -{\rtf1\ansi\ansicpg1252\cocoartf1038\cocoasubrtf360 -{\fonttbl\f0\fswiss\fcharset0 Helvetica;} -{\colortbl;\red255\green255\blue255;} -\margl1440\margr1440\vieww14640\viewh25240\viewkind0 -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\f0\b\fs24 \cf0 Changes to CICE Column Package -\b0 \ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 This report documents all new development changes needed to the column package interface and elsewhere in CICE, for two purposes:\ -1) to enable E. Hunke to understand the changes more quickly, allowing accelerated release to the CICE community,\ -2) to enable new column package developments to be ported to MPAS-Seaice more easily.\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i0 \cf0 \ - -\b Brief description\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i\b0 \cf0 Provide a one-sentence overview.\ -In a separate document, provide documentation suitable for inclusion in cicedoc.pdf. -\i0 \ -\ -\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\b \cf0 New Column Package Modules -\b0 \ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 List any new modules that you have added to the column package. -\i0 \ -\ -\ - -\i ----- Changes Necessary to the Column Package Interface or Outside of the Column Package ------ -\i0 \ -\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\b \cf0 Configuration and Declarations -\b0 \ -\ -changes to standard configuration\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 List changes such as the time step, vertical discretization, etc. that are necessary with the new added code capabilities -\i0 \ -\ -new tracers\ - cpp flags in comp_ice, bld/Macros.* ice_domain_size.F90\ - -\i List new pre-processing flags that have been added to these or other files. -\i0 \ -\ - tracer flags and variable names (provide tracer flag and dependency)\ - -\i List the flags (nt_name) and what other tracers it depends on for transport, such as ice area, snow volume, brine height, etc -\i0 .\ -\ -new arrays declared in ice_arrays_column.F90\ - -\i List the names of each new array. -\i0 \ -\ -\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\b \cf0 Initialization and Restart -\b0 \ -\ -new subroutines (provide module, subroutine name, and module/routine from which it is called)\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 E.g., module_name.F90: new_restart_subroutine_name called from module.F90/subroutine -\i0 \ -\ -new file unit numbers\ - -\i List unit number flags for each new required file, e.g. restart_x. -\i0 \ -\ -additional variables required for exact restart\ - -\i List the name of each variable required, and indicate whether the variable is in the tracer array or declared elsewhere. -\i0 \ -\ -other variables initialized outside of new subroutines (provide variable name and module/subroutine)\ - -\i E.g., variable_name appears in module1.F90/subroutine1, module2.F90/subroutine2 -\i0 \ -\ -\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\b \cf0 Time Stepping -\b0 \ -\ -new subroutines (provide module, subroutine name, and module/routine from which it is called)\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 E.g., module_name.F90: new_step_subroutine called from module.F90/subroutine -\i0 \ -\ -other subroutine calls added (provide subroutine name, and module/routine from which it is called)\ - -\i E.g., old_subroutine_name called from module.F90/subroutine -\i0 \ -\ -\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\b \cf0 Column Package Interface -\b0 \ -\ -ice_constants_colpkg.F90: new parameters\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 List new physical or other constant parameters -\i0 \ -\ -ice_colpkg_shared.F90: new namelist flags and parameters\ - tracers\ - -\i List flags that control new tracers, e.g. tr_x, restart_x. -\i0 \ -\ - namelist (provide namelist name):\ - -\i List all other new namelist flags and parameters, and the name of any new namelist (e.g. new_namelist.nml). -\i0 \ -\ -ice_colpkg_tracers: new tracers\ - -\i List flags that control new tracers, e.g. tr_x, restart_x. These should be the same as in ice_colpkg_shared.F90.\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i0 \cf0 \ -\ -ice_colpkg.F90\ - arguments added to subroutine calls (matching changes also made in subroutines)\ - (provide subroutine name and arguments added or changed)\ - -\i E.g., subroutine1: abc, xyz where abc and xyz are arguments in the subroutine1 call that are new or changed. -\i0 \ -\ - new subroutine calls to other modules (with matching 'use' statements)\ - -\i List the names of new subroutines called from ice_colpkg.F90. -\i0 \ -\ - new subroutines\ - -\i List the names of new subroutines added to ice_colpkg.F90. -\i0 \ -\ - other changes\ - -\i Describe any other changes to the code that are necessary for proper functioning of the new code. -\i0 \ -\ -\ - -\b Changes Made Outside of New Subroutines -\b0 \ -\ -In column package:\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 List each module and describe the necessary change. E.g. old_module.F90: use xyz to compute abc instead of ghi. -\i0 \ -\ -Elsewhere:\ - -\i As above for CICE modules not included in the column package. -\i0 \ -\ -\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\b \cf0 Output and Coupling -\b0 \ -\ -coupling/history variables declared in ice_flux.F90\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 List new variable names. -\i0 \ -\ -history namelist flags\ - namelist (provide namelist name):\ - -\i List any new namelist names (icefields_newname_nml) and all new namelist flags (f_name). -\i0 \ -\ -diagnostics\ - standard\ - -\i List any new diagnostic output included in CICE\'92s text log files not listed below. -\i0 \ -\ - print_global\ - -\i List any new global diagnostic output included in CICE\'92s text log files and controlled by the flag print_global. -\i0 \ -\ - print_points\ - -\i List any new local diagnostic output included in CICE\'92s text log files and controlled by the flag print_points.\ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i0 \cf0 \ - tracers added to ice_transport_driver.F90 diagnostics (in init_transport)\ - -\i List the flags for all new tracers added to this diagnostic output (nt_name).\ - -\i0 \ -\ - -\b Comments (suggestions, bug fixes, etc) -\b0 \ -\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\ql\qnatural\pardirnatural - -\i \cf0 List anything else that needs to be fixed or otherwise might be helpful. -\i0 \ - \ -} diff --git a/components/mpas-seaice/src/column/documentation/README b/components/mpas-seaice/src/column/documentation/README deleted file mode 100644 index 463d6c6539d6..000000000000 --- a/components/mpas-seaice/src/column/documentation/README +++ /dev/null @@ -1,113 +0,0 @@ -CICE and MPAS-Seaice Column Physics Package -June 30, 2015 (CHANGE FOR RELEASE) - -A very large community, including many climate modeling and forecast -centers, uses the CICE model. Several of these centers and collaborators -have been active in the development of CICE, particularly in the column -physics. As part of the ACME proposal, DOE's CICE developers specifically -outlined an approach for continued support of this CICE community during -the transition to the new DOE MPAS-based sea-ice model. The CICE column -physics package is a set of modules that are completely independent of -grid and other infrastructural CICE elements (e.g. MPI tasks, calendar). -It also includes an interface of subroutine calls that translate from -model-specific arrays and other variables to the model-independent column -physics calculations. The package is callable by both the older CICE -model (modified v5.1) and the new MPAS-Seaice model to enable continued -development of the CICE column physics during the transition. - -The column package code is available to approved collaborators through the -CICE subversion repository, at (CHANGE THIS FOR RELEASE) -http://oceans11.lanl.gov/svn/CICE/branches/column_pkg/source_colpkg. -Complete documentation of the included physics is available in the CICE -documentation (cicedoc.pdf) available from -http://oceans11.lanl.gov/trac/CICE/attachment/wiki/WikiStart/cicedoc.pdf?format=raw. - -Collaborations, and access to the repository, must be approved by the DOE -developers of the column package (contact E. Hunke, eclare@lanl.gov), and -are subject to the collaboration agreement included in this directory -(see CollaborationAgreement). The code may not be redistributed beyond the -approved collaboration. - -To be incorporated into the column package, community development code must -be accompanied with a complete description of the changes necessary to the -column package interface. A form detailing the information needed is -provided in this directory (see DocForChanges). - -Requirements: -1. Modules within the column package shall use no modules that are not part -of the column package (see module designations below). -2. Modules outside the column package shall use only the column packag -interface modules. -3. Column package modules shall contain as much of the 'physics' for each -column parameterization as possible, leaving only infrastructure related -elements outside, such as array declarations and I/O. - -Notes regarding coding style: -1. Most 'use' statements should be restricted to use of subroutines, with -variables passed through argument lists rather than being used. -2. In most cases, tracers are passed into the column package as individual -arrays named according to their physical representation. Pass the tracer -tracer arrays, with tracer indices, only when unavoidable. -3. Variables declared at the tops of modules should include only those -that are used strictly within the module, except for 'shared' modules. -4. All variable declarations should include comments identifying the -variable and its units. -5. Comment code subroutines and subsections freely and verbosely. -6. There are exceptions to these rules in the existing column -package. We are still working on it. - -Source Code: - -Interface modules, marked with *, contain all code that needs to be -accessed from outside the column package in CICE and MPAS-Seaice. In turn, -the interface modules call other, internal column package code. Although -it is not included in the column package, corresponding code must be -included outside of the column package to declare spatial arrays, assign -namelist and other parameter values, call subroutines within the column -package, etc. In the column-package version of CICE, these modules are -source/ice_arrays_column.F90 -source/ice_init_column.F90 -source/ice_restart_column.F90 -source/ice_step_mod.F90. - -Column Package Source Code: - -source_colpkg/ - -constants/ -constants/cesm/ice_constants_colpkg.F90 -constants/cice/ice_constants_colpkg.F90 -constants/hadgem3/ice_constants_colpkg.F90 - -documentation/ -documentation/CollaborationAgreement.pdf -documentation/DocForChanges.pdf -documentation/DocForChanges.rtf -documentation/README - -*ice_kinds_mod.F90 -ice_aerosol.F90 -ice_age.F90 -ice_algae.F90 -ice_atmo.F90 -*ice_colpkg.F90 -*ice_colpkg_shared.F90 -*ice_colpkg_tracers.F90 -ice_firstyear.F90 -ice_flux_colpkg.F90 -ice_itd.F90 -ice_mechred.F90 -ice_meltpond_cesm.F90 -ice_meltpond_lvl.F90 -ice_meltpond_topo.F90 -ice_mushy_physics.F90 -ice_orbital.F90 -ice_shortwave.F90 -ice_therm_0layer.F90 -ice_therm_bl99.F90 -ice_therm_itd.F90 -ice_therm_mushy.F90 -ice_therm_shared.F90 -ice_therm_vertical.F90 -ice_zbgc.F90 -ice_zbgc_shared.F90 diff --git a/components/mpas-seaice/src/column/ice_aerosol.F90 b/components/mpas-seaice/src/column/ice_aerosol.F90 deleted file mode 100644 index a4a270713a80..000000000000 --- a/components/mpas-seaice/src/column/ice_aerosol.F90 +++ /dev/null @@ -1,906 +0,0 @@ -! SVN:$Id: ice_aerosol.F90 1175 2017-03-02 19:53:26Z akt $ -!======================================================================= - -! Aerosol tracer within sea ice -! -! authors Marika Holland, NCAR -! David Bailey, NCAR - - module ice_aerosol - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, puny, rhoi, rhos, hs_min - use ice_warnings, only: add_warning - - implicit none - - private - public :: update_aerosol, update_snow_bgc - -!======================================================================= - - contains - -!======================================================================= - -! Increase aerosol in ice or snow surface due to deposition -! and vertical cycling - - subroutine update_aerosol(dt, & - nilyr, nslyr, & - n_aero, & - meltt, melts, & - meltb, congel, & - snoice, & - fsnow, & - aerosno, aeroice, & - aice_old, & - vice_old, vsno_old, & - vicen, vsnon, aicen, & - faero_atm, faero_ocn) - - use ice_colpkg_shared, only: hi_ssl, hs_ssl, max_aero - use ice_colpkg_tracers, only: nt_aero - - integer (kind=int_kind), intent(in) :: & - nilyr, nslyr, n_aero - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step - meltt, & ! thermodynamic melt/growth rates - melts, & - meltb, & - congel, & - snoice, & - fsnow, & - vicen, & ! ice volume (m) - vsnon, & ! snow volume (m) - aicen, & ! ice area fraction - aice_old, & ! values prior to thermodynamic changes - vice_old, & - vsno_old - - real (kind=dbl_kind), dimension(:), & - intent(in) :: & - faero_atm ! aerosol deposition rate (W/m^2 s) - - real (kind=dbl_kind), dimension(:), & - intent(inout) :: & - faero_ocn ! aerosol flux to ocean (W/m^2 s) - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - aerosno, aeroice ! kg/m^2 - - ! local variables - integer (kind=int_kind) :: k, n - - real (kind=dbl_kind) :: & - dzssl, dzssl_new, & ! snow ssl thickness - dzint, dzint_new, & ! snow interior thickness - dzssli, dzssli_new, & ! ice ssl thickness - dzinti, dzinti_new, & ! ice interior thickness - dznew, & ! tracks thickness changes - hs, hi, & ! snow/ice thickness (m) - dhs_evap, dhi_evap, & ! snow/ice thickness change due to evap - dhs_melts, dhi_meltt, & ! ... due to surface melt - dhs_snoice, dhi_snoice, & ! ... due to snow-ice formation - dhi_congel, dhi_meltb, & ! ... due to bottom growth, melt - hslyr, hilyr, & ! snow, ice layer thickness (m) - hslyr_old, hilyr_old, & ! old snow, ice layer thickness (m) - hs_old, hi_old, & ! old snow, ice thickness (m) - sloss1, sloss2, & ! aerosol mass loss (kg/m^2) - ar ! 1/aicen(i,j) - - real (kind=dbl_kind), dimension(max_aero) :: & - kscav, kscavsi ! scavenging by melt water - - real (kind=dbl_kind), dimension(n_aero) :: & - aerotot, aerotot0, & ! for conservation check - focn_old ! for conservation check - - real (kind=dbl_kind), dimension(n_aero,2) :: & - aerosno0, aeroice0 ! for diagnostic prints - - character(len=char_len_long) :: & - warning ! warning message - - ! echmod: this assumes max_aero=6 - data kscav / .03_dbl_kind, .20_dbl_kind, .02_dbl_kind, & - .02_dbl_kind, .01_dbl_kind, .01_dbl_kind / - data kscavsi / .03_dbl_kind, .20_dbl_kind, .02_dbl_kind, & - .02_dbl_kind, .01_dbl_kind, .01_dbl_kind / - - !------------------------------------------------------------------- - ! initialize - !------------------------------------------------------------------- - focn_old(:) = faero_ocn(:) - aerosno0(:,:) = c0 - aeroice0(:,:) = c0 - - hs_old = vsno_old/aice_old - hi_old = vice_old/aice_old - hslyr_old = hs_old/real(nslyr,kind=dbl_kind) - hilyr_old = hi_old/real(nilyr,kind=dbl_kind) - - dzssl = min(hslyr_old/c2, hs_ssl) - dzssli = min(hilyr_old/c2, hi_ssl) - dzint = hs_old - dzssl - dzinti = hi_old - dzssli - - if (aicen > c0) then - ar = c1/aicen - hs = vsnon*ar - hi = vicen*ar - dhs_melts = -melts*ar - dhi_snoice = snoice*ar - dhs_snoice = dhi_snoice*rhoi/rhos - dhi_meltt = -meltt*ar - dhi_meltb = -meltb*ar - dhi_congel = congel*ar - else ! ice disappeared during time step - hs = vsnon/aice_old - hi = vicen/aice_old - dhs_melts = -melts/aice_old - dhi_snoice = snoice/aice_old - dhs_snoice = dhi_snoice*rhoi/rhos - dhi_meltt = -meltt/aice_old - dhi_meltb = -meltb/aice_old - dhi_congel = congel/aice_old - endif - - dhs_evap = hs - (hs_old + dhs_melts - dhs_snoice & - + fsnow/rhos*dt) - dhi_evap = hi - (hi_old + dhi_meltt + dhi_meltb & - + dhi_congel + dhi_snoice) - - do k = 1, n_aero - aerosno0(k,:) = aerosno(k,:) - aeroice0(k,:) = aeroice(k,:) - aerotot0(k) = aerosno(k,2) + aerosno(k,1) & - + aeroice(k,2) + aeroice(k,1) - enddo - - !------------------------------------------------------------------- - ! evaporation - !------------------------------------------------------------------- - dzint = dzint + min(dzssl + dhs_evap, c0) - dzinti = dzinti + min(dzssli + dhi_evap, c0) - dzssl = max(dzssl + dhs_evap, c0) - dzssli = max(dzssli + dhi_evap, c0) - - !------------------------------------------------------------------- - ! basal ice growth - !------------------------------------------------------------------- - dzinti = dzinti + dhi_congel - - !------------------------------------------------------------------- - ! surface snow melt - !------------------------------------------------------------------- - if (-dhs_melts > puny) then - do k = 1, n_aero - sloss1 = c0 - sloss2 = c0 - if (dzssl > puny) & - sloss1 = kscav(k)*aerosno(k,1) & - *min(-dhs_melts,dzssl)/dzssl - aerosno(k,1) = aerosno(k,1) - sloss1 - if (dzint > puny) & - sloss2 = kscav(k)*aerosno(k,2) & - *max(-dhs_melts-dzssl,c0)/dzint - aerosno(k,2) = aerosno(k,2) - sloss2 - faero_ocn(k) = faero_ocn(k) + (sloss1+sloss2)/dt - enddo ! n_aero - - ! update snow thickness - dzint=dzint+min(dzssl+dhs_melts, c0) - dzssl=max(dzssl+dhs_melts, c0) - - if ( dzssl <= puny ) then ! ssl melts away - aerosno(:,2) = aerosno(:,1) + aerosno(:,2) - aerosno(:,1) = c0 - dzssl = max(dzssl, c0) - endif - if (dzint <= puny ) then ! all snow melts away - aeroice(:,1) = aeroice(:,1) & - + aerosno(:,1) + aerosno(:,2) - aerosno(:,:) = c0 - dzint = max(dzint, c0) - endif - endif - - !------------------------------------------------------------------- - ! surface ice melt - !------------------------------------------------------------------- - if (-dhi_meltt > puny) then - do k = 1, n_aero - sloss1 = c0 - sloss2 = c0 - if (dzssli > puny) & - sloss1 = kscav(k)*aeroice(k,1) & - *min(-dhi_meltt,dzssli)/dzssli - aeroice(k,1) = aeroice(k,1) - sloss1 - if (dzinti > puny) & - sloss2 = kscav(k)*aeroice(k,2) & - *max(-dhi_meltt-dzssli,c0)/dzinti - aeroice(k,2) = aeroice(k,2) - sloss2 - faero_ocn(k) = faero_ocn(k) + (sloss1+sloss2)/dt - enddo - - dzinti = dzinti + min(dzssli+dhi_meltt, c0) - dzssli = max(dzssli+dhi_meltt, c0) - if (dzssli <= puny) then ! ssl ice melts away - do k = 1, n_aero - aeroice(k,2) = aeroice(k,1) + aeroice(k,2) - aeroice(k,1) = c0 - enddo - dzssli = max(dzssli, c0) - endif - if (dzinti <= puny) then ! all ice melts away - do k = 1, n_aero - faero_ocn(k) = faero_ocn(k) & - + (aeroice(k,1)+aeroice(k,2))/dt - aeroice(k,:)=c0 - enddo - dzinti = max(dzinti, c0) - endif - endif - - !------------------------------------------------------------------- - ! basal ice melt. Assume all aero lost in basal melt - !------------------------------------------------------------------- - if (-dhi_meltb > puny) then - do k=1,n_aero - sloss1=c0 - sloss2=c0 - if (dzssli > puny) & - sloss1 = max(-dhi_meltb-dzinti, c0) & - *aeroice(k,1)/dzssli - aeroice(k,1) = aeroice(k,1) - sloss1 - if (dzinti > puny) & - sloss2 = min(-dhi_meltb, dzinti) & - *aeroice(k,2)/dzinti - aeroice(k,2) = aeroice(k,2) - sloss2 - faero_ocn(k) = faero_ocn(k) + (sloss1+sloss2)/dt - enddo - - dzssli = dzssli + min(dzinti+dhi_meltb, c0) - dzinti = max(dzinti+dhi_meltb, c0) - endif - - !------------------------------------------------------------------- - ! snowfall - !------------------------------------------------------------------- - if (fsnow > c0) dzssl = dzssl + fsnow/rhos*dt - - !------------------------------------------------------------------- - ! snow-ice formation - !------------------------------------------------------------------- - if (dhs_snoice > puny) then - do k = 1, n_aero - sloss1 = c0 - sloss2 = c0 - if (dzint > puny) & - sloss2 = min(dhs_snoice, dzint) & - *aerosno(k,2)/dzint - aerosno(k,2) = aerosno(k,2) - sloss2 - if (dzssl > puny) & - sloss1 = max(dhs_snoice-dzint, c0) & - *aerosno(k,1)/dzssl - aerosno(k,1) = aerosno(k,1) - sloss1 - aeroice(k,1) = aeroice(k,1) & - + (c1-kscavsi(k))*(sloss2+sloss1) - faero_ocn(k) = faero_ocn(k) & - + kscavsi(k)*(sloss2+sloss1)/dt - enddo - dzssl = dzssl - max(dhs_snoice-dzint, c0) - dzint = max(dzint-dhs_snoice, c0) - dzssli = dzssli + dhi_snoice - endif - - !------------------------------------------------------------------- - ! aerosol deposition - !------------------------------------------------------------------- - if (aicen > c0) then - hs = vsnon * ar - else - hs = c0 - endif - if (hs > hs_min) then ! should this really be hs_min or 0? - ! should use same hs_min value as in radiation - do k=1,n_aero - aerosno(k,1) = aerosno(k,1) & - + faero_atm(k)*dt*aicen - enddo - else - do k=1,n_aero - aeroice(k,1) = aeroice(k,1) & - + faero_atm(k)*dt*aicen - enddo - endif - - !------------------------------------------------------------------- - ! redistribute aerosol within vertical layers - !------------------------------------------------------------------- - if (aicen > c0) then - hs = vsnon * ar ! new snow thickness - hi = vicen * ar ! new ice thickness - else - hs = c0 - hi = c0 - endif - if (dzssl <= puny) then ! nothing in SSL - do k=1,n_aero - aerosno(k,2) = aerosno(k,2) + aerosno(k,1) - aerosno(k,1) = c0 - enddo - endif - if (dzint <= puny) then ! nothing in Snow Int - do k = 1, n_aero - aeroice(k,1) = aeroice(k,1) + aerosno(k,2) - aerosno(k,2) = c0 - enddo - endif - if (dzssli <= puny) then ! nothing in Ice SSL - do k = 1, n_aero - aeroice(k,2) = aeroice(k,2) + aeroice(k,1) - aeroice(k,1) = c0 - enddo - endif - - if (dzinti <= puny) then ! nothing in Ice INT - do k = 1, n_aero - faero_ocn(k) = faero_ocn(k) & - + (aeroice(k,1)+aeroice(k,2))/dt - aeroice(k,:)=c0 - enddo - endif - - hslyr = hs/real(nslyr,kind=dbl_kind) - hilyr = hi/real(nilyr,kind=dbl_kind) - dzssl_new = min(hslyr/c2, hs_ssl) - dzssli_new = min(hilyr/c2, hi_ssl) - dzint_new = hs - dzssl_new - dzinti_new = hi - dzssli_new - - if (hs > hs_min) then - do k = 1, n_aero - dznew = min(dzssl_new-dzssl, c0) - sloss1 = c0 - if (dzssl > puny) & - sloss1 = dznew*aerosno(k,1)/dzssl ! not neccesarily a loss - dznew = max(dzssl_new-dzssl, c0) - if (dzint > puny) & - sloss1 = sloss1 + aerosno(k,2)*dznew/dzint - aerosno(k,1) = aerosno(k,1) + sloss1 - aerosno(k,2) = aerosno(k,2) - sloss1 - enddo - else - aeroice(:,1) = aeroice(:,1) & - + aerosno(:,1) + aerosno(:,2) - aerosno(:,:) = c0 - endif - - if (vicen > puny) then ! may want a limit on hi instead? - do k = 1, n_aero - sloss2 = c0 - dznew = min(dzssli_new-dzssli, c0) - if (dzssli > puny) & - sloss2 = dznew*aeroice(k,1)/dzssli - dznew = max(dzssli_new-dzssli, c0) - if (dzinti > puny) & - sloss2 = sloss2 + aeroice(k,2)*dznew/dzinti - aeroice(k,1) = aeroice(k,1) + sloss2 - aeroice(k,2) = aeroice(k,2) - sloss2 - enddo - else - faero_ocn(:) = faero_ocn(:) + (aeroice(:,1)+aeroice(:,2))/dt - aeroice(:,:) = c0 - endif - - !------------------------------------------------------------------- - ! check conservation - !------------------------------------------------------------------- - do k = 1, n_aero - aerotot(k) = aerosno(k,2) + aerosno(k,1) & - + aeroice(k,2) + aeroice(k,1) - if ((aerotot(k)-aerotot0(k)) & - - ( faero_atm(k)*aicen & - - (faero_ocn(k)-focn_old(k)) )*dt > puny) then - - write(warning,*) 'aerosol tracer: ',k - call add_warning(warning) - write(warning,*) 'aerotot-aerotot0 ',aerotot(k)-aerotot0(k) - call add_warning(warning) - write(warning,*) 'faero_atm-faero_ocn ', & - (faero_atm(k)*aicen-(faero_ocn(k)-focn_old(k)))*dt - call add_warning(warning) - endif - enddo - - !------------------------------------------------------------------- - ! check for negative values - !------------------------------------------------------------------- - -!echmod: note that this does not test or fix all aero tracers - if (aeroice(1,1) < -puny .or. & - aeroice(1,2) < -puny .or. & - aerosno(1,1) < -puny .or. & - aerosno(1,2) < -puny) then - - write(warning,*) 'aerosol negative in aerosol code' - call add_warning(warning) - - aeroice(1,1) = max(aeroice(1,1), c0) - aeroice(1,2) = max(aeroice(1,2), c0) - aerosno(1,1) = max(aerosno(1,1), c0) - aerosno(1,2) = max(aerosno(1,2), c0) - - endif - - end subroutine update_aerosol - -!======================================================================= - -! Increase aerosol in snow surface due to deposition -! and vertical cycling : after update_aerosol - - subroutine update_snow_bgc (dt, nblyr, & - nslyr, & - meltt, melts, & - meltb, congel, & - snoice, nbtrcr, & - fsnow, ntrcr, & - trcrn, bio_index, & - aice_old, zbgc_snow, & - vice_old, vsno_old, & - vicen, vsnon, & - aicen, flux_bio_atm,& - zbgc_atm, flux_bio, & - bio_index_o) - - use ice_colpkg_shared, only: hi_ssl, hs_ssl, hs_ssl_min - use ice_constants_colpkg, only: c0, rhos, rhoi, hs_min, puny, & - c2, c1, p5 - use ice_zbgc_shared, only: kscavz - - integer (kind=int_kind), intent(in) :: & - nbtrcr, & ! number of distinct snow tracers - nblyr, & ! number of bio layers - nslyr, & ! number of snow layers - ntrcr ! number of tracers - - integer (kind=int_kind), dimension (nbtrcr), intent(in) :: & - bio_index, & - bio_index_o ! provides index of scavenging (kscavz) data array - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), intent(in) :: & - meltt, & ! thermodynamic melt/growth rates - melts, & - meltb, & - congel, & - snoice, & - fsnow, & - vicen, & ! ice volume (m) - vsnon, & ! snow volume (m) - aicen, & ! ice area fraction - aice_old, & ! values prior to thermodynamic changes - vice_old, & - vsno_old - - real (kind=dbl_kind),dimension(nbtrcr), intent(out) :: & - zbgc_snow, & ! aerosol contribution from snow to ice - zbgc_atm ! and atm to ice concentration * volume (kg or mmol/m^3*m) - - real (kind=dbl_kind),dimension(nbtrcr), intent(inout) :: & - flux_bio ! total ocean tracer flux (mmol/m^2/s) - - real (kind=dbl_kind), dimension(nbtrcr), & - intent(in) :: & - flux_bio_atm ! aerosol deposition rate (kg or mmol/m^2 s) - - real (kind=dbl_kind), dimension(ntrcr), & - intent(inout) :: & - trcrn ! ice/snow tracer array - - ! local variables - - integer (kind=int_kind) :: k, n - - real (kind=dbl_kind) :: & - dzssl, dzssl_new, & ! snow ssl thickness - dzint, dzint_new, & ! snow interior thickness - dz, & ! - hi, & ! ice thickness (m) - hilyr, & ! ice layer thickness (m) - hs, & ! snow thickness (m) - dhs_evap, & ! snow thickness change due to evap - dhs_melts, & ! ... due to surface melt - dhs_snoice, & ! ... due to snow-ice formation - hslyr, & ! snow layer thickness (m) - hslyr_old, & ! old snow layer thickness (m) - hs_old, & ! old snow thickness (m) - dznew, & ! change in the snow sl (m) - sloss1, sloss2, & ! aerosol mass loss (kg/m^2) - ar ! 1/aicen(i,j) - - real (kind=dbl_kind), dimension(nbtrcr) :: & - aerotot, aerotot0, & ! for conservation check (mmol/m^3) - aero_cons , & ! for conservation check (mmol/m^2) - flux_bio_o ! initial ocean tracer flux (mmol/m^2/s) - - real (kind=dbl_kind), dimension(nbtrcr,2) :: & - aerosno, & ! kg/m^2 - aerosno0 ! for diagnostic prints - - character(len=char_len_long) :: & - warning ! warning message - - !------------------------------------------------------------------- - ! initialize - !------------------------------------------------------------------- - aerosno (:,:) = c0 - aerosno0(:,:) = c0 - aero_cons(:) = c0 - zbgc_snow(:) = c0 - zbgc_atm(:) = c0 - - hs_old = vsno_old/aice_old - if (aice_old .gt. puny) then - hs_old = vsno_old/aice_old - else - hs_old = c0 - end if - hslyr_old = hs_old/real(nslyr,kind=dbl_kind) - - dzssl = min(hslyr_old/c2, hs_ssl) - dzint = hs_old - dzssl - - if (aicen > c0) then - ar = c1/aicen - hs = vsnon*ar - hi = vicen*ar - else ! ice disappeared during time step - ar = c1 - hs = c0 - hi = c0 - if (aice_old > c0) hs = vsnon/aice_old - endif - hilyr = hi/real(nblyr,kind=dbl_kind) - hslyr = hs/real(nslyr,kind=dbl_kind) - dzssl_new = min(hslyr/c2, hs_ssl) - dhs_melts = -melts - dhs_snoice = snoice*rhoi/rhos - dhs_evap = hs - (hs_old + dhs_melts - dhs_snoice & - + fsnow/rhos*dt) - - ! trcrn() has units kg/m^3 - - if (dzssl_new .lt. hs_ssl_min) then ! Put atm BC/dust flux directly into the sea ice - do k=1,nbtrcr - flux_bio_o(k) = flux_bio(k) - if (hilyr .lt. hs_ssl_min) then - flux_bio(k) = flux_bio(k) + & - (trcrn(bio_index(k)+ nblyr+1)*dzssl+ & - trcrn(bio_index(k)+ nblyr+2)*dzint)/dt - flux_bio(k) = flux_bio(k) + flux_bio_atm(k) - else - zbgc_snow(k) = zbgc_snow(k) + & - (trcrn(bio_index(k)+ nblyr+1)*dzssl+ & - trcrn(bio_index(k)+ nblyr+2)*dzint) - zbgc_atm(k) = zbgc_atm(k) & - + flux_bio_atm(k)*dt - end if - trcrn(bio_index(k) + nblyr+1) = c0 - trcrn(bio_index(k) + nblyr+2) = c0 - enddo - - else - - do k=1,nbtrcr - flux_bio_o(k) = flux_bio(k) - aerosno (k,1) = trcrn(bio_index(k)+ nblyr+1) * dzssl - aerosno (k,2) = trcrn(bio_index(k)+ nblyr+2) * dzint - aerosno0(k,:) = aerosno(k,:) - aerotot0(k) = aerosno(k,2) + aerosno(k,1) - enddo - - !------------------------------------------------------------------- - ! evaporation - !------------------------------------------------------------------- - dzint = dzint + min(dzssl + dhs_evap, c0) - dzssl = max(dzssl + dhs_evap, c0) - if (dzssl <= puny) then - do k = 1,nbtrcr - aerosno(k,2) = aerosno(k,2) + aerosno(k,1) - aerosno(k,1) = c0 - end do - end if - if (dzint <= puny) then - do k = 1,nbtrcr - zbgc_snow(k) = zbgc_snow(k) + (aerosno(k,2) + aerosno(k,1)) - aerosno(k,2) = c0 - aerosno(k,1) = c0 - end do - end if - !------------------------------------------------------------------ - ! snowfall - !------------------------------------------------------------------- - if (fsnow > c0) then - sloss1 = c0 - dz = min(fsnow/rhos*dt,dzssl) - do k = 1, nbtrcr - if (dzssl > puny) & - sloss1 = aerosno(k,1)*dz/dzssl - aerosno(k,1) = max(c0,aerosno(k,1) - sloss1) - aerosno(k,2) = aerosno(k,2) + sloss1 - end do - dzssl = dzssl - dz + fsnow/rhos*dt - dzint = dzint + dz - end if - - if (dzssl <= puny) then - do k = 1,nbtrcr - aerosno(k,2) = aerosno(k,2) + aerosno(k,1) - aerosno(k,1) = c0 - end do - end if - if (dzint <= puny) then - do k = 1,nbtrcr - zbgc_snow(k) = zbgc_snow(k) + (aerosno(k,2) + aerosno(k,1)) - aerosno(k,2) = c0 - aerosno(k,1) = c0 - end do - end if - !------------------------------------------------------------------- - ! surface snow melt - !------------------------------------------------------------------- - if (-dhs_melts > puny) then - do k = 1, nbtrcr - sloss1 = c0 - sloss2 = c0 - if (dzssl > puny) & - sloss1 = kscavz(bio_index_o(k))*aerosno(k,1) & - *min(-dhs_melts,dzssl)/dzssl - aerosno(k,1) = max(c0,aerosno(k,1) - sloss1) - if (dzint > puny) & - sloss2 = kscavz(bio_index_o(k))*aerosno(k,2) & - *max(-dhs_melts-dzssl,c0)/dzint - aerosno(k,2) = max(c0,aerosno(k,2) - sloss2) - zbgc_snow(k) = zbgc_snow(k) + (sloss1+sloss2) ! all not scavenged ends in ice - enddo - - ! update snow thickness - dzint=dzint+min(dzssl+dhs_melts, c0) - dzssl=max(dzssl+dhs_melts, c0) - - if ( dzssl .le. puny ) then ! ssl melts away - do k = 1,nbtrcr - aerosno(k,2) = aerosno(k,1) + aerosno(k,2) - aerosno(k,1) = c0 - end do - dzssl = max(dzssl, c0) - endif - if (dzint .le. puny ) then ! all snow melts away - do k = 1,nbtrcr - zbgc_snow(k) = zbgc_snow(k) & - + aerosno(k,1) + aerosno(k,2) - aerosno(k,:) = c0 - enddo - dzint = max(dzint, c0) - endif - endif ! -dhs_melts > puny - !------------------------------------------------------------------- - ! snow-ice formation - !------------------------------------------------------------------- - if (dhs_snoice > puny) then - do k = 1, nbtrcr - sloss1 = c0 - sloss2 = c0 - if (dzint > puny .and. aerosno(k,2) > c0) & - sloss2 = min(dhs_snoice, dzint) & - *aerosno(k,2)/dzint - aerosno(k,2) = max(c0,aerosno(k,2) - sloss2) - if (dzssl > puny .and. aerosno(k,1) > c0) & - sloss1 = max(dhs_snoice-dzint, c0) & - *aerosno(k,1)/dzssl - - aerosno(k,1) = max(c0,aerosno(k,1) - sloss1) - flux_bio(k) = flux_bio(k) & - + kscavz(bio_index_o(k)) * (sloss2+sloss1)/dt - zbgc_snow(k) = zbgc_snow(k) & - + (c1-kscavz(bio_index_o(k)))*(sloss2+sloss1) - enddo - dzssl = max(c0,dzssl - max(dhs_snoice-dzint, c0)) - dzint = max(dzint-dhs_snoice, c0) - endif ! dhs_snowice > puny - - !------------------------------------------------------------------- - ! aerosol deposition - !------------------------------------------------------------------- - ! if (aicen > c0) then - ! hs = vsnon * ar - ! else - ! hs = c0 - ! endif - ! Spread out the atm dust flux in the snow interior for small snow surface layers - if (dzssl .ge. hs_ssl*p5) then - - do k=1,nbtrcr - aerosno(k,1) = aerosno(k,1) & - + flux_bio_atm(k)*dt - enddo - else - dz = (hs_ssl*p5 - dzssl)/(hs_ssl*p5) - do k=1,nbtrcr - aerosno(k,1) = aerosno(k,1) & - + flux_bio_atm(k)*dt*(c1-dz) - aerosno(k,2) = aerosno(k,2) & - + flux_bio_atm(k)*dt*dz - enddo - endif - - !------------------------------------------------------------------- - ! redistribute aerosol within vertical layers - !------------------------------------------------------------------- - if (aicen > c0) then - hs = vsnon * ar ! new snow thickness - else - hs = c0 - endif - if (dzssl <= puny) then ! nothing in SSL - do k=1,nbtrcr - aerosno(k,2) = aerosno(k,2) + aerosno(k,1) - aerosno(k,1) = c0 - enddo - endif - if (dzint <= puny) then ! nothing in Snow Int - do k = 1, nbtrcr - zbgc_snow(k) = zbgc_snow(k) + max(c0,aerosno(k,2)+aerosno(k,1)) - aerosno(k,1) = c0 - aerosno(k,2) = c0 - enddo - endif - - hslyr = hs/real(nslyr,kind=dbl_kind) - dzssl_new = min(hslyr/c2, hs_ssl) - dzint_new = max(c0,hs - dzssl_new) - - if (hs > hs_min) then - do k = 1, nbtrcr - dznew = min(dzssl_new-dzssl, c0) - sloss1 = c0 - if (dzssl > puny .and. aerosno(k,1) > c0) & - sloss1 = dznew*aerosno(k,1)/dzssl ! not neccesarily a loss - dznew = max(dzssl_new-dzssl, c0) - if (dzint > puny .and. aerosno(k,2) > c0) & - sloss1 = aerosno(k,2)*dznew/dzint - aerosno(k,1) = max(c0,aerosno(k,1) + sloss1) - aerosno(k,2) = max(c0,aerosno(k,2) - sloss1) - enddo - else - zbgc_snow(:) = zbgc_snow(:) & - + aerosno(:,1) + aerosno(:,2) - aerosno(:,:) = c0 - endif - - !------------------------------------------------------------------- - ! check conservation - !------------------------------------------------------------------- - do k = 1, nbtrcr - aerotot(k) = aerosno(k,2) + aerosno(k,1) & - + zbgc_snow(k) + zbgc_atm(k) - aero_cons(k) = aerotot(k)-aerotot0(k) & - - ( flux_bio_atm(k) & - - (flux_bio(k)-flux_bio_o(k))) * dt - if (aerotot0(k) > aerotot(k) .and. aerotot0(k) > c0) then - aero_cons(k) = aero_cons(k)/aerotot0(k) - else if (aerotot(k) > c0) then - aero_cons(k) = aero_cons(k)/aerotot(k) - end if - - if (aero_cons(k) > puny .or. zbgc_snow(k) + zbgc_atm(k) < c0) then - write(warning,*) 'Conservation failure: aerosols in snow' - call add_warning(warning) - write(warning,*) 'test aerosol 1' - call add_warning(warning) - write(warning,*) 'aerosol tracer: ',k - call add_warning(warning) - write(warning,*) 'aero_cons(k),puny:', aero_cons(k),puny - call add_warning(warning) - write(warning,*) 'aerotot,aerotot0 ',aerotot(k),aerotot0(k) - call add_warning(warning) - write(warning,*) ' aerosno(k,2),aerosno(k,1) ', aerosno(k,2),aerosno(k,1) - call add_warning(warning) - write(warning,*) 'flux_bio_atm(k)*aicen*dt', & - flux_bio_atm(k)*aicen*dt - call add_warning(warning) - write(warning,*) 'zbgc_snow(k)', & - zbgc_snow(k) - call add_warning(warning) - write(warning,*) 'zbgc_atm(k)', & - zbgc_atm(k) - call add_warning(warning) - endif - enddo - - !------------------------------------------------------------------- - ! reload tracers - !------------------------------------------------------------------- - if (dzssl_new > puny .and. dzint_new > puny .and. vsnon > puny) then - do k = 1,nbtrcr - trcrn(bio_index(k)+nblyr+1)=aerosno(k,1)/dzssl_new - trcrn(bio_index(k)+nblyr+2)=aerosno(k,2)/dzint_new - enddo - else - do k = 1,nbtrcr - trcrn(bio_index(k)+nblyr+1)= c0 - trcrn(bio_index(k)+nblyr+2)= c0 - enddo - endif - !------------------------------------------------------------------- - ! check for negative values - !------------------------------------------------------------------- - if (minval(aerosno(:,1)) < -puny .or. & - minval(aerosno(:,2)) < -puny) then - - write(warning,*) 'Snow aerosol negative in update_snow_bgc' - call add_warning(warning) - write(warning,*) 'aicen= ' ,aicen - call add_warning(warning) - write(warning,*) 'vicen= ' ,vicen - call add_warning(warning) - write(warning,*) 'vsnon= ' ,vsnon - call add_warning(warning) - write(warning,*) 'viceold= ' ,vice_old - call add_warning(warning) - write(warning,*) 'vsnoold= ' ,vsno_old - call add_warning(warning) - write(warning,*) 'melts= ' ,melts - call add_warning(warning) - write(warning,*) 'meltt= ' ,meltt - call add_warning(warning) - write(warning,*) 'meltb= ' ,meltb - call add_warning(warning) - write(warning,*) 'congel= ' ,congel - call add_warning(warning) - write(warning,*) 'snoice= ' ,snoice - call add_warning(warning) - write(warning,*) 'aero evap snow= ' ,dhs_evap - call add_warning(warning) - write(warning,*) 'fsnow= ' ,fsnow - call add_warning(warning) - do k = 1, nbtrcr - write(warning,*) 'NBTRCR value k = ', k - call add_warning(warning) - write(warning,*) 'aero snowssl (k)= ' ,aerosno0(k,1) - call add_warning(warning) - write(warning,*) 'aero new snowssl (k)= ',aerosno(k,1) - call add_warning(warning) - write(warning,*) 'aero snowint (k)= ' ,aerosno0(k,2) - call add_warning(warning) - write(warning,*) 'aero new snowint(k)= ',aerosno(k,2) - call add_warning(warning) - write(warning,*) 'flux_bio_atm(k)= ' , flux_bio_atm(k) - call add_warning(warning) - write(warning,*) 'zbgc_snow(k)= ' ,zbgc_snow(k) - call add_warning(warning) - write(warning,*) 'zbgc_atm(k)= ' ,zbgc_atm(k) - call add_warning(warning) - - do n = 1,2 - trcrn(bio_index(k)+nblyr+n)=max(trcrn(bio_index(k)+nblyr+n), c0) - enddo - enddo - endif - endif - - end subroutine update_snow_bgc - -!======================================================================= - - end module ice_aerosol - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_age.F90 b/components/mpas-seaice/src/column/ice_age.F90 deleted file mode 100644 index 7e5e602161d7..000000000000 --- a/components/mpas-seaice/src/column/ice_age.F90 +++ /dev/null @@ -1,40 +0,0 @@ -! SVN:$Id: ice_age.F90 1012 2015-06-26 12:34:09Z eclare $ -!======================================================================= -! -! authors Elizabeth Hunke - - module ice_age - - use ice_kinds_mod - - implicit none - - private - public :: increment_age - -!======================================================================= - - contains - -!======================================================================= - -! Increase ice age tracer by timestep length. - - subroutine increment_age (dt, iage) - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), & - intent(inout) :: & - iage - - iage = iage + dt - - end subroutine increment_age - -!======================================================================= - - end module ice_age - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_algae.F90 b/components/mpas-seaice/src/column/ice_algae.F90 deleted file mode 100644 index e65dbed667ec..000000000000 --- a/components/mpas-seaice/src/column/ice_algae.F90 +++ /dev/null @@ -1,3125 +0,0 @@ -! SVN:$Id: ice_algae.F90 1183 2017-03-16 19:50:34Z njeffery $ -!======================================================================= -! -! Compute sea ice biogeochemistry (vertical or skeletal layer) -! -! authors: Nicole Jeffery, LANL -! Scott Elliot, LANL -! Elizabeth C. Hunke, LANL -! - module ice_algae - - use ice_kinds_mod - use ice_zbgc_shared - use ice_warnings, only: add_warning - - implicit none - - private - public :: zbio, sklbio - - save - -!======================================================================= - - contains - -!======================================================================= - - subroutine zbio (dt, nblyr, & - nslyr, nilyr, & - meltt, melts, & - meltb, congel, & - snoice, nbtrcr, & - fsnow, ntrcr, & - trcrn, bio_index, & - bio_index_o, aice_old, & - vice_old, vsno_old, & - vicen, vsnon, & - aicen, flux_bio_atm,& - n_cat, n_algae, & - n_doc, n_dic, & - n_don, & - n_fed, n_fep, & - n_zaero, first_ice, & - hice_old, ocean_bio, & - bphin, iphin, & - iDin, sss, & - fswthrul, & - dh_top, dh_bot, & - dh_top_chl, dh_bot_chl, & - zfswin, & - hbri, hbri_old, & - darcy_V, darcy_V_chl, & - bgrid, cgrid, & - igrid, icgrid, & - bphi_min, & - dhice, iTin, & - Zoo, & - flux_bio, dh_direct, & - upNO, upNH, & - fbio_snoice, fbio_atmice, & - PP_net, ice_bio_net, & - snow_bio_net, grow_net, & - totalChla, & - flux_bion, iSin, & - bioPorosityIceCell, & - bioSalinityIceCell, & - bioTemperatureIceCell, & - l_stop, stop_label) - - use ice_aerosol, only: update_snow_bgc - use ice_constants_colpkg, only: c0, c1, puny, p5 - use ice_zbgc, only: merge_bgc_fluxes - - integer (kind=int_kind), intent(in) :: & - nblyr, & ! number of bio layers - nslyr, & ! number of snow layers - nilyr, & ! number of ice layers - nbtrcr, & ! number of distinct bio tracers - n_cat, & ! category number - n_algae, & ! number of autotrophs - n_zaero, & ! number of aerosols - n_doc, n_dic, n_don, n_fed, n_fep, & - ntrcr ! number of tracers - - integer (kind=int_kind), dimension (nbtrcr), intent(in) :: & - bio_index, & ! references index of bio tracer (nbtrcr) to tracer array (ntrcr) - bio_index_o ! references index of data arrays (eg. kscavz) - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step - hbri, & ! brine height (m) - dhice, & ! change due to sublimation/condensation (m) - bphi_min, & ! surface porosity - meltt, & ! thermodynamic melt/growth rates in dt (m) - melts, & - meltb, & - congel, & - snoice, & - fsnow, & ! snowfall rate (kg/m^2 s) - sss, & ! ocean salinity (ppt) - hice_old, & ! ice height (m) - vicen, & ! ice volume (m) - vsnon, & ! snow volume (m) - aicen, & ! ice area fraction - aice_old, & ! values prior to thermodynamic changes - vice_old, & - vsno_old, & - darcy_V, & ! darcy velocity - darcy_V_chl,& ! darcy velocity for algae - dh_bot, & ! change in brine bottom (m) - dh_bot_chl, & ! change in brine bottom (m) felt by algae - dh_top, & ! change in brine top (m) - dh_top_chl, & ! change in brine top (m) felt by algae - dh_direct ! surface flooding or surface runoff (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - snow_bio_net,& ! net bio tracer in snow (mmol/m^2) - ice_bio_net, & ! net bio tracer in ice (mmol/m^2) - fbio_atmice, & ! bio flux from atm to ice (mmol/m^2/s) - fbio_snoice, & ! bio flux from snow to ice (mmol/m^2/s) - flux_bio, & ! total ocean tracer flux (mmol/m^2/s) - flux_bion ! category ocean tracer flux (mmol/m^2/s) - - real (kind=dbl_kind), intent(in) :: & - hbri_old ! brine height (m) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid , & ! biology vertical interface points - iTin , & ! Temperature vertical interface points - iphin , & ! Porosity on the igrid - iDin , & ! Diffusivity/h on the igrid (1/s) - iSin ! Salinity on vertical interface points (ppt) - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid , & ! CICE vertical coordinate - icgrid , & ! CICE interface coordinate - fswthrul ! visible short wave radiation on icgrid (W/m^2) - - real (kind=dbl_kind), dimension(:), & - intent(in) :: & - flux_bio_atm ! aerosol/bgc deposition rate (mmol/m^2 s) - - real (kind=dbl_kind), dimension(ntrcr), & - intent(inout) :: & - trcrn - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - zfswin ! visible Short wave flux on igrid (W/m^2) - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - Zoo ! N losses to the system from reaction terms - ! (ie. zooplankton/bacteria) (mmol/m^3) - - real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: & - !change to inout when updating ocean fields - ocean_bio ! ocean concentrations (mmol/m^3) - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bphin ! Porosity on the bgrid - - real (kind=dbl_kind), intent(inout):: & - PP_net , & ! net PP (mg C/m^2/d) times aice - grow_net , & ! net specific growth (m/d) times vice - upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice - upNH , & ! tot ammonium uptake rate (mmol/m^2/d) times aice - totalChla ! total chla (mg chla/m^2) - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout):: & ! diagnostics - bioPorosityIceCell , & ! porosity on vertical interface points - bioSalinityIceCell , & ! salinity on vertical interface points (ppt) - bioTemperatureIceCell ! temperature on vertical interface points (oC) - - logical (kind=log_kind), intent(in) :: & - first_ice ! initialized values should be used - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k , & ! vertical index - n, mm ! thickness category index - - real (kind=dbl_kind), dimension (nblyr+1,n_algae) :: & - upNOn , & ! algal nitrate uptake rate (mmol/m^3/s) - upNHn , & ! algal ammonium uptake rate (mmol/m^3/s) - grow_alg ! algal growth rate (mmol/m^3/s) - - real (kind=dbl_kind),dimension(nbtrcr) :: & - zbgc_snown, & ! aerosol contribution from snow to ice - zbgc_atmn ! and atm to ice concentration * volume (mmol/m^3*m) - - real (kind=dbl_kind), dimension(nbtrcr) :: & - Tot_BGC_i, & ! initial column sum, ice + snow, of BGC tracer (mmol/m^2) - Tot_BGC_f, & ! final column sum - flux_bio_sno ! - - real (kind=dbl_kind) :: & - Tot_Nit, & ! - hsnow_i, & ! initial snow thickness (m) - hsnow_f, & ! final snow thickness (m) - carbonError ! carbon conservation error (mmol/m2) - - real (kind=dbl_kind) :: & - carbonInitial, & ! initial carbon content (mmol/m2) - carbonFinal, & ! final carbon content (mmol/m2) - carbonFlux ! carbon flux (mmol/m2/s) - - logical (kind=log_kind) :: & - write_flux_diag - - real (kind=dbl_kind) :: & - a_ice - - real (kind=dbl_kind), parameter :: & - accuracy = 1.0e-13_dbl_kind - - character(len=char_len_long) :: & - warning - - real (kind=dbl_kind), dimension (nblyr+1) :: & - zspace ! vertical grid spacing - - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5*zspace(1) - zspace(nblyr+1) = p5*zspace(nblyr+1) - - zbgc_snown(:) = c0 - zbgc_atmn (:) = c0 - flux_bion (:) = c0 - flux_bio_sno(:) = c0 - Tot_BGC_i (:) = c0 - Tot_BGC_f (:) = c0 - Zoo (:) = c0 - hsnow_i = c0 - hsnow_f = c0 - write_flux_diag = .false. - - call bgc_carbon_sum(nblyr, hbri_old, trcrn(:), carbonInitial,n_doc,n_dic,n_algae,n_don) - - if (aice_old > puny) then - hsnow_i = vsno_old/aice_old - do mm = 1,nbtrcr - call bgc_column_sum (nblyr, nslyr, hsnow_i, hbri_old, & - trcrn(bio_index(mm):bio_index(mm)+nblyr+2), & - Tot_BGC_i(mm)) - enddo - endif - - call update_snow_bgc (dt, nblyr, & - nslyr, & - meltt, melts, & - meltb, congel, & - snoice, nbtrcr, & - fsnow, ntrcr, & - trcrn, bio_index, & - aice_old, zbgc_snown, & - vice_old, vsno_old, & - vicen, vsnon, & - aicen, flux_bio_atm, & - zbgc_atmn, flux_bio_sno, & - bio_index_o) - - call z_biogeochemistry (n_cat, dt, & - nilyr, nslyr, & - nblyr, nbtrcr, & - n_algae, n_doc, & - n_dic, n_don, & - n_fed, n_fep, & - n_zaero, first_ice, & - aicen, vicen, & - hice_old, ocean_bio, & - flux_bion, bphin, & - iphin, trcrn, & - iDin, sss, & - fswthrul, grow_alg, & - upNOn, upNHn, & - dh_top, dh_bot, & - dh_top_chl, dh_bot_chl,& - zfswin, hbri, & - hbri_old, darcy_V, & - darcy_V_chl, bgrid, & - igrid, icgrid, & - bphi_min, zbgc_snown,& - dhice, zbgc_atmn, & - iTin, dh_direct, & - Zoo, meltb, & - congel, l_stop, & - stop_label) - - do mm = 1,nbtrcr - flux_bion(mm) = flux_bion(mm) + flux_bio_sno(mm) - enddo - - call bgc_carbon_sum(nblyr, hbri, trcrn(:), carbonFinal,n_doc,n_dic,n_algae,n_don) - call bgc_carbon_flux(flux_bio_atm,flux_bion,n_doc,n_dic,n_algae,n_don,carbonFlux) - - carbonError = carbonInitial-carbonFlux*dt-carbonFinal - - if (abs(carbonError) > max(puny,accuracy * maxval ((/carbonInitial, carbonFinal/)))) then - write(warning,*) 'carbonError:', carbonError - call add_warning(warning) - write(warning,*) 'carbonInitial:', carbonInitial - call add_warning(warning) - write(warning,*) 'carbonFinal:', carbonFinal - call add_warning(warning) - write(warning,*) 'carbonFlux (positive into ocean):', carbonFlux - call add_warning(warning) - write(warning,*) 'accuracy * maxval ((/carbonInitial, carbonFinal/:)', accuracy * maxval ((/carbonInitial, carbonFinal/)) - call add_warning(warning) - write(warning,*) 'puny', puny - call add_warning(warning) - if (aicen > c0) then - hsnow_f = vsnon/aicen - write(warning,*) 'after z_biogeochemistry' - call add_warning(warning) - write(warning,*) 'Remaining carbon after algal_dyn: Zoo' - call add_warning(warning) - do mm = 1,nblyr+1 - write(warning,*) 'layer mm, Zoo(mm)' - call add_warning(warning) - write(warning,*) mm,Zoo(mm) - call add_warning(warning) - end do - do mm = 1,nbtrcr - call bgc_column_sum (nblyr, nslyr, hsnow_f, hbri, & - trcrn(bio_index(mm):bio_index(mm)+nblyr+2), & - Tot_BGC_f(mm)) - write(warning,*) 'mm, Tot_BGC_i(mm), Tot_BGC_f(mm)' - call add_warning(warning) - write(warning,*) mm, Tot_BGC_i(mm), Tot_BGC_f(mm) - call add_warning(warning) - write(warning,*) 'flux_bion(mm), flux_bio_atm(mm)' - call add_warning(warning) - write(warning,*) flux_bion(mm), flux_bio_atm(mm) - call add_warning(warning) - write(warning,*) 'zbgc_snown(mm),zbgc_atmn(mm)' - call add_warning(warning) - write(warning,*) zbgc_snown(mm),zbgc_atmn(mm) - call add_warning(warning) - write(warning,*) 'Tot_BGC_i(mm) + flux_bio_atm(mm)*dt - flux_bion(mm)*dt' - call add_warning(warning) - write(warning,*) Tot_BGC_i(mm) + flux_bio_atm(mm)*dt - flux_bion(mm)*dt - call add_warning(warning) - write(warning,*) 'hbri, hbri_old' - call add_warning(warning) - write(warning,*) hbri, hbri_old - call add_warning(warning) - l_stop = .true. - stop_label = "carbon conservation in ice_algae.F90" - enddo - endif - endif - - if (l_stop) return - - call merge_bgc_fluxes (dt, nblyr, & - bio_index, n_algae, & - nbtrcr, aicen, & - vicen, vsnon, & - ntrcr, iphin, & - trcrn, aice_old, & - flux_bion, flux_bio, & - upNOn, upNHn, & - upNO, upNH, & - zbgc_snown, zbgc_atmn, & - fbio_snoice, fbio_atmice,& - PP_net, ice_bio_net,& - snow_bio_net, grow_alg, & - grow_net, totalChla, & - nslyr, iTin, & - iSin, & - bioPorosityIceCell, & - bioSalinityIceCell, & - bioTemperatureIceCell) - - if (write_flux_diag) then - if (aicen > c0) then - if (n_cat .eq. 1) a_ice = c0 - a_ice = a_ice + aicen - write(warning,*) 'after merge_bgc_fluxes, n_cat:', n_cat - call add_warning(warning) - do mm = 1,nbtrcr - write(warning,*) 'mm, flux_bio(mm):',mm,flux_bio(mm) - call add_warning(warning) - write(warning,*) 'fbio_snoice(mm)',fbio_snoice(mm) - call add_warning(warning) - write(warning,*) 'fbio_atmice(mm)',fbio_atmice(mm) - call add_warning(warning) - write(warning,*) 'flux_bio_atm(mm)', flux_bio_atm(mm) - call add_warning(warning) - write(warning,*) 'flux_bio_atm(mm)*a_ice', flux_bio_atm(mm)*a_ice - call add_warning(warning) - enddo - endif - endif - - end subroutine zbio - -!======================================================================= - - subroutine sklbio (dt, Tf, & - ntrcr, nilyr, & - nbtrcr, n_algae, & - n_zaero, n_doc, & - n_dic, n_don, & - n_fed, n_fep, & - flux_bio, ocean_bio, & - hmix, aicen, & - meltb, congel, & - fswthru, first_ice, & - trcrn, hin, & - PP_net, upNO, & - upNH, grow_net, & - totalChla, & - l_stop, stop_label) - - use ice_zbgc, only: merge_bgc_fluxes_skl - use ice_colpkg_tracers, only: nt_bgc_N - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nbtrcr, & ! number of distinct bio tracers - n_algae, & ! number of autotrophs - n_zaero, & ! number of z aerosols - n_doc, n_dic, & ! number of dissolved organic, inorganic carbon - n_don, & ! number of dissolved organic nitrogen - n_fed, n_fep, & ! number of iron - ntrcr ! number of tracers - - logical (kind=log_kind), intent(in) :: & - first_ice ! initialized values should be used - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step - Tf, & ! basal freezing temperature (C) - hmix, & ! mixed layer depth (m) - aicen, & ! ice area fraction - meltb, & ! bottom melt (m) - congel, & ! bottom growth (m) - fswthru, & ! visible shortwave passing to ocean(W/m^2) - hin ! ice thickness (m) - - real (kind=dbl_kind), dimension(ntrcr), intent(inout) :: & - trcrn ! bulk concentration per m^3 - - real (kind=dbl_kind), dimension (nbtrcr), intent(inout) :: & - flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean - - real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: & - ocean_bio ! ocean tracer concentration (mmol/m^3) - - ! history output - real (kind=dbl_kind), intent(inout):: & - PP_net , & ! Bulk net PP (mg C/m^2/s) - grow_net, & ! net specific growth (/s) - upNO , & ! tot nitrate uptake rate (mmol/m^2/s) - upNH , & ! tot ammonium uptake rate (mmol/m^2/s) - totalChla ! total Chla (mg chla/m^2) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(out) :: stop_label - - ! local variables - - real (kind=dbl_kind), dimension (n_algae) :: & - upNOn , & ! algal nitrate uptake rate (mmol/m^3/s) - upNHn , & ! algal ammonium uptake rate (mmol/m^3/s) - grow_alg ! algal growth rate (mmol/m^3/s) - - real (kind=dbl_kind), dimension (nbtrcr) :: & - flux_bion !tracer flux to ocean - - character(len=char_len_long) :: & - warning ! warning message - - call skl_biogeochemistry (dt, nilyr, & - n_zaero, n_doc, & - n_dic, n_don, & - n_fed, n_fep, & - nbtrcr, n_algae, & - flux_bion, ocean_bio, & - hmix, aicen, & - meltb, congel, & - fswthru, first_ice, & - trcrn, upNOn, & - upNHn, grow_alg, & - hin, Tf, & - l_stop, stop_label) - - if (l_stop) return - - call merge_bgc_fluxes_skl (ntrcr, & - nbtrcr, n_algae, & - aicen, trcrn, & - flux_bion, flux_bio, & - PP_net, upNOn, & - upNHn, upNO, & - upNH, grow_net, & - grow_alg, totalChla) - - end subroutine sklbio - -!======================================================================= -! -! skeletal layer biochemistry -! - subroutine skl_biogeochemistry (dt, nilyr, & - n_zaero, n_doc, & - n_dic, n_don, & - n_fed, n_fep, & - nbtrcr, n_algae, & - flux_bio, ocean_bio, & - hmix, aicen, & - meltb, congel, & - fswthru, first_ice, & - trcrn, upNOn, & - upNHn, grow_alg_skl, & - hin, Tf, & - l_stop, stop_label) - - use ice_constants_colpkg, only: p5, p05, p1, c1, c0, puny, c10, sk_l - use ice_colpkg_tracers, only: nt_bgc_N, ntrcr, bio_index - use ice_colpkg_shared, only: dEdd_algae, bgc_flux_type, R_chl2N - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - n_zaero, n_doc, n_dic, n_don, n_fed, n_fep, & - nbtrcr , n_algae ! number of bgc tracers and number algae - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - hin , & ! ice thickness (m) - hmix , & ! mixed layer depth - aicen , & ! ice area - meltb , & ! bottom ice melt - congel , & ! bottom ice growth - Tf , & ! bottom freezing temperature - fswthru ! shortwave passing through ice to ocean - - logical (kind=log_kind), intent(in) :: & - first_ice ! initialized values should be used - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - trcrn ! bulk concentration per m^3 - - ! history variables - - real (kind=dbl_kind), dimension (:), intent(out) :: & - flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean - - real (kind=dbl_kind), dimension (:), intent(in) :: & - ocean_bio ! ocean tracer concentration (mmol/m^3) - - real (kind=dbl_kind), dimension (:), intent(out) :: & - grow_alg_skl, & ! tot algal growth rate (mmol/m^3/s) - upNOn , & ! algal NO uptake rate (mmol/m^3/s) - upNHn ! algal NH uptake rate (mmol/m^3/s) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: nn, mm - - real (kind=dbl_kind), dimension(nbtrcr):: & - react , & ! biological sources and sinks (mmol/m^3) - cinit , & ! initial brine concentration*sk_l (mmol/m^2) - cinit_v , & ! initial brine concentration (mmol/m^3) - congel_alg , & ! congelation flux contribution to ice algae (mmol/m^2 s) - ! (used as initialization) - f_meltn , & ! vertical melt fraction of skeletal layer in dt - flux_bio_temp, & ! tracer flux to ocean (mmol/m^2 s) - PVflag , & ! 1 for tracers that flow with the brine, 0 otherwise - cling ! 1 for tracers that cling, 0 otherwise - - real (kind=dbl_kind) :: & - Zoo_skl , & ! N losses from zooplankton/bacteria ... (mmol/m^3) - iTin , & - PVt , & ! type 'Jin2006' piston velocity (m/s) - ice_growth , & ! Jin2006 definition: either congel rate or bottom melt rate (m/s) - grow_val , & ! (m/x) - rphi_sk , & ! 1 / skeletal layer porosity - cinit_tmp , & ! temporary variable for concentration (mmol/m^2) - Cerror , & ! change in total carbon from reactions (mmol/m^3) - nitrification ! nitrate from nitrification (mmol/m^3) - - real (kind=dbl_kind), parameter :: & - PVc = 1.e-6_dbl_kind , & ! type 'constant' piston velocity for interface (m/s) - PV_scale_growth = p5 , & ! scale factor in Jin code PV during ice growth - PV_scale_melt = p05 , & ! scale factor in Jin code PV during ice melt - growth_max = 1.85e-10_dbl_kind , & ! PVt function reaches maximum here. (m/s) - MJ1 = 9.667e-9_dbl_kind , & ! (m/s) coefficients in Jin2008 - MJ2 = 38.8_dbl_kind , & ! (1) from:4.49e-4_dbl_kind*secday - MJ3 = 1.04e7_dbl_kind , & ! 1/(m/s) from: 1.39e-3_dbl_kind*secday^2 - PV_frac_max = 0.9_dbl_kind ! Maximum Piston velocity is 90% of skeletal layer/dt - - logical (kind=log_kind) :: conserve_C - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - conserve_C = .true. - Zoo_skl = c0 - rphi_sk = c1/phi_sk - PVt = c0 - iTin = Tf - - do nn = 1, nbtrcr - cinit (nn) = c0 - cinit_v (nn) = c0 - congel_alg(nn) = c0 - f_meltn (nn) = c0 - react (nn) = c0 - PVflag (nn) = c1 - cling (nn) = c0 - nitrification = c0 - - !----------------------------------------------------------------- - ! only the dominant tracer_type affects behavior - ! < 0 is purely mobile: > 0 stationary behavior - ! NOTE: retention times are not used in skl model - !----------------------------------------------------------------- - - if (bgc_tracer_type(nn) >= c0) then - PVflag(nn) = c0 - cling (nn) = c1 - endif - - ice_growth = (congel-meltb)/dt - cinit (nn) = trcrn(bio_index(nn)) * sk_l * rphi_sk - cinit_v(nn) = cinit(nn)/sk_l - if (cinit(nn) < c0) then - write(warning,*)'initial sk_bgc < 0, nn,nbtrcr,cinit(nn)', & - nn,nbtrcr,cinit(nn) - call add_warning(warning) - l_stop = .true. - stop_label = 'cinit < c0' - endif - enddo ! nbtrcr - - if (l_stop) return - - if (trim(bgc_flux_type) == 'Jin2006') then - - !----------------------------------------------------------------- - ! 'Jin2006': - ! 1. congel/melt dependent piston velocity (PV) for growth and melt - ! 2. If congel > melt use 'congel'; if melt > congel use 'melt' - ! 3. For algal N, PV for ice growth only provides a seeding concentration - ! 4. Melt affects nutrients and algae in the same manner through PV(melt) - !----------------------------------------------------------------- - - if (ice_growth > c0) then ! ice_growth = congel/dt - grow_val = min(ice_growth,growth_max) - PVt = -min(abs(PV_scale_growth*(MJ1 + MJ2*grow_val & - - MJ3*grow_val**2)), & - PV_frac_max*sk_l/dt) - else ! ice_growth = -meltb/dt - PVt = min(abs(PV_scale_melt *( MJ2*ice_growth & - - MJ3*ice_growth**2)), & - PV_frac_max*sk_l/dt) - endif - do nn = 1, nbtrcr - if (bgc_tracer_type(nn) >= c0) then - if (ice_growth < c0) then ! flux from ice to ocean - ! Algae and clinging tracers melt like nutrients - f_meltn(nn) = PVt*cinit_v(nn) ! for algae only - elseif (ice_growth > c0 .AND. & - cinit(nn) < ocean_bio(nn)*sk_l/phi_sk) then - ! Growth only contributes to seeding from ocean - congel_alg(nn) = (ocean_bio(nn)*sk_l/phi_sk - cinit(nn))/dt - endif ! PVt > c0 - endif - enddo - - else ! bgc_flux_type = 'constant' - - !----------------------------------------------------------------- - ! 'constant': - ! 1. Constant PV for congel > melt - ! 2. For algae, PV for ice growth only provides a seeding concentration - ! 3. Melt loss (f_meltn) affects algae only and is proportional to melt - !----------------------------------------------------------------- - - if (ice_growth > c0) PVt = -PVc - do nn = 1, nbtrcr - if (bgc_tracer_type(nn) >= c0 ) then - if (ice_growth >= c0 .AND. cinit_v(nn) < ocean_bio(nn)/phi_sk) then - congel_alg(nn) = (ocean_bio(nn)*sk_l/phi_sk - cinit(nn))/dt - elseif (ice_growth < c0) then - f_meltn(nn) = min(c1, meltb/sk_l)*cinit(nn)/dt - endif - endif - enddo ! nn - - endif ! bgc_flux_type - - !----------------------------------------------------------------- - ! begin building biogeochemistry terms - !----------------------------------------------------------------- - - call algal_dyn (dt, & - n_zaero, n_doc, n_dic, n_don, n_fed, n_fep, & - dEdd_algae, & - fswthru, react, & - cinit_v, nbtrcr, & - grow_alg_skl, n_algae, & - iTin, & - upNOn, upNHn, & - Zoo_skl, & - Cerror, conserve_C,& - nitrification) - - !----------------------------------------------------------------- - ! compute new tracer concencentrations - !----------------------------------------------------------------- - - do nn = 1, nbtrcr - - !----------------------------------------------------------------- - ! if PVt > 0, ie melt, then ocean_bio term drops out (MJ2006) - ! Combine boundary fluxes - !----------------------------------------------------------------- - - PVflag(nn) = SIGN(PVflag(nn),PVt) - cinit_tmp = max(c0, cinit_v(nn) + react(nn)) - flux_bio_temp(nn) = (PVflag(nn)*PVt*cinit_tmp & - - PVflag(nn)*min(c0,PVt)*ocean_bio(nn)) & - + f_meltn(nn)*cling(nn) - congel_alg(nn) - - if (cinit_tmp*sk_l < flux_bio_temp(nn)*dt) then - flux_bio_temp(nn) = cinit_tmp*sk_l/dt*(c1-puny) - endif - - cinit(nn) = cinit_tmp*sk_l - flux_bio_temp(nn)*dt - flux_bio(nn) = flux_bio(nn) + flux_bio_temp(nn)*phi_sk - - ! Uncomment to update ocean concentration - ! Currently not coupled with ocean biogeochemistry -! ocean_bio(nn) = ocean_bio(nn) + flux_bio(nn)/hmix*aicen - - if (.not. conserve_C) then - write(warning,*) 'C not conserved in skl_bgc, Cerror:',Cerror - call add_warning(warning) - write(warning,*) 'sk_bgc < 0 after algal fluxes, nn,cinit,flux_bio',& - nn,cinit(nn),flux_bio(nn) - call add_warning(warning) - write(warning,*) 'cinit_tmp,flux_bio_temp,f_meltn,congel_alg,PVt,PVflag: ' - call add_warning(warning) - write(warning,*) cinit_tmp,flux_bio_temp(nn),f_meltn(nn), & - congel_alg(nn),PVt,PVflag(nn) - call add_warning(warning) - write(warning,*) 'congel, meltb: ',congel,meltb - call add_warning(warning) - l_stop = .true. - stop_label = 'N not conserved in skl_bgc' - elseif (cinit(nn) < c0) then - write(warning,*) 'sk_bgc < 0 after algal fluxes, nn,cinit,flux_bio',& - nn,cinit(nn),flux_bio(nn) - call add_warning(warning) - write(warning,*) 'cinit_tmp,flux_bio_temp,f_meltn,congel_alg,PVt,PVflag: ' - call add_warning(warning) - write(warning,*) cinit_tmp,flux_bio_temp(nn),f_meltn(nn), & - congel_alg(nn),PVt,PVflag(nn) - call add_warning(warning) - write(warning,*) 'congel, meltb: ',congel,meltb - call add_warning(warning) - l_stop = .true. - stop_label = 'sk_bgc < 0 after algal fluxes' - endif - - if (l_stop) return - - !----------------------------------------------------------------- - ! reload tracer array: Bulk tracer concentration (mmol or mg per m^3) - !----------------------------------------------------------------- - - trcrn(bio_index(nn)) = cinit(nn) * phi_sk/sk_l - - enddo !nbtrcr - - end subroutine skl_biogeochemistry - -!======================================================================= -! -! Solve the scalar vertical diffusion equation implicitly using -! tridiag_solver. Calculate the diffusivity from temperature and salinity. -! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with -! dynamic salinity or the height ratio == hinS/vicen*aicen, where hinS is the -! height of the brine surface relative to the bottom of the ice. This volume fraction -! may be > 1 in which case there is brine above the ice surface (meltponds). -! - - subroutine z_biogeochemistry (n_cat, dt, & - nilyr, nslyr, & - nblyr, nbtrcr, & - n_algae, n_doc, & - n_dic, n_don, & - n_fed, n_fep, & - n_zaero, first_ice, & - aicen, vicen, & - hice_old, ocean_bio, & - flux_bio, bphin, & - iphin, trcrn, & - iDin, sss, & - fswthrul, grow_alg, & - upNOn, upNHn, & - dh_top, dh_bot, & - dh_top_chl, dh_bot_chl,& - zfswin, hbri, & - hbri_old, darcy_V, & - darcy_V_chl, bgrid, & - i_grid, ic_grid, & - bphi_min, zbgc_snow, & - dhice, zbgc_atm, & - iTin, dh_direct, & - Zoo, meltb, & - congel, l_stop, & - stop_label) - - use ice_colpkg_tracers, only: nt_fbri, nt_zbgc_frac, & - ntrcr, nlt_bgc_Nit, tr_bgc_Fe, tr_zaero, & - nlt_bgc_Fed, nlt_zaero, bio_index, tr_bgc_N, & - nlt_bgc_N, tr_bgc_C, nlt_bgc_DIC - use ice_constants_colpkg, only: c0, c1, c2, p5, puny, pi, p1 - use ice_colpkg_shared, only: hi_ssl, dEdd_algae, solve_zbgc, & - R_dFe2dust, dustFe_sol, algal_vel - - integer (kind=int_kind), intent(in) :: & - n_cat, & ! category number - nilyr, & ! number of ice layers - nslyr, & ! number of snow layers - nblyr, & ! number of bio layers - nbtrcr, n_algae, & ! number of bgc tracers, number of autotrophs - n_zaero, & ! number of aerosols - n_doc, n_dic, n_don, n_fed, n_fep - - logical (kind=log_kind), intent(in) :: & - first_ice ! initialized values should be used - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - hbri , & ! brine height (m) - dhice , & ! change due to sublimation/condensation (m) - bphi_min , & ! surface porosity - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - sss , & ! ocean salinity (ppt) - hice_old , & ! ice height (m) - meltb , & ! bottom melt in dt (m) - congel , & ! bottom growth in dt (m) - darcy_V , & ! darcy velocity - darcy_V_chl, & ! darcy velocity for algae - dh_bot , & ! change in brine bottom (m) - dh_bot_chl , & ! change in brine bottom (m) felt by algae - dh_top , & ! change in brine top (m) - dh_top_chl , & ! change in brine top (m) felt by algae - dh_direct ! surface flooding or runoff (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - bgrid , & ! biology nondimensional vertical grid points - flux_bio , & ! total ocean tracer flux (mmol/m^2/s) - zfswin , & ! visible Short wave flux on igrid (W/m^2) - Zoo , & ! N losses to the system from reaction terms - ! (ie. zooplankton/bacteria) (mmol/m^3) - trcrn ! bulk tracer concentration (mmol/m^3) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - i_grid , & ! biology vertical interface points - iTin , & ! salinity vertical interface points - iphin , & ! Porosity on the igrid - iDin , & ! Diffusivity/h on the igrid (1/s) - ic_grid , & ! CICE interface coordinate - fswthrul , & ! visible short wave radiation on icgrid (W/m^2) - zbgc_snow , & ! tracer input from snow (mmol/m^3*m) - zbgc_atm , & ! tracer input from atm (mmol/m^3 *m) - ocean_bio , & ! ocean concentrations (mmol/m^3) - bphin ! Porosity on the bgrid - - real (kind=dbl_kind), intent(in) :: & - hbri_old ! brine height (m) - - real (kind=dbl_kind), dimension (:,:), intent(out) :: & - upNOn , & ! algal nitrate uptake rate (mmol/m^3/s) - upNHn , & ! algal ammonium uptake rate (mmol/m^3/s) - grow_alg ! algal growth rate (mmol/m^3/s) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(out) :: stop_label - - !----------------------------------------------------------------------------- - ! algae absorption coefficient for 0.5 m thick layer - ! Grenfell (1991): SA = specific absorption coefficient= 0.004 m^2/mg Chla - ! generalizing kalg_bio(k) = SA*\sum R_chl2N(m)*trcrn(i,j,nt_bgc_N(m)+k-1) - ! output kalg on the icgrid - !----------------------------------------------------------------------------- - - ! local variables - - integer (kind=int_kind) :: & - k, m, mm, nn ! vertical biology layer index - - real (kind=dbl_kind) :: & - hin , & ! ice thickness (m) - hin_old , & ! ice thickness before current melt/growth (m) - ice_conc , & ! algal concentration in ice above hin > hinS - sum_old , & ! - sum_new , & ! - sum_tot , & ! - sum_initial , & ! - zspace , & ! 1/nblyr - darcyV , & ! - dhtop , & ! - dhbot , & ! - dhmelt , & ! >=0 (m) melt contribution to surface brine height - dhrunoff , & ! >=0 (m) surface runoff to ocean - dhflood ! >=0 (m) surface flooding from the ocean - - real (kind=dbl_kind), dimension (nblyr+2) :: & - bphin_N ! porosity for tracer model has minimum - ! bphin_N >= bphimin - - real (kind=dbl_kind), dimension (nblyr+1) :: & - iphin_N , & ! tracer porosity on the igrid - sbdiagz , & ! sub-diagonal matrix elements - diagz , & ! diagonal matrix elements - spdiagz , & ! super-diagonal matrix elements - rhsz , & ! rhs of tri-diagonal matrix equation - ML_diag , & ! lumped mass matrix - D_spdiag , & ! artificial diffusion matrix - D_sbdiag , & ! artificial diffusion matrix - biomat_low , & ! Low order solution - Cerror ! Change in N after reactions - - real (kind=dbl_kind), dimension(nblyr+1,nbtrcr):: & - react ! biological sources and sinks for equation matrix - - real (kind=dbl_kind), dimension(nblyr+1,nbtrcr):: & - in_init_cons , & ! Initial bulk concentration*h (mmol/m^2) - biomat_cons , & ! Matrix output of (mmol/m^2) - biomat_brine ! brine concentration (mmol/m^3) - - real (kind=dbl_kind), dimension(nbtrcr):: & - C_top, & ! bulk top tracer source: h phi C(meltwater) (mmol/m^2) - C_bot, & ! bulk bottom tracer source: h phi C(ocean) (mmol/m^2) - Source_top, & ! For cons: (+) top tracer source into ice (mmol/m^2/s) - Source_bot, & ! For cons: (+) bottom tracer source into ice (mmol/m^2/s) - Sink_bot, & ! For cons: (+ or -) remaining bottom flux into ice(mmol/m^2/s) - Sink_top, & ! For cons: (+ or -) remaining bottom flux into ice(mmol/m^2/s) - ocean_b, & ! ocean_bio - sum_react, & - rtau_ret, & ! retention frequency (s^-1) - rtau_rel , & ! release frequency (s^-1) - atm_add_cons , & ! zbgc_snow+zbgc_atm (mmol/m^3*m) - dust_Fe , & ! contribution of dust surface flux to dFe (umol/m*3*m) - source , & ! mmol/m^2 surface input from snow/atmosphere - sum_stationary ! sum of stationary tracer (mmol/m^2) - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0 , & ! temporary, remapped tracers - trtmp ! temporary, remapped tracers - - logical (kind=log_kind), dimension(nblyr+1) :: & - conserve_C - - real (kind=dbl_kind), dimension(nblyr+1):: & ! temporary variables for - Diff , & ! diffusivity - initcons , & ! initial concentration - biocons , & ! new concentration - dmobile , & ! - initcons_mobile,&! - initcons_stationary, & - dz , & ! normalized vertical grid spacing - nitrification ! nitrate produced from nitrification (mmol/m3) - - real (kind=dbl_kind), dimension (nilyr+1):: & - icegrid ! correct for large ice surface layers - - real (kind=dbl_kind):: & - top_conc ! 1% (min_bgc) of surface concentration - ! when hin > hbri: just used in sw calculation - - real (kind=dbl_kind):: & - bio_tmp ! temporary variable - - real (kind=dbl_kind):: & - Sat_conc , & ! adsorbing saturation concentration (mmols/m^3) - phi_max , & ! maximum porosity - S_col , & ! surface area of collector (um^2) - P_b , & ! projected area of diatoms (um^2) - V_c , & ! volume of collector (um^3) - V_alg ! volume of algae (um^3) - - real (kind=dbl_kind), dimension(nbtrcr) :: & - mobile ! c0 if mobile, c1 otherwise - - ! local parameters - - real (kind=dbl_kind), parameter :: & - accuracy = 1.0e-13_dbl_kind, & ! 1.0e-14_dbl_kind, & - r_c = 3.0e3_dbl_kind , & ! ice crystal radius (um) - r_bac= 4.7_dbl_kind , & ! diatom large radius (um) - r_alg= 10.0_dbl_kind , & ! diatom small radius (um) - Nquota_A = 0.88_dbl_kind, & ! slope in Nitrogen quota to cell volume fit - ! (Lomas et al. 2019, Edwards et al. 2012) - Nquota_I = 0.0408_dbl_kind, & ! Intercept in N quota to cell volume fit - f_s = p1, & ! fracton of sites available for saturation - f_a = 0.3_dbl_kind, & !c1 , & ! fraction of collector available for attachment - f_v = 0.7854_dbl_kind ! fraction of algal coverage on area availabel for attachment - ! 4(pi r^2)/(4r)^2 [Johnson et al, 1995, water res. research] - - integer, parameter :: & - nt_zfswin = 1 ! for interpolation of short wave to bgrid - - character(len=char_len_long) :: & - warning ! warning message - - !------------------------------------- - ! Initialize - !----------------------------------- - - l_stop = .false. - zspace = c1/real(nblyr,kind=dbl_kind) - dz(:) = zspace - dz(1) = zspace/c2 - dz(nblyr+1) = zspace/c2 - in_init_cons(:,:) = c0 - atm_add_cons(:) = c0 - sum_react(:) = c0 - dhtop = c0 - dhbot = c0 - darcyV = c0 - C_top(:) = c0 - mobile(:) = c0 - conserve_C(:) = .true. - nitrification(:) = c0 - - do m = 1, nbtrcr - do k = 1, nblyr+1 - - bphin_N(nblyr+2) =c1 - bphin_N(k) = bphin(k) - iphin_N(k) = iphin(k) - bphin_N(1) = bphi_min - - if (abs(trcrn(bio_index(m) + k-1)) < accuracy) then - flux_bio(m) = flux_bio(m) + trcrn(bio_index(m) + k-1)* hbri_old * dz(k)/dt - trcrn(bio_index(m) + k-1) = c0 - in_init_cons(k,m) = c0 - else - in_init_cons(k,m) = trcrn(bio_index(m) + k-1)* hbri_old - endif - - if (trcrn(bio_index(m) + k-1) < c0 ) then - write(warning,*)'zbgc initialization error, first ice = ', first_ice - call add_warning(warning) - write(warning,*)'Category,m:',n_cat,m - call add_warning(warning) - write(warning,*)'hbri,hbri_old' - call add_warning(warning) - write(warning,*) hbri,hbri_old - call add_warning(warning) - write(warning,*)'trcrn(bio_index(m) + k-1)' - call add_warning(warning) - write(warning,*) trcrn(bio_index(m) + k-1) - call add_warning(warning) - l_stop = .true. - stop_label = 'zbgc initialization error' - endif - if (l_stop) return - enddo !k - enddo !m - - !----------------------------------------------------------------- - ! boundary conditions - !----------------------------------------------------------------- - - ice_conc = c0 - hin = vicen/aicen - hin_old = hice_old - - !----------------------------------------------------------------- - ! calculate the saturation concentration for attachment: Sat_conc - !----------------------------------------------------------------- - - phi_max = maxval(bphin_N(2:nblyr+1)) - S_col = 4.0_dbl_kind*pi*r_c**2 - P_b = pi*r_bac**2 !*10-6 for colloids - V_c = 4.0_dbl_kind*pi*r_c**3/3.0_dbl_kind !*(1.0e-6_dbl_kind)**3 (m^3) sphere - V_alg = pi/6.0_dbl_kind*r_bac*r_alg**2 ! prolate spheroid (*10-9 for colloids) - Sat_conc= f_s*f_a*f_v*(c1-phi_max)/V_c*S_col/P_b*(V_alg)**Nquota_A*Nquota_I * 1.0e9_dbl_kind - !mmol/m^3 (algae, don, hum...) and umols/m^3 for colloids - - !----------------------------------------------------------------- - ! convert surface dust flux (n_zaero > 2) to dFe(1) flux - !----------------------------------------------------------------- - - dust_Fe(:) = c0 - - if (tr_zaero .and. n_zaero > 2 .and. tr_bgc_Fe) then - do m = 3,n_zaero - dust_Fe(nlt_bgc_Fed(1)) = dust_Fe(nlt_bgc_Fed(1)) + & - (zbgc_snow(nlt_zaero(m)) + zbgc_atm(nlt_zaero(m))) * & - R_dFe2dust * dustFe_sol - ! dust_Fe(nlt_zaero(m)) = -(zbgc_snow(nlt_zaero(m)) + zbgc_atm(nlt_zaero(m))) * & - ! dustFe_sol - enddo - endif - - do m = 1,nbtrcr - !----------------------------------------------------------------- - ! time constants for mobile/stationary phase changes - !----------------------------------------------------------------- - - if (m .ne. nlt_bgc_N(1)) then - if (hin_old > hin) then !melting - rtau_rel(m) = c1/tau_rel(m) - rtau_ret(m) = c0 - else !not melting - rtau_ret(m) = c1/tau_ret(m) - rtau_rel(m) = c0 - endif - elseif (tr_bgc_N .and. hin_old > hin + algal_vel*dt) then - rtau_rel(m) = c1/tau_rel(m) - rtau_ret(m) = c0 - elseif (tr_bgc_N) then - rtau_ret(m) = c1/tau_ret(m) - rtau_rel(m) = c0 - endif - - ocean_b(m) = ocean_bio(m) - dhtop = dh_top - dhbot = dh_bot - darcyV = darcy_V - C_top(m) = in_init_cons(1,m)*trcrn(nt_zbgc_frac+m-1)!mobile fraction - source(m) = abs(zbgc_snow(m) + zbgc_atm(m) + dust_Fe(m)) - dhflood = max(c0,-dh_direct) ! ocean water flooding surface - dhrunoff = max(c0,dh_direct) - - if (dhtop+darcyV/bphin_N(1)*dt < -puny) then !snow/top ice melt - C_top(m) = (zbgc_snow(m)+zbgc_atm(m) + dust_Fe(m))/abs(dhtop & - + darcyV/bphin_N(1)*dt + puny)*hbri_old - elseif (dhtop+darcyV/bphin_N(1)*dt >= -puny .and. & - abs((zbgc_snow(m)+zbgc_atm(m) + dust_Fe(m)) + & - ocean_bio(m)*bphin_N(1)*dhflood) > puny) then - atm_add_cons(m) = abs(zbgc_snow(m) + zbgc_atm(m)+ dust_Fe(m)) + & - ocean_bio(m)*bphin_N(1)*dhflood - else ! only positive fluxes - atm_add_cons(m) = abs(zbgc_snow(m) + zbgc_atm(m)+ dust_Fe(m)) - endif - - C_bot(m) = ocean_bio(m)*hbri_old*iphin_N(nblyr+1) - - enddo ! m - - !----------------------------------------------------------------- - ! Interpolate shortwave flux, fswthrul (defined at top to bottom with nilyr+1 - ! evenly spaced with spacing = (1/nilyr) to grid variable zfswin: - !----------------------------------------------------------------- - - trtmp(:) = c0 - trtmp0(:)= c0 - zfswin(:) = c0 - - do k = 1, nilyr+1 - ! contains cice values (fswthrul(1) is surface value) - ! and fwsthrul(nilyr+1) is output - trtmp0(nt_zfswin+k-1) = fswthrul(k) - enddo !k - - call remap_zbgc(ntrcr, nilyr+1, & - nt_zfswin, & - trtmp0(1:ntrcr), trtmp(1:ntrcr+2), & - 0, nblyr+1, & - hin, hbri, & - ic_grid(1:nilyr+1), & - i_grid(1:nblyr+1),ice_conc, & - l_stop, stop_label) - - if (l_stop) return - - do k = 1,nblyr+1 - zfswin(k) = trtmp(nt_zfswin+k-1) - enddo - !----------------------------------------------------------------- - ! Initialze Biology - !----------------------------------------------------------------- - - do mm = 1, nbtrcr - mobile(mm) = c0 - if (bgc_tracer_type(mm) .GE. c0) mobile(mm) = c1 - - do k = 1, nblyr+1 - biomat_cons(k,mm) = in_init_cons(k,mm) - enddo !k - enddo !mm - - !----------------------------------------------------------------- - ! Compute FCT - !----------------------------------------------------------------- - - do mm = 1, nbtrcr - - if (hbri_old > thinS .and. hbri > thinS) then - do k = 1,nblyr+1 - initcons_mobile(k) = in_init_cons(k,mm)*trcrn(nt_zbgc_frac+mm-1) - initcons_stationary(k) = max(c0,in_init_cons(k,mm)-initcons_mobile(k)) - -! allow release of Nitrate/silicate, but not adsorption * - dmobile(k) = mobile(mm)*(initcons_mobile(k)*(exp(-dt*rtau_ret( mm))-c1) + & - initcons_stationary(k)*(c1-exp(-dt*rtau_rel(mm)))) + & - (1-mobile(mm))*initcons_stationary(k)*(c1-exp(-dt*rtau_rel(mm))) - initcons_mobile(k) = max(c0,initcons_mobile(k) + dmobile(k)) - initcons_stationary(k) = max(c0,initcons_stationary(k) - dmobile(k)) - if (initcons_stationary(k)/hbri_old > Sat_conc) then - initcons_mobile(k) = initcons_mobile(k) + initcons_stationary(k) - Sat_conc*hbri_old - initcons_stationary(k) = Sat_conc*hbri_old - endif - - Diff(k) = iDin(k) - initcons(k) = initcons_mobile(k) - biocons(k) = initcons_mobile(k) - enddo - - call compute_FCT_matrix & - (initcons,sbdiagz, dt, nblyr, & - diagz, spdiagz, rhsz, bgrid, & - i_grid, darcyV, dhtop, & - dhbot, iphin_N, & - Diff, hbri_old, & - atm_add_cons(mm), bphin_N, & - C_top(mm), C_bot(mm), & - Source_bot(mm), Source_top(mm),& - Sink_bot(mm),Sink_top(mm), & - D_sbdiag, D_spdiag, ML_diag) - - call tridiag_solverz & - (nblyr+1, sbdiagz, & - diagz, spdiagz, & - rhsz, biocons) - - call check_conservation_FCT & - (initcons, & - biocons, & - biomat_low, & - Source_top(mm), & - Source_bot(mm), & - Sink_bot(mm), & - Sink_top(mm), & - dt, flux_bio(mm), & - l_stop, nblyr, & - source(mm)) - - if (l_stop) return - - call compute_FCT_corr & - (initcons, & - biocons, dt, nblyr, & - D_sbdiag, D_spdiag, ML_diag) - - top_conc = c0 ! or frazil ice concentration - - ! assume diatoms actively maintain there relative position in the ice - - if (mm .ne. nlt_bgc_N(1)) then - - call regrid_stationary & - (initcons_stationary, hbri_old, & - hbri, dt, & - ntrcr, & - nblyr, top_conc, & - i_grid, flux_bio(mm),& - l_stop, stop_label, & - meltb, congel) - - elseif (tr_bgc_N .and. mm .eq. nlt_bgc_N(1)) then - if (meltb > algal_vel*dt .or. aicen < 0.001_dbl_kind) then - - call regrid_stationary & - (initcons_stationary, hbri_old, & - hbri, dt, & - ntrcr, & - nblyr, top_conc, & - i_grid, flux_bio(mm),& - l_stop, stop_label, & - meltb, congel) - - endif - endif - if (l_stop) return - - biomat_cons(:,mm) = biocons(:) + initcons_stationary(:) - - sum_initial = (in_init_cons(1,mm) + in_init_cons(nblyr+1,mm))*zspace/c2 - sum_old = (biomat_low(1) + biomat_low(nblyr+1))*zspace/c2 - sum_new = (biocons(1)+ biocons(nblyr+1))*zspace/c2 - sum_tot = (biomat_cons(1,mm) + biomat_cons(nblyr+1,mm))*zspace/c2 - do k = 2,nblyr - sum_initial = sum_initial + in_init_cons(k,mm)*zspace - sum_old = sum_old + biomat_low(k)*zspace - sum_new = sum_new + biocons(k)*zspace - sum_tot = sum_tot + biomat_cons(k,mm)*zspace - enddo - trcrn(nt_zbgc_frac+mm-1) = zbgc_frac_init(mm) - if (sum_tot > c0) trcrn(nt_zbgc_frac+mm-1) = sum_new/sum_tot - - if (abs(sum_initial-sum_tot-flux_bio(mm)*dt + source(mm)) > max(accuracy,accuracy*max(sum_initial,sum_tot)) .or. & - minval(biocons(:)) < c0 .or. minval(initcons_stationary(:)) < c0 & - .or. l_stop) then - write(warning,*)'zbgc FCT tracer solution failed,mm', mm - call add_warning(warning) - write(warning,*)'sum_new,sum_tot,sum_initial,flux_bio(mm),source(mm):' - call add_warning(warning) - write(warning,*)sum_new,sum_tot,sum_initial,flux_bio(mm),source(mm) - call add_warning(warning) - write(warning,*)'error = sum_initial-sum_tot-flux_bio(mm)*dt+source(mm)' - call add_warning(warning) - write(warning,*)sum_initial-sum_tot-flux_bio(mm)*dt+source(mm) - call add_warning(warning) - write(warning,*)'sum_new,sum_old:',sum_new,sum_old - call add_warning(warning) - write(warning,*)'mm,biocons(:):',mm,biocons(:) - call add_warning(warning) - write(warning,*)'biomat_low:',biomat_low - call add_warning(warning) - write(warning,*)'Diff(:):',Diff(:) - call add_warning(warning) - write(warning,*)'dmobile(:):',dmobile(:) - call add_warning(warning) - write(warning,*)'mobile(mm):',mobile(mm) - call add_warning(warning) - write(warning,*)'initcons_stationary(:):',initcons_stationary(:) - call add_warning(warning) - write(warning,*) 'trcrn(nt_zbgc_frac+mm-1):',trcrn(nt_zbgc_frac+mm-1) - call add_warning(warning) - write(warning,*) 'in_init_cons(:,mm):',in_init_cons(:,mm) - call add_warning(warning) - write(warning,*) 'rtau_ret( mm),rtau_rel( mm)',rtau_ret( mm),rtau_rel( mm) - call add_warning(warning) - write(warning,*)'darcyV,dhtop,dhbot' - call add_warning(warning) - write(warning,*)darcyV,dhtop,dhbot - call add_warning(warning) - write(warning,*)'Category,mm:',n_cat,mm - call add_warning(warning) -! l_stop = .true. - stop_label = 'zbgc FCT tracer solution warning' - endif - if (l_stop) return - - else - - Call thin_ice_flux(hbri,hbri_old,iphin_N, biomat_cons(:,mm), & - flux_bio(mm),source(mm), & - i_grid, dt, nblyr,ocean_bio(mm)) - - endif ! thin or not - - do k = 1,nblyr+1 - biomat_brine(k,mm) = biomat_cons(k,mm)/hbri/iphin_N(k) - enddo ! k - enddo ! mm - - react(:,:) = c0 - grow_alg(:,:) = c0 - - if (solve_zbgc) then - do k = 1, nblyr+1 - call algal_dyn (dt, & - n_zaero, n_doc, n_dic, n_don, n_fed, n_fep, & - dEdd_algae, & - zfswin(k), react(k,:), & - biomat_brine(k,:), nbtrcr, & - grow_alg(k,:), n_algae, & - iTin(k), & - upNOn(k,:), upNHn(k,:), & - Zoo(k), & - Cerror(k), conserve_C(k), & - nitrification(k)) - enddo ! k - endif ! solve_zbgc - - !----------------------------------------------------------------- - ! Update the tracer variable - !----------------------------------------------------------------- - - sum_new = c0 - sum_tot = c0 - - do m = 1,nbtrcr - do k = 1,nblyr+1 ! back to bulk quantity - bio_tmp = (biomat_brine(k,m) + react(k,m))*iphin_N(k) - if (tr_bgc_C .and. m .eq. nlt_bgc_DIC(1) .and. bio_tmp .le. -accuracy) then ! satisfy DIC demands from ocean - !uncomment for additional diagnostics - ! write(warning, *) 'DIC demand from ocean' - ! call add_warning(warning) - ! write(warning, *) 'm, nlt_bgc_DIC(1), bio_tmp, react(k,m):' - ! call add_warning(warning) - ! write(warning, *) m, nlt_bgc_DIC(1), bio_tmp, react(k,m) - ! call add_warning(warning) - ! write(warning,*)'flux_bio(m) Initial, hbri_old, dz(k)' - ! call add_warning(warning) - ! write(warning,*) flux_bio(m), hbri_old, dz(k) - ! call add_warning(warning) - flux_bio(m) = flux_bio(m) + bio_tmp*dz(k)*hbri/dt - bio_tmp = c0 - ! write(warning,*) 'flux_bio(m)' - ! call add_warning(warning) - ! write(warning,*) flux_bio(m) - ! call add_warning(warning) - end if - if (m .eq. nlt_bgc_Nit) then - initcons_mobile(k) = max(c0,(biomat_brine(k,m)-nitrification(k) + & - react(k,m))*iphin_N(k)*trcrn(nt_zbgc_frac+m-1)) - initcons_stationary(k) = max(c0,((c1-trcrn(nt_zbgc_frac+m-1))*(biomat_brine(k,m)- & - nitrification(k) + react(k,m)) + nitrification(k))*iphin_N(k)) - - sum_new = sum_new + initcons_mobile(k)*dz(k) - sum_tot = sum_tot + (initcons_mobile(k) + initcons_stationary(k))*dz(k) - - end if ! m .eq. nlt_bgc_Nit - if (.not. conserve_C(k)) then - write(warning, *) 'C in algal_dyn not conserved' - call add_warning(warning) - write(warning, *) 'Cerror(k):', Cerror(k) - call add_warning(warning) - write(warning, *) 'k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m)' - call add_warning(warning) - write(warning, *) k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m) - call add_warning(warning) - write(warning, *) 'react(k,m),iphin_N(k),biomat_brine(k,m)' - call add_warning(warning) - write(warning, *) react(k,m),iphin_N(k),biomat_brine(k,m) - call add_warning(warning) - l_stop = .true. - stop_label = 'C in algal_dyn not conserved' - elseif (abs(bio_tmp) < accuracy) then - flux_bio(m) = flux_bio(m) + bio_tmp*dz(k)*hbri/dt - bio_tmp = c0 - elseif (bio_tmp > 1.0e8_dbl_kind) then - write(warning, *) 'very large bgc value' - call add_warning(warning) - write(warning, *) 'k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m)' - call add_warning(warning) - write(warning, *) k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m) - call add_warning(warning) - write(warning, *) 'react(k,m),iphin_N(k),biomat_brine(k,m)' - call add_warning(warning) - write(warning, *) react(k,m),iphin_N(k),biomat_brine(k,m) - call add_warning(warning) -! l_stop = .true. - stop_label = 'very large bgc value' - elseif (bio_tmp < c0) then - write(warning, *) 'negative bgc' - call add_warning(warning) - write(warning, *) 'k,m,nlt_bgc_Nit,hbri,hbri_old' - call add_warning(warning) - write(warning, *) k,m,nlt_bgc_Nit,hbri,hbri_old - call add_warning(warning) - write(warning, *) 'bio_tmp,biomat_cons(k,m),ocean_bio(m)' - call add_warning(warning) - write(warning, *) bio_tmp,biomat_cons(k,m),ocean_bio(m) - call add_warning(warning) - write(warning, *) 'react(k,m),iphin_N(k),biomat_brine(k,m)' - call add_warning(warning) - write(warning, *) react(k,m),iphin_N(k),biomat_brine(k,m) - call add_warning(warning) - write(warning, *) 'rtau_ret( m),rtau_ret( m)',rtau_ret( m),rtau_ret( m) - call add_warning(warning) - l_stop = .true. - stop_label = 'negative bgc' - endif - trcrn(bio_index(m)+k-1) = max(c0, bio_tmp) - if (l_stop) then - write(warning, *) 'trcrn(nt_zbgc_frac+m-1):',trcrn(nt_zbgc_frac+m-1) - call add_warning(warning) - write(warning, *) 'in_init_cons(k,m):',in_init_cons(k,m) - call add_warning(warning) - write(warning, *) 'trcrn(bio_index(m) + k-1)' - call add_warning(warning) - write(warning, *) trcrn(bio_index(m) + k-1) - call add_warning(warning) - write(warning, *) 'Category,m:',n_cat,m - call add_warning(warning) - return - endif - enddo ! k - if (m .eq. nlt_bgc_Nit .and. MAXVAL(nitrification) > c0) then - trcrn(nt_zbgc_frac+m-1) = zbgc_frac_init(m) - if (sum_tot > c0) trcrn(nt_zbgc_frac+m-1) = sum_new/sum_tot - end if - enddo ! m - -770 format (I6,D16.6) -781 format (I6,I6,I6) -790 format (I6,I6) -791 format (f24.17) -792 format (2D16.6) -793 format (3D16.6) -794 format (4D15.5) -800 format (F10.4) - - end subroutine z_biogeochemistry - -!======================================================================= -! -! Do biogeochemistry from subroutine algal_dynamics -! authors: Scott Elliott, LANL -! Nicole Jeffery, LANL - - subroutine algal_dyn (dt, & - n_zaero, n_doc, n_dic, n_don, n_fed, n_fep, & - dEdd_algae, & - fswthru, reactb, & - ltrcrn, nbtrcr, & - grow_alg, n_algae, & - T_bot, & - upNOn, upNHn, & - Zoo, & - Cerror, conserve_C, & - nitrification) - - use ice_constants_colpkg, only: p1, p5, c0, c1, secday, puny - use ice_colpkg_shared, only: max_algae, max_DON, max_DOC, R_C2N, R_chl2N, & - T_max, fsal , fr_resp , & - op_dep_min , fr_graze_s , & - fr_graze_e , fr_mort2min , & - fr_dFe , k_nitrif , & - t_iron_conv , max_loss , & - max_dfe_doc1 , fr_resp_s , & - y_sk_DMS , t_sk_conv , & - t_sk_ox , R_C2N_DON - - use ice_zbgc_shared, only: chlabs, alpha2max_low, beta2max, mu_max, & - grow_Tdep, fr_graze, mort_pre, mort_Tdep, & - k_exude, K_Nit, K_Am, K_Sil, K_Fe, & - f_don, kn_bac, f_don_Am, & - f_doc, f_exude, k_bac - - use ice_colpkg_tracers, only: tr_brine, nt_fbri, & - tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & - tr_bgc_DMS, tr_bgc_PON, tr_bgc_S, & - tr_bgc_N, tr_bgc_C, tr_bgc_chl, & - tr_bgc_DON, tr_bgc_Fe, & - nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & - nlt_bgc_DMS, nlt_bgc_PON, & - nlt_bgc_N, nlt_bgc_C, nlt_bgc_chl, & - nlt_bgc_DOC, nlt_bgc_DON, nlt_bgc_DIC, & - nlt_zaero , nlt_bgc_DMSPp,nlt_bgc_DMSPd, & - nlt_bgc_Fed, nlt_bgc_Fep, nlt_zaero - - integer (kind=int_kind), intent(in) :: & - nbtrcr, & ! number of layer tracers, - n_zaero, n_doc, n_dic, n_don, n_fed, n_fep, & - n_algae ! number of autotrophic types - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - T_bot , & ! ice temperature (oC) - fswthru ! average shortwave passing through current ice layer (W/m^2) - - real (kind=dbl_kind), intent(inout) :: & - Zoo, & ! N losses from zooplankton/bacteria... (mmol/m^3) - Cerror, & ! Change in C after reactions (mmol/m^3) - nitrification ! nitrate produced through nitrification (mmol/m3) - - real (kind=dbl_kind), dimension (:), intent(out) :: & - grow_alg,& ! algal growth rate (mmol/m^3/s) - upNOn, & ! algal NO uptake rate (mmol/m^3/s) - upNHn ! algal NH uptake rate (mmol/m^3/s) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - reactb ! biological reaction terms (mmol/m3) - - real (kind=dbl_kind), dimension(:), intent(in) :: & - ltrcrn ! brine concentrations in layer (mmol/m^3) - - logical (kind=log_kind), intent(inout) :: & - conserve_C - - logical (kind=log_kind), intent(in) :: & - dEdd_algae ! .true. chla impact on shortwave computed in dEdd - - ! local variables - !------------------------------------------------------------------------------------ - ! 3 possible autotrophs nt_bgc_N(1:3): diatoms, flagellates, phaeocystis - ! 2 types of dissolved organic carbon nt_bgc_DOC(1:2): - ! polysaccharids, lipids - ! 1 DON (proteins) - ! 1 particulate iron (nt_bgc_Fe) n_fep - ! 1 dossp;ved orpm m+fed - ! Limiting macro/micro nutrients: nt_bgc_Nit -> nitrate, nt_bgc_NH -> ammonium, - ! nt_bgc_Sil -> silicate, nt_bgc_Fe -> dissolved iron - ! -------------------------------------------------------------------------------------- - - real (kind=dbl_kind), parameter, dimension(max_algae) :: & - alpha2max_high = (/ 0.25_dbl_kind, 0.25_dbl_kind, 0.25_dbl_kind/) ! light limitation (1/(W/m^2)) - real (kind=dbl_kind), parameter, dimension(max_algae) :: & - graze_exponent = (/ 0.333_dbl_kind, c1, c1/) ! Implicit grazing exponent (Dunneet al. 2005) - - real (kind=dbl_kind), parameter :: & - graze_conc = 1.36_dbl_kind ! (mmol N/m^3) converted from Dunne et al 2005 - ! data fit for phytoplankton (1.9 mmol C/m^3) to - ! ice algal N with 20% porosity and C/N = 7 - - integer (kind=int_kind) :: k, n - - real (kind=dbl_kind), dimension(n_algae) :: & - Nin , & ! algal nitrogen concentration on volume (mmol/m^3) - Cin , & ! algal carbon concentration on volume (mmol/m^3) - chlin ! algal chlorophyll concentration on volume (mg/m^3) - - real (kind=dbl_kind), dimension(n_doc) :: & - Docin ! dissolved organic carbon concentration on volume (mmolC/m^3) - - real (kind=dbl_kind), dimension(n_dic) :: & - Dicin ! dissolved inorganic carbon concentration on volume (mmolC/m^3) - - real (kind=dbl_kind), dimension(n_don) :: & !proteins - Donin ! dissolved organic nitrogen concentration on volume (mmolN/m^3) - - real (kind=dbl_kind), dimension(n_fed) :: & !iron - Fedin ! dissolved iron concentration on volume (umol/m^3) - - real (kind=dbl_kind), dimension(n_fep) :: & !iron - Fepin ! algal nitrogen concentration on volume (umol/m^3) - - real (kind=dbl_kind) :: & - Nitin , & ! nitrate concentration on volume (mmol/m^3) - Amin , & ! ammonia/um concentration on volume (mmol/m^3) - Silin , & ! silicon concentration on volume (mmol/m^3) - DMSPpin , & ! DMSPp concentration on volume (mmol/m^3) - DMSPdin , & ! DMSPd concentration on volume (mmol/m^3) - DMSin , & ! DMS concentration on volume (mmol/m^3) - PONin , & ! PON concentration on volume (mmol/m^3) - op_dep , & ! bottom layer attenuation exponent (optical depth) - Iavg_loc ! bottom layer attenuated Fswthru (W/m^2) - - real (kind=dbl_kind), dimension(n_algae) :: & - L_lim , & ! overall light limitation - Nit_lim , & ! overall nitrate limitation - Am_lim , & ! overall ammonium limitation - N_lim , & ! overall nitrogen species limitation - Sil_lim , & ! overall silicon limitation - Fe_lim , & ! overall iron limitation - fr_Nit , & ! fraction of local ecological growth as nitrate - fr_Am , & ! fraction of local ecological growth as ammonia - growmax_N, & ! maximum growth rate in N currency (mmol/m^3/s) - grow_N , & ! true growth rate in N currency (mmol/m^3/s) - potU_Nit , & ! potential nitrate uptake (mmol/m^3/s) - potU_Am , & ! potential ammonium uptake (mmol/m^3/s) - U_Nit , & ! actual nitrate uptake (mmol/m^3/s) - U_Am , & ! actual ammonium uptake (mmol/m^3/s) - U_Sil , & ! actual silicon uptake (mmol/m^3/s) - U_Fe , & ! actual iron uptake (umol/m^3/s) - U_Nit_f , & ! fraction of Nit uptake due to each algal species - U_Am_f , & ! fraction of Am uptake due to each algal species - U_Sil_f , & ! fraction of Sil uptake due to each algal species - U_Fe_f ! fraction of Fe uptake due to each algal species - - real (kind=dbl_kind) :: & - dTemp , & ! sea ice temperature minus sst (oC) < 0 - U_Nit_tot , & ! actual nitrate uptake (mmol/m^3/s) - U_Am_tot , & ! actual ammonium uptake (mmol/m^3/s) - U_Sil_tot , & ! actual silicon uptake (mmol/m^3/s) - U_Fe_tot , & ! actual iron uptake (umol/m^3/s) - nitrif , & ! nitrification (mmol/m^3/s) - mort_N , & ! total algal mortality (mmol N/m^3) - mort_C , & ! total algal mortality (mmol C/m^3) - graze_N , & ! total algae grazed (mmol N/m^3) - graze_C , & ! total algae grazed (mmol C/m^3) - exude_C , & ! total carbon exuded by algae (mmol C/m^3) - resp_N , & ! total N in respiration (mmol N/m^3) - growth_N , & ! total algal growth (mmol N/m^3) - fr_graze_p , & ! fraction of N grazed that becomes protein - ! (rest is assimilated) < (1-fr_graze_a) - ! and fr_graze_a*fr_graze_e becomes ammonia - fr_mort_p ! fraction of N mortality that becomes protein - ! < (1-fr_mort2min) - - real (kind=dbl_kind), dimension(n_algae) :: & - resp , & ! respiration (mmol/m^3/s) - graze , & ! grazing (mmol/m^3/s) - mort ! sum of mortality and excretion (mmol/m^3/s) - -! source terms underscore s, removal underscore r - - real (kind=dbl_kind), dimension(n_algae) :: & - N_s , & ! net algal nitrogen sources (mmol/m^3) - N_r ! net algal nitrogen removal (mmol/m^3) - - real (kind=dbl_kind), dimension(n_doc) :: & - DOC_r , & ! net DOC removal (mmol/m^3) - DOC_s ! net DOC sources (mmol/m^3) - - real (kind=dbl_kind), dimension(n_dic) :: & - DIC_r , & ! net DIC removal (mmol/m^3) - DIC_s ! net DIC sources (mmol/m^3) - - real (kind=dbl_kind), dimension(n_don) :: & - DON_r , & ! net DON removal (mmol/m^3) - DON_s ! net DON sources (mmol/m^3) - - real (kind=dbl_kind), dimension(n_fed) :: & - Fed_r_l , & ! removal due to loss of binding saccharids (nM) - Fed_r , & ! net Fed removal (nM) - Fed_s , & ! net Fed sources (nM) - rFed ! ratio of dissolved Fe to tot Fed - - real (kind=dbl_kind), dimension(n_fep) :: & - Fep_r , & ! net Fep removal (nM) - Fep_s , & ! net Fep sources (nM) - rFep ! ratio of particulate Fe to tot Fep - - real (kind=dbl_kind) :: & - dN , & ! change in Nitrogen (mmol N/m^3) - dC , & ! change in Carbon (mmol C/m^3) - N_s_p , & ! algal nitrogen photosynthesis (mmol/m^3) - N_r_g , & ! algal nitrogen losses to grazing (mmol/m^3) - N_r_r , & ! algal nitrogen losses to respiration (mmol/m^3) - N_r_mo , & ! algal nitrogen losses to mortality (mmol/m^3) - Nit_s_n , & ! nitrate from nitrification (mmol/m^3) - Nit_s_r , & ! nitrate from respiration (mmol/m^3) - Nit_r_p , & ! nitrate uptake by algae (mmol/m^3) - Nit_s , & ! net nitrate sources (mmol/m^3) - Nit_r , & ! net nitrate removal (mmol/m^3) - Am_s_e , & ! ammonium source from excretion (mmol/m^3) - Am_s_r , & ! ammonium source from respiration (mmol/m^3) - Am_s_mo , & ! ammonium source from mort/remin (mmol/m^3) - Am_r_p , & ! ammonium uptake by algae (mmol/m^3) - Am_r_n , & ! ammonium removal to nitrification (mmol/m^3) - Am_s , & ! net ammonium sources (mmol/m^3) - Am_r , & ! net ammonium removal (mmol/m^3) - Sil_r_p , & ! silicon uptake by algae (mmol/m^3) - Sil_r , & ! net silicon removal (mmol/m^3) - Fe_r_p , & ! iron uptake by algae (nM) - DOC_r_c , & ! net doc removal from bacterial consumption (mmol/m^3) - doc_s_m , & ! protein source due to algal mortality (mmol/m^3) - doc_s_g ! protein source due to grazing (mmol/m^3) - - real (kind=dbl_kind) :: & - DMSPd_s_r , & ! skl dissolved DMSP from respiration (mmol/m^3) - DMSPd_s_mo, & ! skl dissolved DMSP from MBJ algal mortexc (mmol/m^3) - DMSPd_r , & ! skl dissolved DMSP conversion (mmol/m^3) DMSPD_sk_r - DMSPd_s , & ! net skl dissolved DMSP sources (mmol/m^3) - DMS_s_c , & ! skl DMS source via conversion (mmol/m^3) - DMS_r_o , & ! skl DMS losses due to oxidation (mmol/m^3) - DMS_s , & ! net skl DMS sources (mmol/m^3) - DMS_r , & ! net skl DMS removal (mmol/m^3) - Fed_tot , & ! total dissolved iron from all sources (nM) - Fed_tot_r , & ! total dissolved iron losses (nM) - Fed_tot_s , & ! total dissolved iron sources (nM) - Fep_tot , & ! total particulate iron from all sources (nM) - Fep_tot_r , & ! total particulate iron losses (nM) - Fep_tot_s , & ! total particulate iron sources (nM) - Zoo_s_a , & ! N Losses due to zooplankton assimilation (mmol/m^3) - Zoo_s_s , & ! N Losses due to grazing spillage (mmol/m^3) - Zoo_s_m , & ! N Losses due to algal mortality (mmol/m^3) - Zoo_s_b ! N losses due to bacterial recycling of DON (mmol/m^3) - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------------- - - conserve_C = .true. - Nin(:) = c0 - Cin(:) = c0 - chlin(:) = c0 - DOCin(:) = c0 - DICin(:) = c0 - DONin(:) = c0 - Fedin(:) = c0 - Fepin(:) = c0 - Nitin = c0 - Amin = c0 - Silin = c0 - DMSPpin = c0 - DMSPdin = c0 - DMSin = c0 - PONin = c0 - U_Am_tot = c0 - U_Nit_tot = c0 - U_Sil_tot = c0 - U_Fe_tot = c0 - U_Am_f(:) = c0 - U_Nit_f(:) = c0 - U_Sil_f(:) = c0 - U_Fe_f(:) = c0 - DOC_s(:) = c0 - DOC_r(:) = c0 - DIC_s(:) = c0 - DIC_r(:) = c0 - DOC_r_c = c0 - nitrif = c0 - mort_N = c0 - mort_C = c0 - graze_N = c0 - graze_C = c0 - exude_C = c0 - resp_N = c0 - growth_N = c0 - Nit_r = c0 - Am_s = c0 - Am_r = c0 - Sil_r = c0 - Fed_r(:) = c0 - Fed_s(:) = c0 - Fep_r(:) = c0 - Fep_s(:) = c0 - DMSPd_s = c0 - dTemp = min(T_bot-T_max,c0) - Fed_tot = c0 - Fed_tot_r = c0 - Fed_tot_s = c0 - rFed(:) = c0 - Fep_tot = c0 - Fep_tot_r = c0 - Fep_tot_s = c0 - rFep(:) = c0 - - Nitin = ltrcrn(nlt_bgc_Nit) - op_dep = c0 - do k = 1, n_algae - Nin(k) = ltrcrn(nlt_bgc_N(k)) - chlin(k) = R_chl2N(k)* Nin(k) - op_dep = op_dep + chlabs(k)*chlin(k) - enddo - if (tr_bgc_C) then - ! do k = 1, n_algae - ! Cin(k)= ltrcrn(nlt_bgc_C(k)) - ! enddo - do k = 1, n_doc - DOCin(k)= ltrcrn(nlt_bgc_DOC(k)) - enddo - do k = 1, n_dic - DICin(k)= ltrcrn(nlt_bgc_DIC(k)) - enddo - endif - if (tr_bgc_Am) Amin = ltrcrn(nlt_bgc_Am) - if (tr_bgc_Sil) Silin = ltrcrn(nlt_bgc_Sil) - if (tr_bgc_DMS) then - ! DMSPpin = ltrcrn(nlt_bgc_DMSPp) - DMSPdin = ltrcrn(nlt_bgc_DMSPd) - DMSin = ltrcrn(nlt_bgc_DMS) - endif - if (tr_bgc_PON) PONin = ltrcrn(nlt_bgc_PON) - if (tr_bgc_DON) then - do k = 1, n_don - DONin(k) = ltrcrn(nlt_bgc_DON(k)) - enddo - endif - if (tr_bgc_Fe ) then - do k = 1, n_fed - Fedin(k) = ltrcrn(nlt_bgc_Fed(k)) - enddo - do k = 1, n_fep - Fepin(k) = ltrcrn(nlt_bgc_Fep(k)) - enddo - endif - - !----------------------------------------------------------------------- - ! Total iron from all pools - !----------------------------------------------------------------------- - - do k = 1,n_fed - Fed_tot = Fed_tot + Fedin(k) - enddo - do k = 1,n_fep - Fep_tot = Fep_tot + Fepin(k) - enddo - if (Fed_tot > puny) then - do k = 1,n_fed - rFed(k) = Fedin(k)/Fed_tot - enddo - endif - if (Fep_tot > puny) then - do k = 1,n_fep - rFep(k) = Fepin(k)/Fep_tot - enddo - endif - - !----------------------------------------------------------------------- - ! Light limitation (op_dep) defined above - !----------------------------------------------------------------------- - - if (op_dep > op_dep_min .and. .not. dEdd_algae) then - Iavg_loc = fswthru * (c1 - exp(-op_dep)) / op_dep - else - Iavg_loc = fswthru - endif - - do k = 1, n_algae - ! With light inhibition ! Maybe include light inhibition for diatoms but phaeocystis - - L_lim = (c1 - exp(-alpha2max_low(k)*Iavg_loc)) * exp(-beta2max(k)*Iavg_loc) - - ! Without light inhibition - !L_lim(k) = (c1 - exp(-alpha2max_low(k)*Iavg_loc)) - - !----------------------------------------------------------------------- - ! Nutrient limitation - !----------------------------------------------------------------------- - - Nit_lim(k) = Nitin/(Nitin + K_Nit(k)) - Am_lim(k) = c0 - N_lim(k) = Nit_lim(k) - if (tr_bgc_Am) then - Am_lim(k) = Amin/(Amin + K_Am(k)) - N_lim(k) = min(c1, Nit_lim(k) + Am_lim(k)) - endif - Sil_lim(k) = c1 - if (tr_bgc_Sil .and. K_Sil(k) > c0) Sil_lim(k) = Silin/(Silin + K_Sil(k)) - - !----------------------------------------------------------------------- - ! Iron limitation - !----------------------------------------------------------------------- - - Fe_lim(k) = c1 - if (tr_bgc_Fe .and. K_Fe (k) > c0) Fe_lim (k) = Fed_tot/(Fed_tot + K_Fe(k)) - - !---------------------------------------------------------------------------- - ! Growth and uptake computed within the bottom layer - ! Note here per A93 discussions and MBJ model, salinity is a universal - ! restriction. Comparison with available column nutrients inserted - ! but in tests had no effect. - ! Primary production reverts to SE form, see MBJ below and be careful - !---------------------------------------------------------------------------- - - growmax_N(k) = mu_max(k) / secday * exp(grow_Tdep(k) * dTemp)* Nin(k) *fsal - grow_N(k) = min(L_lim(k), N_lim(k), Sil_lim(k), Fe_lim(k)) * growmax_N(k) - potU_Nit(k) = Nit_lim(k)* growmax_N(k) - potU_Am(k) = Am_lim(k)* growmax_N(k) - U_Am(k) = min(grow_N(k), potU_Am(k)) - U_Nit(k) = grow_N(k) - U_Am(k) - U_Sil(k) = R_Si2N(k) * grow_N(k) - U_Fe (k) = R_Fe2N(k) * grow_N(k) - - U_Am_tot = U_Am_tot + U_Am(k) - U_Nit_tot = U_Nit_tot + U_Nit(k) - U_Sil_tot = U_Sil_tot + U_Sil(k) - U_Fe_tot = U_Fe_tot + U_Fe(k) - enddo - do k = 1, n_algae - if (U_Am_tot > c0) U_Am_f(k) = U_Am(k)/U_Am_tot - if (U_Nit_tot > c0) U_Nit_f(k) = U_Nit(k)/U_Nit_tot - if (U_Sil_tot > c0) U_Sil_f(k) = U_Sil(k)/U_Sil_tot - if (U_Fe_tot > c0) U_Fe_f(k) = U_Fe(k)/U_Fe_tot - enddo - - if (tr_bgc_Sil) U_Sil_tot = min(U_Sil_tot, max_loss * Silin/dt) - if (tr_bgc_Fe) U_Fe_tot = min(U_Fe_tot, max_loss * Fed_tot/dt) - U_Nit_tot = min(U_Nit_tot, max_loss * Nitin/dt) - U_Am_tot = min(U_Am_tot, max_loss * Amin/dt) - - do k = 1, n_algae - U_Am(k) = U_Am_f(k)*U_Am_tot - U_Nit(k) = U_Nit_f(k)*U_Nit_tot - U_Sil(k) = U_Sil_f(k)*U_Sil_tot - U_Fe(k) = U_Fe_f(k)*U_Fe_tot - - if (R_Si2N(k) > c0) then - grow_N(k) = min(U_Sil(k)/R_Si2N(k),U_Nit(k) + U_Am(k), U_Fe(k)/R_Fe2N(k)) - else - grow_N(k) = min(U_Nit(k) + U_Am(k),U_Fe(k)/R_Fe2N(k)) - endif - - fr_Am(k) = c0 - if (tr_bgc_Am) then - fr_Am(k) = p5 - if (grow_N(k) > c0) fr_Am(k) = min(U_Am(k)/grow_N(k), c1) - endif - fr_Nit(k) = c1 - fr_Am(k) - U_Nit(k) = fr_Nit(k) * grow_N(k) - U_Am(k) = fr_Am(k) * grow_N(k) - U_Sil(k) = R_Si2N(k) * grow_N(k) - U_Fe (k) = R_Fe2N(k) * grow_N(k) - - !----------------------------------------------------------------------- - ! Define reaction terms - !----------------------------------------------------------------------- - - ! Since the framework remains incomplete at this point, - ! it is assumed as a starting expedient that - ! DMSP loss to melting results in 10% conversion to DMS - ! which is then given a ten day removal constant. - ! Grazing losses are channeled into rough spillage and assimilation - ! then following ammonia there is some recycling. - - !-------------------------------------------------------------------- - ! Algal reaction term - ! v1: N_react = (grow_N*(c1 - fr_graze-fr_resp) - mort)*dt - ! v2: N_react = (grow_N*(c1 - fr_graze * (N/graze_conc)**graze_exp-fr_resp) - mort)*dt - ! with maximum grazing less than max_loss * Nin(k)/dt - !-------------------------------------------------------------------- - - resp(k) = fr_resp * grow_N(k) - graze(k) = min(max_loss * Nin(k)/dt, grow_N(k) * fr_graze(k) * (Nin(k)/graze_conc)**graze_exponent(k)) - mort(k) = min(max_loss * Nin(k)/dt, mort_pre(k)* exp(mort_Tdep(k)*dTemp) * Nin(k) / secday) - - ! history variables - grow_alg(k) = grow_N(k) - upNOn(k) = U_Nit(k) - upNHn(k) = U_Am(k) - - N_s_p = grow_N(k) * dt - N_r_g = graze(k) * dt - N_r_r = resp(k) * dt - N_r_mo = mort(k) * dt - N_s(k) = N_s_p !(c1- fr_resp - fr_graze(k)) * grow_N(k) *dt - N_r(k) = N_r_g + N_r_mo + N_r_r !mort(k) * dt - graze_N = graze_N + graze(k) - graze_C = graze_C + R_C2N(k)*graze(k) - mort_N = mort_N + mort(k) - mort_C = mort_C + R_C2N(k)*mort(k) - resp_N = resp_N + resp(k) - growth_N = growth_N + grow_N(k) - enddo ! n_algae - !-------------------------------------------------------------------- - ! Ammonium source: algal grazing, respiration, and mortality - !-------------------------------------------------------------------- - - Am_s_e = graze_N*(c1-fr_graze_s)*fr_graze_e*dt - Am_s_mo = mort_N*fr_mort2min*dt - Am_s_r = resp_N*dt - Am_s = Am_s_r + Am_s_e + Am_s_mo - - !-------------------------------------------------------------------- - ! Nutrient net loss terms: algal uptake - !-------------------------------------------------------------------- - - do k = 1, n_algae - Am_r_p = U_Am(k) * dt - Am_r = Am_r + Am_r_p - Nit_r_p = U_Nit(k) * dt - Nit_r = Nit_r + Nit_r_p - Sil_r_p = U_Sil(k) * dt - Sil_r = Sil_r + Sil_r_p - Fe_r_p = U_Fe (k) * dt - Fed_tot_r = Fed_tot_r + Fe_r_p - exude_C = exude_C + k_exude(k)* R_C2N(k)*Nin(k) / secday - DIC_r(1) = DIC_r(1) + (c1-fr_resp)*grow_N(k) * R_C2N(k) * dt - enddo - - !-------------------------------------------------------------------- - ! nitrification - !-------------------------------------------------------------------- - nitrification = c0 - nitrif = k_nitrif /secday * Amin - Am_r = Am_r + nitrif*dt - Nit_s_n = nitrif * dt !source from NH4 - Nit_s = Nit_s_n - - !-------------------------------------------------------------------- - ! PON: currently using PON to shadow nitrate - ! - ! N Losses are counted in Zoo. These arise from mortality not - ! remineralized (Zoo_s_m), assimilated grazing not excreted (Zoo_s_a), - !spilled N not going to DON (Zoo_s_s) and bacterial recycling - ! of DON (Zoo_s_b). - !-------------------------------------------------------------------- - - if (tr_bgc_Am) then - Zoo_s_a = graze_N*(c1-fr_graze_e)*(c1-fr_graze_s) *dt - Zoo_s_s = graze_N*fr_graze_s*dt - Zoo_s_m = mort_N*dt - Am_s_mo - else - Zoo_s_a = graze_N*dt*(c1-fr_graze_s) - Zoo_s_s = graze_N*fr_graze_s*dt - Zoo_s_m = mort_N*dt - endif - - Zoo_s_b = c0 - - !-------------------------------------------------------------------- - ! DON (n_don = 1) - ! Proteins - !-------------------------------------------------------------------- - - DON_r(:) = c0 - DON_s(:) = c0 - - if (tr_bgc_DON) then - do n = 1, n_don - DON_r(n) = kn_bac(n)/secday * DONin(n) * dt - !DON_s(n) = (c1 - fr_graze_s + fr_graze_e*fr_graze_s)* graze_N * dt !fr_graze_N*f_don(n)*fr_graze_s * dt - DON_s(n) = graze_N*dt - Am_s_e + mort_N*dt - Am_s_mo - Zoo_s_s = Zoo_s_s - DON_s(n) - Zoo_s_b = Zoo_s_b + DON_r(n)*(c1-f_don_Am(n)) - Am_s = Am_s + DON_r(n)*f_don_Am(n) - DIC_s(1) = DIC_s(1) + DON_r(n) * R_C2N_DON(n) - enddo - endif - - Zoo = Zoo_s_a + Zoo_s_s + Zoo_s_m + Zoo_s_b - - !-------------------------------------------------------------------- - ! DOC - ! polysaccharids, lipids - !-------------------------------------------------------------------- - - do n = 1, n_doc - DOC_r(n) = k_bac(n)/secday * DOCin(n) * dt -! DOC_s(n) = f_doc(n)*(fr_graze_s *graze_C + mort_C)*dt & -! + f_exude(n)*exude_C - DOC_s(n) = f_doc(n) * (graze_C*dt + mort_C*dt - DON_s(1) * R_C2N_DON(1)) - DIC_s(1) = DIC_s(1) + DOC_r(n) - enddo - - !-------------------------------------------------------------------- - ! Iron sources from remineralization (follows ammonium but reduced) - ! only Fed_s(1) has remineralized sources - !-------------------------------------------------------------------- - - Fed_s(1) = Fed_s(1) + Am_s * R_Fe2N(1) * fr_dFe ! remineralization source - - !-------------------------------------------------------------------- - ! Conversion to dissolved Fe from Particulate requires DOC(1) - ! Otherwise the only source of dFe is from remineralization - !-------------------------------------------------------------------- - - if (tr_bgc_C .and. tr_bgc_Fe) then - if (DOCin(1) > c0) then - !if (Fed_tot/DOCin(1) > max_dfe_doc1) then - ! do n = 1,n_fed ! low saccharid:dFe ratio leads to - ! Fed_r_l(n) = Fedin(n)/t_iron_conv*dt/secday ! loss of bioavailable Fe to particulate fraction - ! Fep_tot_s = Fep_tot_s + Fed_r_l(n) - ! Fed_r(n) = Fed_r_l(n) ! removal due to particulate scavenging - ! enddo - ! do n = 1,n_fep - ! Fep_s(n) = rFep(n)* Fep_tot_s ! source from dissolved Fe - ! enddo - !elseif (Fed_tot/DOCin(1) < max_dfe_doc1) then - if (Fed_tot/DOCin(1) < max_dfe_doc1) then - do n = 1,n_fep ! high saccharid:dFe ratio leads to - Fep_r(n) = Fepin(n)/t_iron_conv*dt/secday ! gain of bioavailable Fe from particulate fraction - Fed_tot_s = Fed_tot_s + Fep_r(n) - enddo - do n = 1,n_fed - Fed_s(n) = Fed_s(n) + rFed(n)* Fed_tot_s ! source from particulate Fe - enddo - endif - endif !Docin(1) > c0 - endif - if (tr_bgc_Fe) then - do n = 1,n_fed - Fed_r(n) = Fed_r(n) + rFed(n)*Fed_tot_r ! scavenging + uptake - enddo - - ! source from algal mortality/grazing and fraction of remineralized nitrogen that does - ! not become immediately bioavailable - - do n = 1,n_fep - Fep_s(n) = Fep_s(n) + rFep(n)* (Am_s * R_Fe2N(1) * (c1-fr_dFe)) - enddo ! losses not direct to Fed - endif - - !-------------------------------------------------------------------- - ! Sulfur cycle begins here - !-------------------------------------------------------------------- - ! Grazing losses are channeled into rough spillage and assimilation - ! then onward and the MBJ mortality channel is included - ! It is assumed as a starting expedient that - ! DMSP loss to melting gives partial conversion to DMS in product layer - ! which then undergoes Stefels removal. - - !-------------------------------------------------------------------- - ! DMSPd reaction term (DMSPd conversion is outside the algal loop) - ! DMSPd_react = R_S2N*((fr_graze_s+fr_excrt_2S*fr_graze_e*fr_graze_a) - ! *fr_graze*grow_N + fr_mort2min*mort)*dt - ! - [\DMSPd]/t_sk_conv*dt - !-------------------------------------------------------------------- - do k = 1,n_algae - DMSPd_s_r = fr_resp_s * R_S2N(k) * resp(k) * dt !respiration fraction to DMSPd - DMSPd_s_mo= fr_mort2min * R_S2N(k)* mort(k) * dt !mortality and extracellular excretion - - DMSPd_s = DMSPd_s + DMSPd_s_r + DMSPd_s_mo - enddo - DMSPd_r = (c1/t_sk_conv) * (c1/secday) * (DMSPdin) * dt - - !-------------------------------------------------------------------- - ! DMS reaction term + DMSPd loss term - ! DMS_react = ([\DMSPd]*y_sk_DMS/t_sk_conv - c1/t_sk_ox *[\DMS])*dt - !-------------------------------------------------------------------- - - DMS_s_c = y_sk_DMS * DMSPd_r - DMS_r_o = DMSin * dt / (t_sk_ox * secday) - DMS_s = DMS_s_c - DMS_r = DMS_r_o - - !----------------------------------------------------------------------- - ! Load reaction array - !----------------------------------------------------------------------- - - dN = c0 - dC = c0 - do k = 1,n_algae - reactb(nlt_bgc_N(k)) = N_s(k) - N_r(k) - dN = dN + reactb(nlt_bgc_N(k)) - dC = dC + reactb(nlt_bgc_N(k)) * R_C2N(k) - enddo - if (tr_bgc_C) then - ! do k = 1,n_algae - ! reactb(nlt_bgc_C(k)) = R_C2N(k)*reactb(nlt_bgc_N(k)) - ! enddo - do k = 1,n_doc - reactb(nlt_bgc_DOC(k))= DOC_s(k) - DOC_r(k) - dC = dC + reactb(nlt_bgc_DOC(k)) - enddo - do k = 1,n_dic - reactb(nlt_bgc_DIC(k))= DIC_s(k) - DIC_r(k) - dC = dC + reactb(nlt_bgc_DIC(k)) - enddo - endif - reactb(nlt_bgc_Nit) = Nit_s - Nit_r - nitrification = Nit_s_n - dN = dN + reactb(nlt_bgc_Nit) - if (tr_bgc_Am) then - reactb(nlt_bgc_Am) = Am_s - Am_r - dN = dN + reactb(nlt_bgc_Am) - endif - if (tr_bgc_Sil) then - reactb(nlt_bgc_Sil) = - Sil_r - endif - if (tr_bgc_DON) then - do k = 1,n_don - reactb(nlt_bgc_DON(k))= DON_s(k) - DON_r(k) - dN = dN + reactb(nlt_bgc_DON(k)) - dC = dC + reactb(nlt_bgc_DON(k)) * R_C2N_DON(k) - enddo - endif - Cerror = dC - if (tr_bgc_Fe ) then - do k = 1,n_fed - reactb(nlt_bgc_Fed(k))= Fed_s (k) - Fed_r (k) - enddo - do k = 1,n_fep - reactb(nlt_bgc_Fep(k))= Fep_s (k) - Fep_r (k) - enddo - endif - if (tr_bgc_DMS) then - reactb(nlt_bgc_DMSPd) = DMSPd_s - DMSPd_r - reactb(nlt_bgc_DMS) = DMS_s - DMS_r - endif - if (tr_bgc_C) then - if (abs(dC) > max(puny,maxval(abs(reactb(:)))*1.0e-13_dbl_kind) .or. & - abs(dN) > max(puny,maxval(abs(reactb(:)))*1.0e-13_dbl_kind)) then - conserve_C = .false. - write(warning, *) 'Conservation error!' - call add_warning(warning) - if (tr_bgc_DON) then - write(warning, *) 'Error bound = max(puny,maxval(abs(reactb(:)))*1.0e-13_dbl_kind)' - call add_warning(warning) - write(warning, *) max(puny,maxval(abs(reactb(:)))*1.0e-13_dbl_kind) - call add_warning(warning) - write(warning, *) 'dN,DONin(1), kn_bac(1),secday,dt,n_doc' - call add_warning(warning) - write(warning, *) dN, DONin(1),kn_bac(1),secday,dt,n_doc - call add_warning(warning) - write(warning, *) 'reactb(nlt_bgc_DON(1)), DON_r(1),DON_s(1)' - call add_warning(warning) - write(warning, *) reactb(nlt_bgc_DON(1)),DON_r(1),DON_s(1) - call add_warning(warning) - end if - write(warning, *) 'dN,secday,dt,n_doc' - call add_warning(warning) - write(warning, *) dN,secday,dt,n_doc - call add_warning(warning) - write(warning, *) 'reactb(nlt_bgc_Nit),fr_resp' - call add_warning(warning) - write(warning, *) reactb(nlt_bgc_Nit),fr_resp - call add_warning(warning) - do k = 1,n_algae - write(warning, *) 'reactb(nlt_bgc_N(k)),fr_graze(k), grow_N(k), mort(k)' - call add_warning(warning) - write(warning, *) reactb(nlt_bgc_N(k)),fr_graze(k), grow_N(k), mort(k) - call add_warning(warning) - enddo - if (tr_bgc_Am) then - write(warning, *) 'reactb(nlt_bgc_Am),Am_r, Am_s' - call add_warning(warning) - write(warning, *) reactb(nlt_bgc_Am),Am_r, Am_s - call add_warning(warning) - end if - write(warning, *) 'dC' - call add_warning(warning) - write(warning, *) dC - call add_warning(warning) - do k = 1,n_doc - write(warning, *) 'DOCin' - call add_warning(warning) - write(warning, *) DOCin(k) - call add_warning(warning) - write(warning, *) 'reactb(nlt_bgc_DOC)' - call add_warning(warning) - write(warning, *) reactb(nlt_bgc_DOC(k)) - call add_warning(warning) - write(warning, *) 'DOC_r,DOC_s' - call add_warning(warning) - write(warning, *) DOC_r(k),DOC_s(k) - call add_warning(warning) - end do - do k = 1,n_dic - write(warning, *) 'DICin' - call add_warning(warning) - write(warning, *) DICin(k) - call add_warning(warning) - write(warning, *) 'reactb(nlt_bgc_DIC)' - call add_warning(warning) - write(warning, *) reactb(nlt_bgc_DIC(k)) - call add_warning(warning) - write(warning, *) 'DIC_r,DIC_s' - call add_warning(warning) - write(warning, *) DIC_r(k),DIC_s(k) - end do - write(warning, *) 'Zoo' - call add_warning(warning) - write(warning, *) Zoo - call add_warning(warning) - endif - endif - - end subroutine algal_dyn - -!======================================================================= -! -! Find ice-ocean flux when ice is thin and internal dynamics/reactions are -! assumed to be zero -! -! authors Nicole Jeffery, LANL - - subroutine thin_ice_flux (hin, hin_old, phin, Cin, flux_o_tot, & - source, i_grid,dt, nblyr, & - ocean_bio) - - use ice_constants_colpkg, only: c1, p5, c0 - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: & - phin - - real (kind=dbl_kind), dimension(nblyr+1), intent(inout) :: & - Cin ! initial concentration*hin_old*phin - - real (kind=dbl_kind), intent(in) :: & - hin_old , & ! brine thickness (m) - hin , & ! new brine thickness (m) - dt , & ! time step - source , & ! atm, ocean, dust flux (mmol/m^2) - ocean_bio ! ocean tracer concentration (mmol/m^3) - - real (kind=dbl_kind), intent(inout) :: & - flux_o_tot ! tracer flux, gravity+molecular drainage flux , - ! and boundary flux to ocean (mmol/m^2/s) - ! positive into the ocean - - real (kind=dbl_kind), dimension (nblyr + 1), intent(in) :: & - i_grid ! biology nondimensional grid interface points - - ! local variables - - integer (kind=int_kind) :: & - k ! vertical biology layer index - - real (kind=dbl_kind) :: & - sum_bio, & ! initial bio mass (mmol/m^2) - zspace, & ! 1/nblyr - dC, & ! added ocean bio mass (mmol/m^2) - dh ! change in thickness (m) - - zspace = c1/real(nblyr,kind=dbl_kind) - - dC = c0 - sum_bio = c0 - dh = hin-hin_old - - if (dh .le. c0) then ! keep the brine concentration fixed - sum_bio = (Cin(1)+Cin(nblyr+1))/hin_old*zspace*p5 - Cin(1) = Cin(1)/hin_old*hin - Cin(nblyr+1) = Cin(nblyr+1)/hin_old*hin - do k = 2, nblyr - sum_bio = sum_bio + Cin(k)/hin_old*zspace - Cin(k) = Cin(k)/hin_old*hin + dC - enddo - else - dC = dh*ocean_bio - do k = 1, nblyr+1 - Cin(k) = Cin(k) + dC - enddo - endif - - flux_o_tot = - dh*sum_bio/dt - dC/dt + source/dt - - end subroutine thin_ice_flux - -!======================================================================= -! -! Compute matrix elements for the low order solution of FEM-FCT scheme -! Predictor step -! -! July, 2014 by N. Jeffery -! - subroutine compute_FCT_matrix & - (C_in, sbdiag, dt, nblyr, & - diag, spdiag, rhs, bgrid, & - i_grid, darcyV, dhtop, dhbot,& - iphin_N, iDin, hbri_old, & - atm_add, bphin_N, & - C_top, C_bot, Qbot, Qtop, & - Sink_bot, Sink_top, & - D_sbdiag, D_spdiag, ML) - - use ice_constants_colpkg, only: c1, c0, p5, c2, puny - use ice_colpkg_shared, only: grid_o - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: & - C_in ! Initial (bulk) concentration*hbri_old (mmol/m^2) - ! conserved quantity on i_grid - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iDin ! Diffusivity on the igrid (1/s) - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - iphin_N ! Porosity with min condition on igrid - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bphin_N, & ! Porosity with min condition on igrid - bgrid - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - i_grid ! biology nondimensional grid layer points - - real (kind=dbl_kind), dimension (nblyr+1), & - intent(out) :: & - sbdiag , & ! sub-diagonal matrix elements - diag , & ! diagonal matrix elements - spdiag , & ! super-diagonal matrix elements - rhs , & ! rhs of tri-diagonal matrix eqn. - ML, & ! lumped mass matrix - D_spdiag, D_sbdiag ! artificial diffusion matrix - - real (kind=dbl_kind), intent(in) :: & - dhtop , & ! Change in brine top (m) - dhbot , & ! Change in brine bottom (m) - hbri_old , & ! brine height (m) - atm_add , & ! atm-ice flux - C_top , & ! bulk surface source (mmol/m^2) - C_bot , & ! bulk bottom source (mmol/m^2) - darcyV ! Darcy velocity (m/s - - real (kind=dbl_kind), intent(inout) :: & ! positive into ice - Qtop , & ! top flux source (mmol/m^2/s) - Qbot , & ! bottom flux source (mmol/m^2/s) - Sink_bot , & ! rest of bottom flux (sink or source) (mmol/m^2/s) - Sink_top ! rest oftop flux (sink or source) (mmol/m^2/s) - - ! local variables - - real (kind=dbl_kind) :: & - vel, vel2, dphi_dx, vel_tot, zspace, dphi - - integer (kind=int_kind) :: & - k ! vertical index - - real (kind=dbl_kind), dimension (nblyr+1) :: & - Q_top, Q_bot, & ! surface and bottom source - K_diag, K_spdiag, K_sbdiag, & ! advection matrix - S_diag, S_spdiag, S_sbdiag, & ! diffusion matrix - D_diag, iDin_phi - - real (kind=dbl_kind), dimension (nblyr) :: & - kvector1, kvectorn1 - -!--------------------------------------------------------------------- -! Diag (jj) solve for j = 1:nblyr+1 -! spdiag(j) == (j,j+1) solve for j = 1:nblyr otherwise 0 -! sbdiag(j) == (j,j-1) solve for j = 2:nblyr+1 otherwise 0 -!--------------------------------------------------------------------- - kvector1(:) = c0 - kvector1(1) = c1 - kvectorn1(:) = c1 - kvectorn1(1) = c0 - - zspace = c1/real(nblyr,kind=dbl_kind) - Qbot = c0 - Qtop = c0 - Sink_bot = c0 - Sink_top = c0 - -! compute the lumped mass matrix - - ML(:) = zspace - ML(1) = zspace/c2 - ML(nblyr+1) = zspace/c2 - -! compute matrix K: K_diag , K_sbdiag, K_spdiag -! compute matrix S: S_diag, S_sbdiag, S_spdiag - - K_diag(:) = c0 - D_diag(:) = c0 - D_spdiag(:) = c0 - D_sbdiag(:) = c0 - K_spdiag(:) = c0 - K_sbdiag(:) = c0 - S_diag(:) = c0 - S_spdiag(:) = c0 - S_sbdiag(:) = c0 - iDin_phi(:) = c0 - - - iDin_phi(1) = c0 !element 1 - iDin_phi(nblyr+1) = iDin(nblyr+1)/iphin_N(nblyr+1) !outside ice at bottom - iDin_phi(nblyr) = p5*(iDin(nblyr+1)/iphin_N(nblyr+1)+iDin(nblyr)/iphin_N(nblyr)) - - vel = (bgrid(2)*dhbot - (bgrid(2)-c1)*dhtop)/dt+darcyV/bphin_N(2) - K_diag(1) = p5*vel/hbri_old - dphi_dx = (iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) - vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1) - vel = vel/hbri_old - vel2 = (dhbot/hbri_old/dt +darcyV/hbri_old) - K_diag(nblyr+1) = min(c0, vel2) - iDin_phi(nblyr+1)/(zspace+ grid_o/hbri_old) & - + p5*(-vel + iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx) - - do k = 1, nblyr-1 - vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt+darcyV/bphin_N(k+1) - iDin_phi(k+1) = p5*(iDin(k+2)/iphin_N(k+2) + iDin(k+1)/iphin_N(k+1)) - dphi_dx = (iphin_N(k+1) - iphin_N(k))/(zspace) - K_spdiag(k)= p5*(vel/hbri_old - & - iDin_phi(k)/(bphin_N(k+1))*dphi_dx) - - vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt +darcyV/bphin_N(k+1) - dphi_dx = c0 - dphi_dx = kvectorn1(k)*(iphin_N(k+1) - iphin_N(k))/(zspace) - K_sbdiag(k+1)= -p5*(vel/hbri_old- & - iDin_phi(k)/bphin_N(k+1)*dphi_dx) - K_diag(k) = K_diag(1)*kvector1(k) + (K_spdiag(k) + K_sbdiag(k))*kvectorn1(k) - - S_diag(k+1) = -(iDin_phi(k)+ iDin_phi(k+1))/zspace - S_spdiag(k) = iDin_phi(k)/zspace - S_sbdiag(k+1) = iDin_phi(k)/zspace - enddo - - !k = nblyr - - vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt+darcyV/bphin_N(nblyr+1) - dphi_dx = (iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) - K_spdiag(nblyr)= p5*(vel/hbri_old - & - iDin_phi(nblyr)/(bphin_N(nblyr+1))*dphi_dx) - vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1) - dphi_dx = kvectorn1(nblyr)*(iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) - K_sbdiag(nblyr+1)= -p5*(vel/hbri_old- & - iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx) - K_diag(nblyr) = K_spdiag(nblyr) + K_sbdiag(nblyr) - S_diag(nblyr+1) = -iDin_phi(nblyr)/zspace - S_spdiag(nblyr) = iDin_phi(nblyr)/zspace - S_sbdiag(nblyr+1) = iDin_phi(nblyr)/zspace - -! compute matrix artificial D: D_spdiag, D_diag (D_spdiag(k) = D_sbdiag(k+1)) - - do k = 1,nblyr - D_spdiag(k) = max(-K_spdiag(k), c0, -K_sbdiag(k+1)) - D_sbdiag(k+1) = D_spdiag(k) - enddo - do k = 1,nblyr+1 - D_diag(k) = D_diag(k) - D_spdiag(k) - D_sbdiag(k) - enddo - -! compute Q_top and Q_bot: top and bottom sources - - vel2 = -(dhtop/hbri_old/dt +darcyV/bphin_N(1)/hbri_old) - - Q_top(:) = c0 - Q_top(1) = max(c0,vel2*C_top + atm_add/dt) - Qtop = Q_top(1) - - vel = (dhbot/hbri_old/dt +darcyV/hbri_old) ! going from iphin_N(nblyr+1) to c1 makes a difference - - Q_bot(:) = c0 - Q_bot(nblyr+1) = max(c0,vel*C_bot) + iDin_phi(nblyr+1)*C_bot& - /(zspace + grid_o/hbri_old) - - Qbot = Q_bot(nblyr+1) - - Sink_bot = K_diag(nblyr+1) + K_spdiag(nblyr) - Sink_top = K_diag(1) + K_sbdiag(2) - -!compute matrix elements (1 to nblyr+1) - - spdiag = -dt * (D_spdiag + K_spdiag + S_spdiag) - sbdiag = -dt * (D_sbdiag + K_sbdiag + S_sbdiag) - diag = ML - dt * (D_diag + K_diag + S_diag) - rhs = ML * C_in + dt * Q_top + dt* Q_bot - - end subroutine compute_FCT_matrix - -!======================================================================= -! -! Compute matrices for final solution FCT for passive tracers -! Corrector step -! -! July, 2014 by N. Jeffery -! - subroutine compute_FCT_corr & - (C_in, C_low, dt, nblyr, & - D_sbdiag, D_spdiag, ML) - - use ice_constants_colpkg, only: c1, c0, c6, puny - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: & - C_in ! Initial (bulk) concentration*hbri_old (mmol/m^2) - ! conserved quantity on igrid - - real (kind=dbl_kind), dimension(nblyr+1), intent(inout) :: & - C_low ! Low order solution (mmol/m^2) corrected - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), dimension (nblyr+1), & - intent(in) :: & - D_sbdiag , & ! sub-diagonal artificial diffusion matrix elements - ML , & ! Lumped mass diagonal matrix elements - D_spdiag ! super-diagonal artificial diffusion matrix elements - - ! local variables - - real (kind=dbl_kind) :: & - zspace - - integer (kind=int_kind) :: & - k ! vertical index - - real (kind=dbl_kind), dimension (nblyr+1) :: & - M_spdiag, M_sbdiag, & ! mass matrix - F_diag, F_spdiag, F_sbdiag, & ! anti-diffusive matrix - Pplus, Pminus, & ! - Qplus, Qminus, & ! - Rplus, Rminus, & ! - a_spdiag, a_sbdiag ! weightings of F - -!--------------------------------------------------------------------- -! Diag (jj) solve for j = 1:nblyr+1 -! spdiag(j) == (j,j+1) solve for j = 1:nblyr otherwise 0 -! sbdiag(j) == (j,j-1) solve for j = 2:nblyr+1 otherwise 0 -!--------------------------------------------------------------------- - - zspace = c1/real(nblyr,kind=dbl_kind) - -! compute the mass matrix - - M_spdiag(:) = zspace/c6 - M_spdiag(nblyr+1) = c0 - M_sbdiag(:) = zspace/c6 - M_sbdiag(1) = c0 - -! compute off matrix F: - - F_diag(:) = c0 - F_spdiag(:) = c0 - F_sbdiag(:) = c0 - - do k = 1, nblyr - F_spdiag(k) = M_spdiag(k)*(C_low(k)-C_in(k) - C_low(k+1)+ C_in(k+1))/dt & - + D_spdiag(k)*(C_low(k)-C_low(k+1)) - F_sbdiag(k+1) = M_sbdiag(k+1)*(C_low(k+1)-C_in(k+1) - C_low(k)+ C_in(k))/dt & - + D_sbdiag(k+1)*(C_low(k+1)-C_low(k)) - - if (F_spdiag(k)*(C_low(k) - C_low(k+1)) > c0) F_spdiag(k) = c0 - if (F_sbdiag(k+1)*(C_low(k+1) - C_low(k)) > c0) F_sbdiag(k+1) = c0 - enddo - - if (maxval(abs(F_spdiag)) > c0) then - -! compute the weighting factors: a_spdiag, a_sbdiag - - a_spdiag(:) = c0 - a_sbdiag(:) = c0 - - Pplus(1) = max(c0, F_spdiag(1)) - Pminus(1) = min(c0, F_spdiag(1)) - Pplus(nblyr+1) = max(c0, F_sbdiag(nblyr+1)) - Pminus(nblyr+1) = min(c0, F_sbdiag(nblyr+1)) - Qplus(1) = max(c0,C_low(2)-C_low(1)) - Qminus(1)= min(c0,C_low(2)-C_low(1)) - Qplus(nblyr+1) = max(c0,C_low(nblyr)-C_low(nblyr+1)) - Qminus(nblyr+1)= min(c0,C_low(nblyr)-C_low(nblyr+1)) - Rplus(1) = min(c1, ML(1)*Qplus(1)/dt/(Pplus(1)+puny)) - Rminus(1) = min(c1, ML(1)*Qminus(1)/dt/(Pminus(1)-puny)) - Rplus(nblyr+1) = min(c1, ML(nblyr+1)*Qplus(nblyr+1)/dt/(Pplus(nblyr+1)+puny)) - Rminus(nblyr+1) = min(c1, ML(nblyr+1)*Qminus(nblyr+1)/dt/(Pminus(nblyr+1)-puny)) - do k = 2,nblyr - Pplus(k) = max(c0,F_spdiag(k)) + max(c0,F_sbdiag(k)) - Pminus(k) = min(c0,F_spdiag(k)) + min(c0,F_sbdiag(k)) - Qplus(k) = max(c0, max(C_low(k+1)-C_low(k),C_low(k-1)-C_low(k))) - Qminus(k) = min(c0, min(C_low(k+1)-C_low(k),C_low(k-1)-C_low(k))) - Rplus(k) = min(c1, ML(k)*Qplus(k)/dt/(Pplus(k)+puny)) - Rminus(k) = min(c1, ML(k)*Qminus(k)/dt/(Pminus(k)-puny)) - enddo - - do k = 1, nblyr - a_spdiag(k) = min(Rminus(k),Rplus(k+1)) - if (F_spdiag(k) > c0) a_spdiag(k) = min(Rplus(k),Rminus(k+1)) - a_sbdiag(k+1) = min(Rminus(k+1),Rplus(k)) - if (F_sbdiag(k+1) > c0) a_sbdiag(k+1) = min(Rplus(k+1),Rminus(k)) - enddo - -!compute F_diag: - - F_diag(1) = a_spdiag(1)*F_spdiag(1) - F_diag(nblyr+1) = a_sbdiag(nblyr+1)* F_sbdiag(nblyr+1) - C_low(1) = C_low(1) + dt*F_diag(1)/ML(1) - C_low(nblyr+1) = C_low(nblyr+1) + dt*F_diag(nblyr+1)/ML(nblyr+1) - - do k = 2,nblyr - F_diag(k) = a_spdiag(k)*F_spdiag(k) + a_sbdiag(k)*F_sbdiag(k) - C_low(k) = C_low(k) + dt*F_diag(k)/ML(k) - enddo - - endif !F_spdiag is nonzero - - end subroutine compute_FCT_corr - -!======================================================================= -! -! Tridiagonal matrix solver-- for salinity -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW -! - subroutine tridiag_solverz (nmat, sbdiag, & - diag, spdiag, & - rhs, xout) - - integer (kind=int_kind), intent(in) :: & - nmat ! matrix dimension - - real (kind=dbl_kind), dimension (nmat), & - intent(in) :: & - sbdiag , & ! sub-diagonal matrix elements - diag , & ! diagonal matrix elements - spdiag , & ! super-diagonal matrix elements - rhs ! rhs of tri-diagonal matrix eqn. - - real (kind=dbl_kind), dimension (nmat), & - intent(inout) :: & - xout ! solution vector - - ! local variables - - integer (kind=int_kind) :: & - k ! row counter - - real (kind=dbl_kind) :: & - wbeta ! temporary matrix variable - - real (kind=dbl_kind), dimension(nmat):: & - wgamma ! temporary matrix variable - - wbeta = diag(1) - xout(1) = rhs(1) / wbeta - - do k = 2, nmat - wgamma(k) = spdiag(k-1) / wbeta - wbeta = diag(k) - sbdiag(k)*wgamma(k) - xout(k) = (rhs(k) - sbdiag(k)*xout(k-1)) & - / wbeta - enddo ! k - - do k = nmat-1, 1, -1 - xout(k) = xout(k) - wgamma(k+1)*xout(k+1) - enddo ! k - - end subroutine tridiag_solverz - -!======================================================================= -! -! authors Nicole Jeffery, LANL - - subroutine check_conservation_FCT & - (C_init, C_new, C_low, S_top, & - S_bot, L_bot, L_top, dt, & - fluxbio, l_stop, nblyr, & - source) - - use ice_constants_colpkg, only: p5, c1, c4, c0 - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: & - C_init , & ! initial bulk concentration * h_old (mmol/m^2) - C_new ! new bulk concentration * h_new (mmol/m^2) - - real (kind=dbl_kind), dimension(nblyr+1), intent(out) :: & - C_low ! define low order solution = C_new - - real (kind=dbl_kind), intent(in) :: & - S_top , & ! surface flux into ice (mmol/m^2/s) - S_bot , & ! bottom flux into ice (mmol/m^2/s) - L_bot , & ! remaining bottom flux into ice (mmol/m^2/s) - L_top , & ! remaining top flux into ice (mmol/m^2/s) - dt , & - source ! nutrient source from snow and atmosphere (mmol/m^2) - - real (kind=dbl_kind), intent(inout) :: & - fluxbio ! (mmol/m^2/s) positive down (into the ocean) - - logical (kind=log_kind), intent(inout) :: & - l_stop ! false if conservation satisfied within error - - ! local variables - - integer (kind=int_kind) :: & - k - - real (kind=dbl_kind) :: & - diff_dt , & - C_init_tot , & - C_new_tot , & - zspace , & !1/nblyr - accuracy ! centered difference is Order(zspace^2) - - character(len=char_len_long) :: & - warning ! warning message - - zspace = c1/real(nblyr,kind=dbl_kind) - l_stop = .false. - - !------------------------------------- - ! Ocean flux: positive into the ocean - !------------------------------------- - C_init_tot = (C_init(1) + C_init(nblyr+1))*zspace*p5 - C_new_tot = (C_new(1) + C_new(nblyr+1))*zspace*p5 - C_low(1) = C_new(1) - C_low(nblyr+1) = C_new(nblyr+1) - - do k = 2, nblyr - C_init_tot = C_init_tot + C_init(k)*zspace - C_new_tot = C_new_tot + C_new(k)*zspace - C_low(k) = C_new(k) - enddo - - accuracy = 1.0e-11_dbl_kind*max(c1, C_init_tot, C_new_tot) - fluxbio = fluxbio + (C_init_tot - C_new_tot + source)/dt - diff_dt =C_new_tot - C_init_tot - (S_top+S_bot+L_bot*C_new(nblyr+1)+L_top*C_new(1))*dt - - if (minval(C_low) < c0) then - write(warning,*) 'Positivity of zbgc low order solution failed: C_low:',C_low - call add_warning(warning) - l_stop = .true. - endif - - if (abs(diff_dt) > accuracy ) then - l_stop = .true. - write(warning,*) 'Conservation of zbgc low order solution failed: diff_dt:',& - diff_dt - call add_warning(warning) - write(warning,*) 'Total initial tracer', C_init_tot - call add_warning(warning) - write(warning,*) 'Total final1 tracer', C_new_tot - call add_warning(warning) - write(warning,*) 'bottom final tracer', C_new(nblyr+1) - call add_warning(warning) - write(warning,*) 'top final tracer', C_new(1) - call add_warning(warning) - write(warning,*) 'Near bottom final tracer', C_new(nblyr) - call add_warning(warning) - write(warning,*) 'Near top final tracer', C_new(2) - call add_warning(warning) - write(warning,*) 'Top flux*dt into ice:', S_top*dt - call add_warning(warning) - write(warning,*) 'Bottom flux*dt into ice:', S_bot*dt - call add_warning(warning) - write(warning,*) 'Remaining bot flux*dt into ice:', L_bot*C_new(nblyr+1)*dt - call add_warning(warning) - write(warning,*) 'S_bot*dt + L_bot*C_new(nblyr+1)*dt' - call add_warning(warning) - write(warning,*) S_bot*dt + L_bot*C_new(nblyr+1)*dt - call add_warning(warning) - write(warning,*) 'fluxbio*dt:', fluxbio*dt - call add_warning(warning) - write(warning,*) 'fluxbio:', fluxbio - call add_warning(warning) - write(warning,*) 'Remaining top flux*dt into ice:', L_top*C_new(1)*dt - call add_warning(warning) - endif - - end subroutine check_conservation_FCT - -!======================================================================= - -! For each grid cell, sum field over all ice and snow layers -! -! author: Nicole Jeffery, LANL - - subroutine bgc_column_sum (nblyr, nslyr, hsnow, hbrine, xin, xout) - - use ice_colpkg_shared, only: hs_ssl - use ice_constants_colpkg, only: p5, c1, c0 - - integer (kind=int_kind), intent(in) :: & - nblyr, & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), dimension(nblyr+3), intent(in) :: & - xin ! input field - - real (kind=dbl_kind), intent(in) :: & - hsnow, & ! snow thickness - hbrine ! brine height - - real (kind=dbl_kind), intent(out) :: & - xout ! output field - - ! local variables - - real (kind=dbl_kind) :: & - dzssl, & ! snow surface layer (m) - dzint, & ! snow interior depth (m) - hslyr, & ! snow layer thickness (m) - zspace ! brine layer thickness/hbrine - - integer (kind=int_kind) :: & - n ! category/layer index - - hslyr = hsnow/real(nslyr,kind=dbl_kind) - dzssl = min(hslyr*p5, hs_ssl) - dzint = max(c0,hsnow - dzssl) - zspace = c1/real(nblyr,kind=dbl_kind) - - xout = c0 - xout = (xin(1) + xin(nblyr+1))*hbrine*p5*zspace - do n = 2, nblyr - xout = xout + xin(n)*zspace*hbrine - enddo ! n - xout = xout + dzssl*xin(nblyr+2) + dzint*xin(nblyr+3) - - end subroutine bgc_column_sum - -!======================================================================= - -! Find the total carbon concentration by summing the appropriate -! biogeochemical tracers in units of mmol C/m2 -! -! author: Nicole Jeffery, LANL - - subroutine bgc_carbon_sum (nblyr, hbrine, xin, xout, n_doc, n_dic, n_algae, n_don) - - use ice_colpkg_shared, only: hs_ssl, R_C2N, R_C2N_DON - use ice_constants_colpkg, only: p5, c1, c0 - use ice_colpkg_tracers, only: tr_bgc_N, tr_bgc_C, tr_bgc_hum, & - tr_bgc_DON, nt_bgc_hum, nt_bgc_N, nt_bgc_DOC, nt_bgc_DIC, nt_bgc_DON - - integer (kind=int_kind), intent(in) :: & - nblyr, & ! number of ice layers - n_doc, n_dic, n_algae, n_don - - real (kind=dbl_kind), dimension(:), intent(in) :: & - xin ! input field, all tracers and column - - real (kind=dbl_kind), intent(in) :: & - hbrine ! brine height - - real (kind=dbl_kind), intent(out) :: & - xout ! output field mmol/m2 carbon - - ! local variables - - real (kind=dbl_kind), dimension(nblyr+1) :: & - zspace ! brine layer thickness/hbrine - - integer (kind=int_kind) :: & - n, m, iBioCount, iLayer, nBGC ! category/layer index - - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5*zspace(1) - zspace(nblyr+1) = zspace(1) - - xout = c0 - - if (tr_bgc_N) then - iBioCount = c0 - do m = 1, n_algae - nBGC = nt_bgc_N(1) - do n = 1, nblyr+1 - iLayer = iBioCount + n-1 - xout = xout + xin(nBGC+iLayer)*zspace(n)*hbrine*R_C2N(m) - enddo - iBioCount = iBioCount + nblyr+3 - enddo - endif - if (tr_bgc_C) then - iBioCount = c0 - nBGC = nt_bgc_DOC(1) - do m = 1, n_doc - do n = 1, nblyr+1 - iLayer = iBioCount + n-1 - xout = xout + xin(nBGC+iLayer)*zspace(n)*hbrine - enddo - iBioCount = iBioCount + nblyr+3 - enddo - do m = 1, n_dic - do n = 1, nblyr+1 - iLayer = iBioCount + n-1 - xout = xout + xin(nBGC+iLayer)*zspace(n)*hbrine - enddo - iBioCount = iBioCount + nblyr+3 - enddo - endif - - if (tr_bgc_DON) then - iBioCount = c0 - do m = 1, n_don - nBGC = nt_bgc_DON(1) - do n = 1, nblyr+1 - iLayer = iBioCount + n-1 - xout = xout + xin(nBGC+iLayer)*zspace(n)*hbrine*R_C2N_DON(m) - enddo - iBioCount = iBioCount + nblyr+3 - enddo - endif - if (tr_bgc_hum) then - nBGC = nt_bgc_hum - do n = 1, nblyr+1 - iLayer = n-1 - xout = xout + xin(nBGC+iLayer)*zspace(n)*hbrine - enddo - endif - - end subroutine bgc_carbon_sum - -!======================================================================= - -! Find the total carbon flux by summing the fluxes for the appropriate -! biogeochemical each grid cell, sum field over all ice and snow layers -! -! author: Nicole Jeffery, LANL - - subroutine bgc_carbon_flux (flux_bio_atm, flux_bion, n_doc, & - n_dic, n_algae, n_don, Tot_Carbon_flux) - - use ice_colpkg_shared, only: R_C2N, R_C2N_DON - use ice_constants_colpkg, only: c0 - use ice_colpkg_tracers, only: tr_bgc_N, tr_bgc_C, tr_bgc_hum, & - tr_bgc_DON, nlt_bgc_hum, nlt_bgc_N, nlt_bgc_C, nlt_bgc_DOC, & - nlt_bgc_DIC, nlt_bgc_DON - - integer (kind=int_kind), intent(in) :: & - n_doc, n_dic, n_algae, n_don - - real (kind=dbl_kind), dimension(:), intent(in) :: & - flux_bio_atm, & ! input field, all tracers and column - flux_bion - - real (kind=dbl_kind), intent(out) :: & - Tot_Carbon_flux ! output field mmol/m2/s carbon - - ! local variables - integer (kind=int_kind) :: & - m ! biology index - - Tot_Carbon_flux = c0 - - if (tr_bgc_N) then - do m = 1, n_algae - Tot_Carbon_flux = Tot_Carbon_flux - (flux_bio_atm(nlt_bgc_N(m)) - flux_bion(nlt_bgc_N(m)))*R_C2N(m) - enddo - endif - if (tr_bgc_C) then - do m = 1, n_doc - Tot_Carbon_flux = Tot_Carbon_flux - flux_bio_atm(nlt_bgc_DOC(m)) + flux_bion(nlt_bgc_DOC(m)) - enddo - do m = 1, n_dic - Tot_Carbon_flux = Tot_Carbon_flux - flux_bio_atm(nlt_bgc_DIC(m)) + flux_bion(nlt_bgc_DIC(m)) - enddo - endif - if (tr_bgc_DON) then - do m = 1, n_don - Tot_Carbon_flux = Tot_Carbon_flux - (flux_bio_atm(nlt_bgc_DON(m)) - flux_bion(nlt_bgc_DON(m)))*R_C2N_DON(m) - enddo - endif - if (tr_bgc_hum) & - Tot_Carbon_flux = Tot_Carbon_flux - flux_bio_atm(nlt_bgc_hum) + flux_bion(nlt_bgc_hum) - - end subroutine bgc_carbon_flux - -!======================================================================= - - end module ice_algae - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_atmo.F90 b/components/mpas-seaice/src/column/ice_atmo.F90 deleted file mode 100644 index 55bbf3c975f1..000000000000 --- a/components/mpas-seaice/src/column/ice_atmo.F90 +++ /dev/null @@ -1,837 +0,0 @@ -! SVN:$Id: ice_atmo.F90 1182 2017-03-16 19:29:26Z njeffery $ -!======================================================================= - -! Atmospheric boundary interface (stability based flux calculations) - -! author: Elizabeth C. Hunke, LANL -! -! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb -! 2004: Block structure added by William Lipscomb -! 2006: Converted to free source form (F90) by Elizabeth Hunke -! 2013: Form drag routine added (neutral_drag_coeffs) by David Schroeder -! 2014: Adjusted form drag and added high frequency coupling by Andrew Roberts - - module ice_atmo - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, c4, c5, c8, c10, & - c16, c20, p001, p01, p2, p4, p5, p75, puny, & - cp_wv, cp_air, iceruf, zref, qqqice, TTTice, qqqocn, TTTocn, & - Lsub, Lvap, vonkar, Tffresh, zvir, gravit, & - pih, rhoi, rhos, rhow - use ice_colpkg_shared, only: dragio - - implicit none - save - - private - public :: atmo_boundary_layer, atmo_boundary_const, neutral_drag_coeffs - - real(kind=dbl_kind), public :: & - latentHeatActive = c1 - -!======================================================================= - - contains - -!======================================================================= - -! Compute coefficients for atm/ice fluxes, stress, and reference -! temperature and humidity. NOTE: \\ -! (1) All fluxes are positive downward, \\ -! (2) Here, tstar = (WT)/U*, and qstar = (WQ)/U*, \\ -! (3a) wind speeds should all be above a minimum speed (eg. 1.0 m/s). \\ -! -! ASSUME: -! The saturation humidity of air at T(K): qsat(T) (kg/m**3) -! -! Code originally based on CSM1 - - subroutine atmo_boundary_layer (sfctype, & - calc_strair, formdrag, & - highfreq, natmiter, & - Tsf, potT, & - uatm, vatm, & - wind, zlvl, & - Qa, rhoa, & - strx, stry, & - Tref, Qref, & - delt, delq, & - lhcoef, shcoef, & - Cdn_atm, & - Cdn_atm_ratio_n, & - uvel, vvel, & - Uref) - - character (len=3), intent(in) :: & - sfctype ! ice or ocean - - logical (kind=log_kind), intent(in) :: & - calc_strair, & ! if true, calculate wind stress components - formdrag, & ! if true, calculate form drag - highfreq ! if true, use high frequency coupling - - integer (kind=int_kind), intent(in) :: & - natmiter ! number of iterations for boundary layer calculations - - real (kind=dbl_kind), intent(in) :: & - Tsf , & ! surface temperature of ice or ocean - potT , & ! air potential temperature (K) - uatm , & ! x-direction wind speed (m/s) - vatm , & ! y-direction wind speed (m/s) - wind , & ! wind speed (m/s) - zlvl , & ! atm level height (m) - Qa , & ! specific humidity (kg/kg) - rhoa ! air density (kg/m^3) - - real (kind=dbl_kind), intent(inout) :: & - Cdn_atm ! neutral drag coefficient - - real (kind=dbl_kind), intent(out) :: & - Cdn_atm_ratio_n ! ratio drag coeff / neutral drag coeff - - real (kind=dbl_kind), & - intent(inout) :: & - strx , & ! x surface stress (N) - stry ! y surface stress (N) - - real (kind=dbl_kind), intent(inout) :: & - Tref , & ! reference height temperature (K) - Qref , & ! reference height specific humidity (kg/kg) - delt , & ! potential T difference (K) - delq , & ! humidity difference (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - real (kind=dbl_kind), intent(in) :: & - uvel , & ! x-direction ice speed (m/s) - vvel ! y-direction ice speed (m/s) - - real (kind=dbl_kind), intent(out) :: & - Uref ! reference height wind speed (m/s) - - ! local variables - - integer (kind=int_kind) :: & - k ! iteration index - - real (kind=dbl_kind) :: & - TsfK , & ! surface temperature in Kelvin (K) - xqq , & ! temporary variable - psimh , & ! stability function at zlvl (momentum) - tau , & ! stress at zlvl - fac , & ! interpolation factor - al2 , & ! ln(z10 /zTrf) - psix2 , & ! stability function at zTrf (heat and water) - psimhs, & ! stable profile - ssq , & ! sat surface humidity (kg/kg) - qqq , & ! for qsat, dqsfcdt - TTT , & ! for qsat, dqsfcdt - qsat , & ! the saturation humidity of air (kg/m^3) - Lheat , & ! Lvap or Lsub, depending on surface type - umin ! minimum wind speed (m/s) - - real (kind=dbl_kind) :: & - ustar , & ! ustar (m/s) - ustar_prev , & ! ustar_prev (m/s) - tstar , & ! tstar - qstar , & ! qstar - rdn , & ! sqrt of neutral exchange coefficient (momentum) - rhn , & ! sqrt of neutral exchange coefficient (heat) - ren , & ! sqrt of neutral exchange coefficient (water) - rd , & ! sqrt of exchange coefficient (momentum) - re , & ! sqrt of exchange coefficient (water) - rh , & ! sqrt of exchange coefficient (heat) - vmag , & ! surface wind magnitude (m/s) - alz , & ! ln(zlvl /z10) - thva , & ! virtual temperature (K) - cp , & ! specific heat of moist air - hol , & ! H (at zlvl ) over L - stable, & ! stability factor - psixh ! stability function at zlvl (heat and water) - - real (kind=dbl_kind), parameter :: & - cpvir = cp_wv/cp_air-c1, & ! defined as cp_wv/cp_air - 1. - zTrf = c2 ! reference height for air temp (m) - - ! local functions - real (kind=dbl_kind) :: & - xd , & ! dummy argument - psimhu, & ! unstable part of psimh - psixhu ! unstable part of psimx - - !------------------------------------------------------------ - ! Define functions - !------------------------------------------------------------ - - psimhu(xd) = log((c1+xd*(c2+xd))*(c1+xd*xd)/c8) & - - c2*atan(xd) + pih -!ech - c2*atan(xd) + 1.571_dbl_kind - - psixhu(xd) = c2 * log((c1 + xd*xd)/c2) - - al2 = log(zref/zTrf) - - !------------------------------------------------------------ - ! Initialize - !------------------------------------------------------------ - - if (highfreq) then - umin = p5 ! minumum allowable wind-ice speed difference of 0.5 m/s - else - umin = c1 ! minumum allowable wind speed of 1m/s - endif - - Tref = c0 - Qref = c0 - Uref = c0 - delt = c0 - delq = c0 - shcoef = c0 - lhcoef = c0 - - !------------------------------------------------------------ - ! Compute turbulent flux coefficients, wind stress, and - ! reference temperature and humidity. - !------------------------------------------------------------ - - !------------------------------------------------------------ - ! define variables that depend on surface type - !------------------------------------------------------------ - - if (sfctype(1:3)=='ice') then - - qqq = qqqice ! for qsat - TTT = TTTice ! for qsat - Lheat = Lsub ! ice to vapor - - if (highfreq) then - vmag = max(umin, sqrt( (uatm-uvel)**2 + & - (vatm-vvel)**2) ) - else - vmag = max(umin, wind) - endif - - if (formdrag .and. Cdn_atm > puny) then - rdn = sqrt(Cdn_atm) - else - rdn = vonkar/log(zref/iceruf) ! neutral coefficient - Cdn_atm = rdn * rdn - endif - - elseif (sfctype(1:3)=='ocn') then - - qqq = qqqocn - TTT = TTTocn - Lheat = Lvap ! liquid to vapor - vmag = max(umin, wind) - rdn = sqrt(0.0027_dbl_kind/vmag & - + .000142_dbl_kind + .0000764_dbl_kind*vmag) - - endif ! sfctype - - !------------------------------------------------------------ - ! define some more needed variables - !------------------------------------------------------------ - - TsfK = Tsf + Tffresh ! surface temp (K) - qsat = qqq * exp(-TTT/TsfK) ! saturation humidity (kg/m^3) - ssq = qsat / rhoa ! sat surf hum (kg/kg) - - thva = potT * (c1 + zvir * Qa) ! virtual pot temp (K) - delt = potT - TsfK ! pot temp diff (K) - delq = Qa - ssq ! spec hum dif (kg/kg) - alz = log(zlvl/zref) - cp = cp_air*(c1 + cpvir*ssq) - - !------------------------------------------------------------ - ! first estimate of Z/L and ustar, tstar and qstar - !------------------------------------------------------------ - - ! neutral coefficients, z/L = 0.0 - rhn = rdn - ren = rdn - - ! ustar,tstar,qstar - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - !------------------------------------------------------------ - ! iterate to converge on Z/L, ustar, tstar and qstar - !------------------------------------------------------------ - - ustar_prev = c2 * ustar - - k = 1 - do while (abs(ustar - ustar_prev)/ustar > 0 .and. k <= natmiter) - - ustar_prev = ustar - k = k + 1 - - ! compute stability & evaluate all stability functions - hol = vonkar * gravit * zlvl & - * (tstar/thva & - + qstar/(c1/zvir+Qa)) & - / ustar**2 - hol = sign( min(abs(hol),c10), hol ) - stable = p5 + sign(p5 , hol) - xqq = max(sqrt(abs(c1 - c16*hol)) , c1) - xqq = sqrt(xqq) - - ! Jordan et al 1999 - psimhs = -(0.7_dbl_kind*hol & - + 0.75_dbl_kind*(hol-14.3_dbl_kind) & - * exp(-0.35_dbl_kind*hol) + 10.7_dbl_kind) - psimh = psimhs*stable & - + (c1 - stable)*psimhu(xqq) - psixh = psimhs*stable & - + (c1 - stable)*psixhu(xqq) - - ! shift all coeffs to measurement height and stability - rd = rdn / (c1+rdn/vonkar*(alz-psimh)) - rh = rhn / (c1+rhn/vonkar*(alz-psixh)) - re = ren / (c1+ren/vonkar*(alz-psixh)) - - ! update ustar, tstar, qstar using updated, shifted coeffs - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - enddo ! end iteration - - if (calc_strair) then - - ! initialize - strx = c0 - stry = c0 - - if (highfreq .and. sfctype(1:3)=='ice') then - - !------------------------------------------------------------ - ! momentum flux for RASM - !------------------------------------------------------------ - ! tau = rhoa * rd * rd - ! strx = tau * |Uatm-U| * (uatm-u) - ! stry = tau * |Uatm-U| * (vatm-v) - !------------------------------------------------------------ - - tau = rhoa * rd * rd ! not the stress at zlvl - - ! high frequency momentum coupling following Roberts et al. (2014) - strx = tau * sqrt((uatm-uvel)**2 + (vatm-vvel)**2) * (uatm-uvel) - stry = tau * sqrt((uatm-uvel)**2 + (vatm-vvel)**2) * (vatm-vvel) - - else - - !------------------------------------------------------------ - ! momentum flux - !------------------------------------------------------------ - ! tau = rhoa * ustar * ustar - ! strx = tau * uatm / vmag - ! stry = tau * vatm / vmag - !------------------------------------------------------------ - - tau = rhoa * ustar * rd ! not the stress at zlvl - strx = tau * uatm - stry = tau * vatm - - endif - - Cdn_atm_ratio_n = rd * rd / rdn / rdn - - endif ! calc_strair - - !------------------------------------------------------------ - ! coefficients for turbulent flux calculation - !------------------------------------------------------------ - ! add windless coefficient for sensible heat flux - ! as in Jordan et al (JGR, 1999) - !------------------------------------------------------------ - - shcoef = rhoa * ustar * cp * rh + c1 - lhcoef = rhoa * ustar * Lheat * re * latentHeatActive - - !------------------------------------------------------------ - ! Compute diagnostics: 2m ref T, Q, U - !------------------------------------------------------------ - - hol = hol*zTrf/zlvl - xqq = max( c1, sqrt(abs(c1-c16*hol)) ) - xqq = sqrt(xqq) - psix2 = -c5*hol*stable + (c1-stable)*psixhu(xqq) - fac = (rh/vonkar) & - * (alz + al2 - psixh + psix2) - Tref = potT - delt*fac - Tref = Tref - p01*zTrf ! pot temp to temp correction - fac = (re/vonkar) & - * (alz + al2 - psixh + psix2) - Qref = Qa - delq*fac - - if (highfreq .and. sfctype(1:3)=='ice') then - Uref = sqrt((uatm-uvel)**2 + (vatm-vvel)**2) * rd / rdn - else - Uref = vmag * rd / rdn - endif - - end subroutine atmo_boundary_layer - -!======================================================================= - -! Compute coefficients for atm/ice fluxes, stress -! NOTE: \\ -! (1) all fluxes are positive downward, \\ -! (2) reference temperature and humidity are NOT computed - - subroutine atmo_boundary_const (sfctype, calc_strair, & - uatm, vatm, & - wind, rhoa, & - strx, stry, & - Tsf, potT, & - Qa, & - delt, delq, & - lhcoef, shcoef, & - Cdn_atm) - - character (len=3), intent(in) :: & - sfctype ! ice or ocean - - logical (kind=log_kind), intent(in) :: & - calc_strair ! if true, calculate wind stress components - - real (kind=dbl_kind), intent(in) :: & - Tsf , & ! surface temperature of ice or ocean - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - uatm , & ! x-direction wind speed (m/s) - vatm , & ! y-direction wind speed (m/s) - wind , & ! wind speed (m/s) - rhoa ! air density (kg/m^3) - - real (kind=dbl_kind), intent(in) :: & - Cdn_atm ! neutral drag coefficient - - real (kind=dbl_kind), intent(inout):: & - strx , & ! x surface stress (N) - stry ! y surface stress (N) - - real (kind=dbl_kind), intent(out):: & - delt , & ! potential T difference (K) - delq , & ! humidity difference (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - ! local variables - - real (kind=dbl_kind) :: & - TsfK, & ! surface temperature in Kelvin (K) - qsat, & ! the saturation humidity of air (kg/m^3) - ssq , & ! sat surface humidity (kg/kg) - tau, & ! stress at zlvl - Lheat ! Lvap or Lsub, depending on surface type - - !------------------------------------------------------------ - ! Initialize - !------------------------------------------------------------ - - delt = c0 - delq = c0 - shcoef = c0 - lhcoef = c0 - - if (calc_strair) then - - strx = c0 - stry = c0 - - !------------------------------------------------------------ - ! momentum flux - !------------------------------------------------------------ - tau = rhoa * 0.0012_dbl_kind * wind -!AOMIP tau = rhoa * (1.10_dbl_kind + c4*p01*wind) & -!AOMIP * wind * p001 - strx = tau * uatm - stry = tau * vatm - - endif ! calc_strair - - !------------------------------------------------------------ - ! define variables that depend on surface type - !------------------------------------------------------------ - - if (sfctype(1:3)=='ice') then - Lheat = Lsub ! ice to vapor - elseif (sfctype(1:3)=='ocn') then - Lheat = Lvap ! liquid to vapor - endif ! sfctype - - !------------------------------------------------------------ - ! potential temperature and specific humidity differences - !------------------------------------------------------------ - - TsfK = Tsf + Tffresh ! surface temp (K) - qsat = qqqocn * exp(-TTTocn/TsfK) ! sat humidity (kg/m^3) - ssq = qsat / rhoa ! sat surf hum (kg/kg) - - delt= potT - TsfK ! pot temp diff (K) - delq= Qa - ssq ! spec hum dif (kg/kg) - - !------------------------------------------------------------ - ! coefficients for turbulent flux calculation - !------------------------------------------------------------ - - shcoef = (1.20e-3_dbl_kind)*cp_air*rhoa*wind - lhcoef = (1.50e-3_dbl_kind)*Lheat *rhoa*wind*latentHeatActive - - end subroutine atmo_boundary_const - -!======================================================================= - -! Neutral drag coefficients for ocean and atmosphere also compute the -! intermediate necessary variables ridge height, distance, floe size -! based upon Tsamados et al. (2014), JPO, DOI: 10.1175/JPO-D-13-0215.1. -! Places where the code varies from the paper are commented. -! -! authors: Michel Tsamados, CPOM -! David Schroeder, CPOM -! -! changes: Andrew Roberts, NPS (RASM/CESM coupling and documentation) - - subroutine neutral_drag_coeffs (apnd, hpnd, & - ipnd, & - alvl, vlvl, & - aice, vice, & - vsno, aicen, & - vicen, vsnon, & - Cdn_ocn, Cdn_ocn_skin, & - Cdn_ocn_floe, Cdn_ocn_keel,& - Cdn_atm, Cdn_atm_skin, & - Cdn_atm_floe, Cdn_atm_pond,& - Cdn_atm_rdg, hfreebd, & - hdraft, hridge, & - distrdg, hkeel, & - dkeel, lfloe, & - dfloe, ncat) - - use ice_colpkg_tracers, only: & - tr_pond, tr_pond_lvl, tr_pond_topo - - integer (kind=int_kind), intent(in) :: & - ncat - - real (kind=dbl_kind), dimension (:), intent(in) :: & - apnd ,& ! melt pond fraction of sea ice - hpnd ,& ! mean melt pond depth over sea ice - ipnd ,& ! mean ice pond depth over sea ice in cat n - alvl ,& ! level ice area fraction (of grid cell ?) - vlvl ! level ice mean thickness - - real (kind=dbl_kind), intent(in) :: & - aice , & ! concentration of ice - vice , & ! volume per unit area of ice - vsno ! volume per unit area of snow - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), & - intent(out) :: & - hfreebd , & ! freeboard (m) - hdraft , & ! draught of ice + snow column (Stoessel1993) - hridge , & ! ridge height - distrdg , & ! distance between ridges - hkeel , & ! keel depth - dkeel , & ! distance between keels - lfloe , & ! floe length (m) - dfloe , & ! distance between floes - Cdn_ocn , & ! ocean-ice neutral drag coefficient - Cdn_ocn_skin , & ! drag coefficient due to skin drag - Cdn_ocn_floe , & ! drag coefficient due to floe edges - Cdn_ocn_keel , & ! drag coefficient due to keels - Cdn_atm , & ! ice-atmosphere drag coefficient - Cdn_atm_skin , & ! drag coefficient due to skin drag - Cdn_atm_floe , & ! drag coefficient due to floe edges - Cdn_atm_pond , & ! drag coefficient due to ponds - Cdn_atm_rdg ! drag coefficient due to ridges - - real (kind=dbl_kind), parameter :: & - ! [,] = range of values that can be tested - csw = 0.002_dbl_kind ,&! ice-ocn drag coefficient [0.0005,0.005] - csa = 0.0005_dbl_kind,&! ice-air drag coefficient [0.0001,0.001] - dragia = 0.0012_dbl_kind,&! ice-air drag coefficient [0.0005,0.002] - mrdg = c20 ,&! screening effect see Lu2011 [5,50] - mrdgo = c10 ,&! screening effect see Lu2011 [5,50] - beta = p5 ,&! power exponent appearing in astar and - ! L=Lmin(A*/(A*-A))**beta [0,1] - Lmin = c8 ,&! min length of floe (m) [5,100] - Lmax = 300._dbl_kind ,&! max length of floe (m) [30,3000] - Lmoy = 300._dbl_kind ,&! average length of floe (m) [30,1000] - cfa = p2 ,&! Eq. 12 ratio of local from drag over - ! geometrical parameter [0,1] - cfw = p2 ,&! Eq. 15 ratio of local from drag over - ! geometrical parameter [0,1] - cpa = p2 ,&! Eq. 16 ratio of local form drag over - ! geometrical parameter [0,1] - cra = p2 ,&! Eq. 10 local form drag coefficient [0,1] - crw = p2 ,&! Eq. 11 local form drag coefficient [0,1] - sl = 22._dbl_kind ,&! Sheltering parameter Lupkes2012 [10,30] - lpmin = 2.26_dbl_kind ,&! min pond length (m) see Eq. 17 [1,10] - lpmax = 24.63_dbl_kind ,&! max pond length (m) see Eq. 17 [10,100] - tanar = p4 ,&! 0.25 sail slope = 14 deg [0.4,1] - tanak = p4 ,&! 0.58 keel slope = 30 deg [0.4,1] - invsqrte = 0.6065_dbl_kind,&! - phir = 0.8_dbl_kind ,&! porosity of ridges [0.4,1] - phik = 0.8_dbl_kind ,&! porosity of keels [0.4,1] - hkoverhr = c4 ,&! hkeel/hridge ratio [4,8] - dkoverdr = c1 ,&! dkeel/distrdg ratio [1,5] - sHGB = 0.18_dbl_kind ,&! Lupkes2012 Eq. 28, Hanssen1988, - ! Steele1989 suggest instead 0.18 - alpha2 = c0 ,&! weight functions for area of - beta2 = p75 ! ridged ice [0,1] - - integer (kind=int_kind) :: & - n ! category index - - real (kind=dbl_kind) :: & - astar, & ! new constant for form drag - ctecaf, & ! constante - ctecwf, & ! constante - sca, & ! wind attenuation function - scw, & ! ocean attenuation function - lp, & ! pond length (m) - ctecar, & - ctecwk, & - ai, aii, & ! ice area and its inverse - tmp1 ! temporary - - real (kind=dbl_kind) :: & - apond , & ! melt pond fraction of grid cell - vpond , & ! mean melt pond depth over grid cell - ipond , & ! mean melt pond ice depth over grid cell - ardg , & ! ridged ice area fraction of grid cell - vrdg ! ridged ice mean thickness - - real (kind=dbl_kind), parameter :: & - ocnruf = 0.000327_dbl_kind, & ! ocean surface roughness (m) - ocnrufi = c1/ocnruf, & ! inverse ocean roughness - icerufi = c1/iceruf ! inverse ice roughness - - real (kind=dbl_kind), parameter :: & - camax = 0.02_dbl_kind , & ! Maximum for atmospheric drag - cwmax = 0.06_dbl_kind ! Maximum for ocean drag - - astar = c1/(c1-(Lmin/Lmax)**(c1/beta)) - - - !----------------------------------------------------------------- - ! Initialize across entire grid - !----------------------------------------------------------------- - - hfreebd=c0 - hdraft =c0 - hridge =c0 - distrdg=c0 - hkeel =c0 - dkeel =c0 - lfloe =c0 - dfloe =c0 - Cdn_ocn=dragio - Cdn_ocn_skin=c0 - Cdn_ocn_floe=c0 - Cdn_ocn_keel=c0 - Cdn_atm = (vonkar/log(zref/iceruf)) * (vonkar/log(zref/iceruf)) - Cdn_atm_skin=c0 - Cdn_atm_floe=c0 - Cdn_atm_pond=c0 - Cdn_atm_rdg =c0 - - if (aice > p001) then - - Cdn_atm_skin = csa - Cdn_ocn_skin = csw - - ai = aice - aii = c1/ai - - !------------------------------------------------------------ - ! Compute average quantities - !------------------------------------------------------------ - - ! ponds - apond = c0 - vpond = c0 - ipond = c0 - if (tr_pond) then - do n = 1,ncat - ! area of pond per unit area of grid cell - apond = apond+apnd(n)*aicen(n) - ! volume of pond per unit area of grid cell - vpond = vpond+apnd(n)*hpnd(n)*aicen(n) - enddo - endif - if (tr_pond_lvl .and. tr_pond_topo) then - do n = 1,ncat - ! volume of lid per unit area of grid cell - ipond = ipond+apnd(n)*ipnd(n)*aicen(n) - enddo - endif - - ! draft and freeboard (see Eq. 27) - hdraft = (rhoi*vice+rhos*vsno)*aii/rhow ! without ponds - hfreebd = (vice+vsno)*aii-hdraft - - ! Do not allow draft larger than ice thickness (see Eq. 28) - if (hdraft >= vice*aii) then - ! replace excess snow with ice so hi~=hdraft - hfreebd = (hdraft*ai*(c1-rhoi/rhow) + & - (vsno-(vice-hdraft*ai)*rhoi/rhos) * & - (c1-rhos/rhow))*aii ! Stoessel1993 - endif - - ! floe size parameterization see Eq. 13 - lfloe = Lmin * (astar / (astar - ai))**beta - - ! distance between floes parameterization see Eq. 14 - dfloe = lfloe * (c1/sqrt(ai) - c1) - - ! Relate ridge height and distance between ridges to - ! ridged ice area fraction and ridged ice mean thickness - ! Assumes total volume of ridged ice is split into ridges and keels. - ! Then assume total ridges volume over total area of ridges = - ! volume of one average ridge / area of one average ridge - ! Same for keels. - - ardg=c0 - vrdg=c0 - do n=1,ncat - ! ridged ice area fraction over grid cell - ardg=ardg+(c1-alvl(n))*aicen(n) - ! total ridged ice volume per unit grid cell area - vrdg=vrdg+(c1-vlvl(n))*vicen(n) - enddo - - ! hridge, hkeel, distrdg and dkeel estimates from CICE for - ! simple triangular geometry - if (ardg > p001) then - ! see Eq. 25 and Eq. 26 - hridge = vrdg/ardg*c2 & - * (alpha2+beta2*hkoverhr/dkoverdr*tanar/tanak) & - / (phir*c1+phik*tanar/tanak*hkoverhr**c2/dkoverdr) - distrdg = c2*hridge*ai/ardg & - * (alpha2/tanar+beta2/tanak*hkoverhr/dkoverdr) - hkeel = hkoverhr * hridge - dkeel = dkoverdr * distrdg - - ! Use the height of ridges relative to the mean freeboard of - ! the pack. Therefore skin drag and ridge drag differ in - ! this code as compared to Tsamados et al. (2014) equations - ! 10 and 18, which reference both to sea level. - tmp1 = max(c0,hridge - hfreebd) - - !------------------------------------------------------------ - ! Skin drag (atmo) - !------------------------------------------------------------ - - Cdn_atm_skin = csa*(c1 - mrdg*tmp1/distrdg) - Cdn_atm_skin = max(min(Cdn_atm_skin,camax),c0) - - !------------------------------------------------------------ - ! Ridge effect (atmo) - !------------------------------------------------------------ - - if (tmp1 > puny) then - sca = c1 - exp(-sHGB*distrdg/tmp1) ! see Eq. 9 - ctecar = cra*p5 - Cdn_atm_rdg = ctecar*tmp1/distrdg*sca* & - (log(tmp1*icerufi)/log(zref*icerufi))**c2 - Cdn_atm_rdg = min(Cdn_atm_rdg,camax) - endif - - ! Use the depth of keels relative to the mean draft of - ! the pack. Therefore skin drag and keel drag differ in - ! this code as compared to Tsamados et al. (2014) equations - ! 11 and 19, which reference both to sea level. In some - ! circumstances, hkeel can be less than hdraft because hkoverhr - ! is constant, and max(c0,...) temporarily addresses this. - tmp1 = max(c0,hkeel - hdraft) - - !------------------------------------------------------------ - ! Skin drag bottom ice (ocean) - !------------------------------------------------------------ - - Cdn_ocn_skin = csw * (c1 - mrdgo*tmp1/dkeel) - Cdn_ocn_skin = max(min(Cdn_ocn_skin,cwmax), c0) - - !------------------------------------------------------------ - ! Keel effect (ocean) - !------------------------------------------------------------ - - if (tmp1 > puny) then - scw = c1 - exp(-sHGB*dkeel/tmp1) - ctecwk = crw*p5 - Cdn_ocn_keel = ctecwk*tmp1/dkeel*scw* & - (log(tmp1*icerufi)/log(zref*icerufi))**c2 - Cdn_ocn_keel = max(min(Cdn_ocn_keel,cwmax),c0) - endif - - endif ! ardg > 0.001 - - !------------------------------------------------------------ - ! Floe edge drag effect (atmo) - !------------------------------------------------------------ - - if (hfreebd > puny) then - sca = c1 - exp(-sl*beta*(c1-ai)) - ctecaf = cfa*p5*(log(hfreebd*ocnrufi)/log(zref*ocnrufi))**c2*sca - Cdn_atm_floe = ctecaf * hfreebd / lfloe - Cdn_atm_floe = max(min(Cdn_atm_floe,camax),c0) - endif - - !------------------------------------------------------------ - ! Pond edge effect (atmo) - !------------------------------------------------------------ - - if (hfreebd > puny) then - sca = (apond)**(c1/(zref*beta)) - lp = lpmin*(1-apond)+lpmax*apond - Cdn_atm_pond = cpa*p5*sca*apond*hfreebd/lp & - * (log(hfreebd*ocnrufi)/log(zref*ocnrufi))**c2 - Cdn_atm_pond = min(Cdn_atm_pond,camax) - endif - - !------------------------------------------------------------ - ! Floe edge drag effect (ocean) - !------------------------------------------------------------ - - if (hdraft > puny) then - scw = c1 - exp(-sl*beta*(c1-ai)) - ctecwf = cfw*p5*(log(hdraft*ocnrufi)/log(zref*ocnrufi))**c2*scw - Cdn_ocn_floe = ctecwf * hdraft / lfloe - Cdn_ocn_floe = max(min(Cdn_ocn_floe,cwmax),c0) - endif - - !------------------------------------------------------------ - ! Total drag coefficient (atmo) - !------------------------------------------------------------ - - Cdn_atm = Cdn_atm_skin + Cdn_atm_floe + Cdn_atm_pond + Cdn_atm_rdg - Cdn_atm = min(Cdn_atm,camax) - - !------------------------------------------------------------ - ! Total drag coefficient (ocean) - !------------------------------------------------------------ - - Cdn_ocn = Cdn_ocn_skin + Cdn_ocn_floe + Cdn_ocn_keel - Cdn_ocn = min(Cdn_ocn,cwmax) - - endif - - end subroutine neutral_drag_coeffs - -!======================================================================= - - end module ice_atmo - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_brine.F90 b/components/mpas-seaice/src/column/ice_brine.F90 deleted file mode 100644 index 6bdb56df5acc..000000000000 --- a/components/mpas-seaice/src/column/ice_brine.F90 +++ /dev/null @@ -1,958 +0,0 @@ -! SVN:$Id: ice_brine.F90 1008 2015-06-20 23:55:12Z eclare $ -!======================================================================= -! -! Computes ice microstructural information for use in biogeochemistry -! -! authors: Nicole Jeffery, LANL -! - module ice_brine - - use ice_kinds_mod - use ice_constants_colpkg - use ice_colpkg_tracers, only: ntrcr, nt_qice, nt_sice, nt_bgc_S - use ice_zbgc_shared - use ice_warnings, only: add_warning - - implicit none - - private - public :: preflushing_changes, compute_microS_mushy, & - update_hbrine, compute_microS, calculate_drho - - real (kind=dbl_kind), parameter :: & - maxhbr = 1.25_dbl_kind , & ! brine overflows if hbr > maxhbr*hin - viscos = 2.1e-6_dbl_kind, & ! kinematic viscosity (m^2/s) - ! Brine salinity as a cubic function of temperature - a1 = -21.4_dbl_kind , & ! (psu/C) - a2 = -0.886_dbl_kind, & ! (psu/C^2) - a3 = -0.012_dbl_kind, & ! (psu/C^3) - ! Brine density as a quadratic of brine salinity - b1 = 1000.0_dbl_kind, & ! (kg/m^3) - b2 = 0.8_dbl_kind ! (kg/m^3/ppt) - -!======================================================================= - - contains - -!======================================================================= -! Computes the top and bottom brine boundary changes for flushing -! works for zsalinity and tr_salinity -! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with -! dynamic salinity or the height ratio = hbr/vicen*aicen, where hbr is the -! height of the brine surface relative to the bottom of the ice. This volume fraction -! may be > 1 in which case there is brine above the ice surface (meltponds). - - subroutine preflushing_changes (n_cat, & - aicen, vicen, vsnon, & - meltb, meltt, congel, & - snoice, hice_old, dhice, & - fbri, dhbr_top, dhbr_bot, & - hbr_old, hin,hsn, firstice, & - l_stop, stop_label) - - integer (kind=int_kind), intent(in) :: & - n_cat ! category - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon , & ! volume per unit area of snow (m) - meltb , & ! bottom ice melt (m) - meltt , & ! top ice melt (m) - congel , & ! bottom ice growth (m) - snoice , & ! top ice growth from flooding (m) - hice_old ! old ice thickness (m) - - real (kind=dbl_kind), intent(out) :: & - hbr_old ! old brine height (m) - - real (kind=dbl_kind), intent(inout) :: & - hin , & ! ice thickness (m) - hsn , & ! snow thickness (m) - dhice ! change due to sublimation (<0)/condensation (>0) (m) - - real (kind=dbl_kind), intent(inout) :: & - fbri , & ! trcrn(nt_fbri) - dhbr_top , & ! brine change in top for diagnostics (m) - dhbr_bot - - logical (kind=log_kind), intent(in) :: & - firstice ! if true, initialized values should be used - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort the model - - character (char_len), intent(out) :: stop_label - - ! local variables - - real (kind=dbl_kind) :: & - hin_old ! ice thickness before current melt/growth (m) - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! initialize - !----------------------------------------------------------------- - - l_stop = .false. - if (fbri < c0) then - write(warning, *) 'fbri, hice_old', fbri, hice_old - call add_warning(warning) - write(warning, *) 'vicen, aicen', vicen, aicen - call add_warning(warning) - l_stop = .true. - stop_label = 'ice_brine preflushing: fbri <= c0' - endif - hin = c0 - hsn = c0 - if (aicen > puny) then - hin = vicen / aicen - hsn = vsnon / aicen - endif - hin_old = max(c0, hin + meltb + meltt - congel - snoice) - dhice = hin_old - hice_old ! change due to subl/cond - dhbr_top = meltt - snoice - dhice - dhbr_bot = congel - meltb - - !if ((hice_old < puny) .OR. (hin_old < puny) ) then !.OR. firstice) then - ! hice_old = hin - ! dhbr_top = c0 - ! dhbr_bot = c0 - ! dhice = c0 - ! fbri = c1 - !endif - - hbr_old = fbri * hice_old - - end subroutine preflushing_changes - -!======================================================================= - -! Computes ice microstructural properties for updating hbrine -! -! NOTE: This subroutine uses thermosaline_vertical output to compute -! average ice permeability and the surface ice porosity - - subroutine compute_microS_mushy (n_cat, nilyr, nblyr, & - bgrid, cgrid, igrid, & - trcrn, hice_old, hbr_old, & - sss, sst, bTin, & - iTin, bphin, & - kperm, bphi_min, phi_snow, & - bSin, brine_sal, brine_rho, & - iphin, ibrine_rho, ibrine_sal, & - sice_rho, iDin, iSin, & - l_stop, stop_label) - - use ice_therm_mushy, only: permeability - use ice_mushy_physics, only: temperature_mush, liquid_fraction - use ice_colpkg_shared, only: l_sk, min_salin - - integer (kind=int_kind), intent(in) :: & - n_cat , & ! ice category - nilyr , & ! number of ice layers - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), & - intent(in) :: & - hice_old , & ! previous timestep ice height (m) - phi_snow , & ! porosity of snow - sss , & ! ocean salinity (ppt) - sst ! ocean temperature (C) - - real (kind=dbl_kind), dimension(ntrcr), & - intent(in) :: & - trcrn - - real (kind=dbl_kind), intent(out) :: & - kperm , & ! average ice permeability (m^2) - bphi_min ! surface porosity - - real (kind=dbl_kind), intent(in) :: & - hbr_old ! previous timestep brine height (m) - - real (kind=dbl_kind), dimension (nblyr+1), & - intent(inout) :: & - iDin ! tracer diffusivity/h^2 (1/s) includes gravity drainage/molecular - - real (kind=dbl_kind), dimension (nblyr+1), & - intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal , & ! brine sal on interface - iTin , & ! Temperature on the igrid (oC) - iSin ! Salinity on the igrid (ppt) - - real (kind=dbl_kind), dimension (nblyr+2), & - intent(inout) :: & - bSin , & ! bulk salinity (ppt) on bgrid - brine_sal , & ! equilibrium brine salinity (ppt) - brine_rho ! internal brine density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bTin , & ! Temperature on bgrid - bphin ! porosity on bgrid - - real (kind=dbl_kind), intent(inout) :: & - sice_rho ! average ice density - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len), intent(inout) :: stop_label - - ! local variables - - real (kind=dbl_kind), dimension (nilyr) :: & - cSin , & ! bulk salinity (ppt) - cqin ! enthalpy () - - real (kind=dbl_kind), dimension (nblyr+2) :: & - zTin , & ! Temperature of ice layers on bgrid (C) - zSin , & ! Salinity of ice layers on bgrid (C) - bqin ! enthalpy on the bgrid () - - real (kind=dbl_kind), dimension (nblyr+1) :: & - ikin ! permeability (m^2) - - integer (kind=int_kind) :: & - k ! vertical biology layer index - - real (kind=dbl_kind) :: & - surface_S , & ! salinity of ice above hin > hbr - hinc_old , & ! mean ice thickness before current melt/growth (m) - hbrc_old ! mean brine thickness before current melt/growth (m) - - real (kind=dbl_kind), dimension (ntrcr+2) :: & ! nblyr+2) - trtmp_s , & ! temporary, remapped tracers - trtmp_q ! temporary, remapped tracers - - real (kind=dbl_kind), dimension(nblyr+1) :: & - drho ! brine density difference (kg/m^3) - - real(kind=dbl_kind), parameter :: & - Smin = p01 - - !----------------------------------------------------------------- - ! Define ice salinity and temperature on bgrid - !----------------------------------------------------------------- - - trtmp_s(:) = c0 - trtmp_q(:) = c0 - iDin(:) = c0 - - do k = 1, nilyr - cSin(k) = trcrn(nt_sice+k-1) - cqin(k) = trcrn(nt_qice+k-1) - enddo - - ! map Sin and qin (cice) profiles to bgc grid - surface_S = min_salin - hinc_old = hice_old - hbrc_old = hbr_old - - call remap_zbgc(ntrcr, nilyr, & - nt_sice, & - trcrn, trtmp_s, & - 0, nblyr, & - hinc_old, hinc_old, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1), surface_S, & - l_stop, stop_label) - if (l_stop) return - - call remap_zbgc(ntrcr, nilyr, & - nt_qice, & - trcrn, trtmp_q, & - 0, nblyr, & - hinc_old, hinc_old, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1), surface_S, & - l_stop, stop_label) - if (l_stop) return - - do k = 1, nblyr - bqin (k+1) = min(c0, trtmp_q(nt_qice+k-1)) - bSin (k+1) = max(Smin, trtmp_s(nt_sice+k-1)) - bTin (k+1) = temperature_mush(bqin(k+1), bSin(k+1)) - bphin(k+1) = liquid_fraction (bTin(k+1), bSin(k+1)) - enddo ! k - - bSin (1) = bSin(2) - bTin (1) = bTin(2) - bphin(1) = bphin(2) - bphin(nblyr+2) = c1 - bSin (nblyr+2) = sss - bTin (nblyr+2) = sst - bphin(nblyr+2) = c1 - - !----------------------------------------------------------------- - ! Define ice multiphase structure - !----------------------------------------------------------------- - - call prepare_hbrine (nblyr, & - bSin, bTin, iTin, & - brine_sal, brine_rho, & - ibrine_sal, ibrine_rho, & - sice_rho, & - bphin, iphin, & - kperm, bphi_min, phi_snow, & - igrid, sss, iSin) - - call calculate_drho(nblyr, igrid, bgrid, & - brine_rho, ibrine_rho, drho) - - do k= 2, nblyr+1 - ikin(k) = k_o*iphin(k)**exp_h - if (hbr_old .GT. puny) iDin(k) = iphin(k)*Dm/hbr_old**2 - if (hbr_old .GE. Ra_c) & - iDin(k) = iDin(k) & - + l_sk*ikin(k)*gravit/viscos_dynamic*drho(k)/hbr_old**2 - enddo ! k - - end subroutine compute_microS_mushy - -!======================================================================= - - subroutine prepare_hbrine (nblyr, & - bSin, bTin, iTin, & - brine_sal, brine_rho, & - ibrine_sal, ibrine_rho, & - sice_rho, bphin, iphin,& - kperm, bphi_min, phi_snow, & - i_grid, sss, iSin) - - use ice_colpkg_shared, only: rhosi - use ice_therm_shared, only: calculate_Tin_from_qin - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension (:), & - intent(in) :: & - bSin , & ! salinity of ice layers on bio grid (ppt) - bTin , & ! temperature of ice layers on bio grid for history (C) - i_grid ! biology grid interface points - - real (kind=dbl_kind), dimension (:), & - intent(inout) :: & - brine_sal , & ! equilibrium brine salinity (ppt) - brine_rho , & ! internal brine density (kg/m^3) - ibrine_rho , & ! brine density on interface (kg/m^3) - ibrine_sal , & ! brine salinity on interface (ppt) - iphin , & ! porosity on interface - iTin , & ! Temperature on interface - bphin , & ! porosity of layers - iSin ! Bulk salinity on interface - - real (kind=dbl_kind), intent(in) :: & - phi_snow, & ! porosity of snow - sss ! sea surface salinity (ppt) - - real (kind=dbl_kind), intent(out) :: & - kperm , & ! harmonic average permeability (m^2) - bphi_min ! minimum porosity - - real (kind=dbl_kind), intent(inout) :: & - sice_rho ! avg sea ice density - - ! local variables - - real (kind=dbl_kind), dimension(nblyr+1) :: & - kin ! permeability - - real (kind=dbl_kind) :: & - k_min, ktemp, & - igrp, igrm, rigr ! grid finite differences - - integer (kind=int_kind) :: & - k ! layer index - - !----------------------------------------------------------------- - ! calculate equilibrium brine density and gradients - !----------------------------------------------------------------- - - sice_rho = c0 - - do k = 1, nblyr+1 - - if (k == 1) then - igrm = 0 - else - igrm = i_grid(k) - i_grid(k-1) - endif - - brine_sal(k) = a1*bTin(k) & - + a2*bTin(k)**2 & - + a3*bTin(k)**3 - brine_rho(k) = b1 + b2*brine_sal(k) - bphin (k) = max(puny, bSin(k)*rhosi & - / (brine_sal(k)*brine_rho(k))) - bphin (k) = min(c1, bphin(k)) - kin (k) = k_o*bphin(k)**exp_h - sice_rho = sice_rho + (rhoi*(c1-bphin(k)) & - + brine_rho(k)*bphin(k))*igrm - enddo ! k - - brine_sal (nblyr+2) = sss - brine_rho (nblyr+2) = rhow - bphin (nblyr+2) = c1 - ibrine_sal(1) = brine_sal (2) - ibrine_sal(nblyr+1) = brine_sal (nblyr+2) - ibrine_rho(1) = brine_rho (2) - ibrine_rho(nblyr+1) = brine_rho (nblyr+2) - iTin (1) = bTin(2) - iTin (nblyr+1) = bTin(nblyr+1) - iSin (1) = bSin(2) - iSin (nblyr+1) = bSin(nblyr+1) - iphin (1) = bphin (2) - iphin (nblyr+1) = bphin (nblyr+1) - k_min = MINVAL(kin(2:nblyr+1)) - kperm = c0 ! initialize - ktemp = c0 - bphi_min = bphin (1) -! bphi_min = max(bphin(1),bSin(2)*rhosi/bphin(2) & -! / (brine_sal(1)*brine_rho(1))*phi_snow) - - do k = 2, nblyr - if (k_min > c0) then - ktemp = ktemp + c1/kin(k) - kperm = k_min - endif - - igrp = i_grid(k+1) - i_grid(k ) - igrm = i_grid(k ) - i_grid(k-1) - rigr = c1 / (i_grid(k+1)-i_grid(k-1)) - - ibrine_sal(k) = (brine_sal(k+1)*igrp + brine_sal(k)*igrm) * rigr - ibrine_rho(k) = (brine_rho(k+1)*igrp + brine_rho(k)*igrm) * rigr - iTin (k) = (bTin (k+1)*igrp + bTin (k)*igrm) * rigr - iSin (k) = (bSin (k+1)*igrp + bSin (k)*igrm) * rigr - iphin (k) = max(puny, & - (bphin (k+1)*igrp + bphin (k)*igrm) * rigr) - iphin (k) = min(c1, iphin (k)) - enddo ! k - - if (k_min > c0) then - ktemp = ktemp + c1/kin(nblyr+1) - kperm = real(nblyr,kind=dbl_kind)/ktemp - endif - - end subroutine prepare_hbrine - -!======================================================================= - -! Changes include brine height increases from ice and snow surface melt, -! congelation growth, and upward pressure driven flow from snow loading. -! -! Decreases arise from downward flushing and bottom melt. -! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice -! with dynamic salinity or the height ratio == hbr/vicen*aicen, where -! hbr is the height of the brine surface relative to the bottom of the -! ice. This volume fraction may be > 1 in which case there is brine -! above the ice surface (ponds). - - subroutine update_hbrine (meltb, meltt, & - melts, dt, & - hin, hsn, & - hin_old, hbr, & - hbr_old, phi_snow, & - fbri, snoice, & - dhS_top, dhS_bottom, & - dh_top_chl, dh_bot_chl, & - kperm, bphi_min, & - darcy_V, darcy_V_chl, & - bphin, aice0, & - dh_direct) - - use ice_colpkg_shared, only: rhosi - - real (kind=dbl_kind), intent(in) :: & - dt ! timestep - - real (kind=dbl_kind), intent(in):: & - meltb, & ! bottom melt over dt (m) - meltt, & ! true top melt over dt (m) - melts, & ! true snow melt over dt (m) - hin, & ! ice thickness (m) - hsn, & ! snow thickness (m) - hin_old, & ! past timestep ice thickness (m) - hbr_old, & ! previous timestep hbr - phi_snow, & ! porosity of snow - kperm, & ! avg ice permeability - bphin, & ! upper brine porosity - snoice, & ! snoice change (m) - dhS_bottom, & ! change in bottom hbr initially before darcy flow - aice0 ! open water area fraction - - real (kind=dbl_kind), intent(inout):: & - darcy_V , & ! Darcy velocity: m/s - darcy_V_chl, & ! Darcy velocity: m/s for bgc - dhS_top , & ! change in top hbr before darcy flow - dh_bot_chl , & ! change in bottom for algae - dh_top_chl , & ! change in bottom for algae - hbr , & ! thickness of brine (m) - fbri , & ! brine height ratio tracer (hbr/hin) - bphi_min ! surface porosity - - real (kind=dbl_kind), intent(out):: & - dh_direct ! surface flooding or runoff (m) - - ! local variables - - real (kind=dbl_kind) :: & - hbrmin , & ! thinS or hin - dhbr_hin , & ! hbr-hin - hbrocn , & ! brine height above sea level (m) hbr-h_ocn - dhbr , & ! change in brine surface - h_ocn , & ! new ocean surface from ice bottom (m) - darcy_coeff, & ! magnitude of the Darcy velocity/hbrocn (1/s) - hbrocn_new , & ! hbrocn after flushing - dhflood , & ! surface flooding by ocean - dhrunoff ! direct runoff to ocean - - real (kind=dbl_kind), parameter :: & - dh_min = p001 ! brine remains within dh_min of sea level - ! when ice thickness is less than thinS - - hbrocn = c0 - darcy_V = c0 - darcy_V_chl = c0 - hbrocn_new = c0 - h_ocn = rhosi/rhow*hin + rhos/rhow*hsn - dh_direct = c0 - - if (hbr_old > thinS .AND. hin_old > thinS .AND. hin > thinS ) then - hbrmin = thinS - dhS_top = -max(c0, min(hin_old-hbr_old, meltt)) * rhoi/rhow - dhS_top = dhS_top - max(c0, melts) * rhos/rhow - dh_top_chl = dhS_top - dhbr = dhS_bottom - dhS_top - hbr = max(puny, hbr_old+dhbr) - hbrocn = hbr - h_ocn - darcy_coeff = max(c0, kperm*gravit/(viscos*hbr_old)) - - if (hbrocn > c0 .AND. hbr > thinS ) then - bphi_min = bphin - dhrunoff = -dhS_top*aice0 - hbrocn = max(c0,hbrocn - dhrunoff) - hbrocn_new = hbrocn*exp(-darcy_coeff/bphi_min*dt) - hbr = max(hbrmin, h_ocn + hbrocn_new) - hbrocn_new = hbr-h_ocn - darcy_V = -SIGN((hbrocn-hbrocn_new)/dt*bphi_min, hbrocn) - darcy_V_chl= darcy_V - dhS_top = dhS_top - darcy_V*dt/bphi_min + dhrunoff - dh_top_chl = dh_top_chl - darcy_V_chl*dt/bphi_min + dhrunoff - dh_direct = dhrunoff - elseif (hbrocn < c0 .AND. hbr > thinS) then - hbrocn_new = hbrocn*exp(-darcy_coeff/bphi_min*dt) - dhflood = max(c0,hbrocn_new - hbrocn)*aice0 - hbr = max(hbrmin, h_ocn + hbrocn_new) - darcy_V = -SIGN((hbrocn-hbrocn_new + dhflood)/dt*bphi_min, hbrocn) - darcy_V_chl= darcy_V - dhS_top = dhS_top - darcy_V*dt/bphi_min - dhflood - dh_top_chl = dh_top_chl - darcy_V_chl*dt/bphi_min - dhflood - dh_direct = -dhflood - endif - - dh_bot_chl = dhS_bottom - - else ! very thin brine height - hbrmin = min(thinS, hin) - hbr = max(hbrmin, hbr_old+dhS_bottom-dhS_top) - dhbr_hin = hbr - h_ocn - if (abs(dhbr_hin) > dh_min) & - hbr = max(hbrmin, h_ocn + SIGN(dh_min,dhbr_hin)) - dhS_top = hbr_old - hbr + dhS_bottom - dh_top_chl = dhS_top - dh_bot_chl = dhS_bottom - endif - - fbri = hbr/hin - - end subroutine update_hbrine - -!======================================================================= -! -! Computes ice microstructural properties for zbgc and zsalinity -! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with -! dynamic salinity or the height ratio == hbr/vicen*aicen, where hbr is the -! height of the brine surface relative to the bottom of the ice. -! This volume fraction -! may be > 1 in which case there is brine above the ice surface (meltponds). -! - subroutine compute_microS (n_cat, nilyr, nblyr, & - bgrid, cgrid, igrid, & - trcrn, hice_old, & - hbr_old, sss, sst, & - bTin, iTin, bphin, & - kperm, bphi_min, phi_snow, & - Rayleigh_criteria, firstice, & - bSin, brine_sal, & - brine_rho, iphin, ibrine_rho, & - ibrine_sal, sice_rho, sloss, & - salinz, iSin, l_stop, & - stop_label) - - use ice_therm_shared, only: calculate_Tin_from_qin - use ice_colpkg_tracers, only: nt_fbri, nt_Tsfc - use ice_colpkg_shared, only: min_salin, rhosi, salt_loss - - integer (kind=int_kind), intent(in) :: & - n_cat , & ! ice category - nilyr , & ! number of ice layers - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), intent(in) :: & - hice_old , & ! previous timestep ice height (m) - phi_snow , & ! porosity of snow - sss , & ! ocean salinity (ppt) - sst ! ocean temperature (oC) - - real (kind=dbl_kind), dimension(ntrcr), intent(inout) :: & - trcrn - - real (kind=dbl_kind), intent(inout) :: & - hbr_old , & ! old brine height - sice_rho ! average ice density - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bTin , & ! Temperature of ice layers on bio grid for history file (^oC) - bphin , & ! Porosity of layers - brine_sal , & ! equilibrium brine salinity (ppt) - brine_rho ! Internal brine density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr+2), intent(out) :: & - bSin - - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & - iTin , & ! Temperature on the interface grid - iSin ! Bulk Salinity on the interface grid - - real (kind=dbl_kind), dimension (nilyr), & - intent(in) :: & - salinz ! initial salinity profile for new ice (on cice grid) - - real (kind=dbl_kind), intent(out) :: & - bphi_min , & ! surface porosity - kperm , & ! average ice permeability (m^2) - sloss ! (g/m^2) salt from brine runoff for hbr > maxhbr*hin - - logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. if ice exceeded a minimum thickness hin >= Ra_c - - logical (kind=log_kind), intent(in) :: & - firstice ! .true. if ice is newly formed - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal ! brine sal on interface - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort the model - - character (char_len), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k ! vertical biology layer index - - real (kind=dbl_kind) :: & - surface_S , & ! salinity of ice above hin > hbr - hinc_old , & ! ice thickness (cell quantity) before current melt/growth (m) - hbrc_old , & ! brine thickness(cell quantity) before current melt/growth (m) - h_o ! freeboard height (m) - - logical (kind=log_kind) :: & - Rayleigh ! .true. if ice exceeded a minimum thickness hin >= Ra_c - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0 , & ! temporary, remapped tracers - trtmp ! temporary, remapped tracers - - real (kind=dbl_kind) :: & - Tmlts ! melting temperature - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - sloss = c0 - bTin(:) = c0 - bSin(:) = c0 - - trtmp(:) = c0 - surface_S = min_salin - - hinc_old = hice_old - - !----------------------------------------------------------------- - ! Rayleigh condition for salinity and bgc: - ! Implemented as a minimum thickness criteria for category 1 ice only. - ! When hin >= Ra_c (m), pressure flow is allowed. - ! Turn off by putting Ra_c = 0 in ice_in namelist. - !----------------------------------------------------------------- - - Rayleigh = .true. - if (n_cat == 1 .AND. hbr_old < Ra_c) then - Rayleigh = Rayleigh_criteria ! only category 1 ice can be false - endif - - !----------------------------------------------------------------- - ! Define ice salinity on Sin - !----------------------------------------------------------------- - - if (firstice) then - - do k = 1, nilyr - trcrn(nt_sice+k-1) = sss*salt_loss - enddo - - call remap_zbgc(ntrcr, nilyr, & - nt_sice, & - trcrn, trtmp, & - 0, nblyr, & - hinc_old, hinc_old, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1), surface_S, & - l_stop, stop_label) - if (l_stop) return - - do k = 1, nblyr - trcrn(nt_bgc_S+k-1) = max(min_salin,trtmp(nt_sice+k-1)) - bSin(k+1) = max(min_salin,trcrn(nt_bgc_S+k-1)) - if (trcrn(nt_bgc_S+k-1) < min_salin-puny) l_stop = .true. - enddo ! k - - bSin(1) = bSin(2) - bSin(nblyr+2) = sss - - elseif (hbr_old > maxhbr*hice_old) then - - call remap_zbgc(ntrcr, nblyr, & - nt_bgc_S, & - trcrn, trtmp, & - 0, nblyr, & - hbr_old, & - maxhbr*hinc_old, & - bgrid(2:nblyr+1), & - bgrid(2:nblyr+1), surface_S,& - l_stop, stop_label) - if (l_stop) return - - do k = 1, nblyr - bSin(k+1) = max(min_salin,trtmp(nt_bgc_S+k-1)) - sloss = sloss + rhosi*(hbr_old*trcrn(nt_bgc_S+k-1) & - - maxhbr*hice_old*bSin(k+1))*(igrid(k+1)-igrid(k)) - trcrn(nt_bgc_S+k-1) = bSin(k+1) - if (trcrn(nt_bgc_S+k-1) < min_salin-puny) l_stop = .true. - enddo ! k - - bSin(1) = bSin(2) - bSin(nblyr+2) = sss - hbr_old = maxhbr*hinc_old - - else ! old, thin ice - - do k = 1, nblyr - trcrn(nt_bgc_S+k-1) = max(min_salin,trcrn(nt_bgc_S+k-1)) - bSin (k+1) = trcrn(nt_bgc_S+k-1) - enddo ! k - - bSin (1) = bSin(2) - bSin (nblyr+2) = sss - - endif ! ice type - - !----------------------------------------------------------------- - ! sea ice temperature for bio grid - !----------------------------------------------------------------- - - do k = 1, nilyr - Tmlts = -trcrn(nt_sice+k-1)*depressT - trtmp0(nt_qice+k-1) = calculate_Tin_from_qin(trcrn(nt_qice+k-1),Tmlts) - enddo ! k - - trtmp(:) = c0 - - ! CICE to Bio: remap temperatures - call remap_zbgc (ntrcr, & - nilyr, nt_qice, & - trtmp0(1:ntrcr), trtmp, & - 0, nblyr, & - hinc_old, hbr_old, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1), surface_S, & - l_stop, stop_label) - if (l_stop) return - - do k = 1, nblyr - Tmlts = -bSin(k+1) * depressT - bTin (k+1) = min(Tmlts,trtmp(nt_qice+k-1)) - enddo !k - - Tmlts = -min_salin* depressT - bTin (1) = min(Tmlts,(bTin(2) + trcrn(nt_Tsfc))*p5) - Tmlts = -bSin(nblyr+2)* depressT - bTin (nblyr+2) = sst - - !----------------------------------------------------------------- - ! Define ice multiphase structure - !----------------------------------------------------------------- - - call prepare_hbrine (nblyr, & - bSin, bTin, iTin, & - brine_sal, brine_rho, & - ibrine_sal, ibrine_rho, & - sice_rho, & - bphin, iphin, & - kperm, bphi_min, phi_snow, & - igrid, sss, iSin) - - if (l_stop) then - stop_label = 'CICE ice_brine:zsalin < min_salin' - endif - - end subroutine compute_microS - -!========================================================================================== -! -! Find density difference about interface grid points -! for gravity drainage parameterization - - subroutine calculate_drho (nblyr, i_grid, b_grid, & - brine_rho, ibrine_rho, drho) - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of bio layers - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - b_grid ! biology nondimensional grid layer points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - i_grid ! biology grid interface points - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - brine_rho ! Internal brine density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr + 1), intent(in) :: & - ibrine_rho ! Internal brine density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & - drho ! brine difference about grid point (kg/m^3) - - ! local variables - - integer (kind=int_kind) :: & - k, m, mm ! indices - - integer (kind=int_kind) :: & - mstop, mstart - - real (kind=dbl_kind), dimension (nblyr + 1) :: & !on the zbgc vertical grid - rho_a , & ! average brine density above grid point (kg/m^3) - rho_2a ! average brine density above and below grid points (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr + 1) :: & !on the zbgc vertical grid - rho_b , & ! brine density above grid point (kg/m^3) - rho_2b ! brine density above and below grid points (kg/m^3) - - rho_a (:) = c0 - rho_2a(:) = c0 - rho_b (:) = c0 - rho_2b(:) = c0 - drho (:) = c0 ! surface is snow or atmosphere - - do k = 1, nblyr+1 ! i_grid values - - !---------------------------------------------- - ! h_avg(k) = i_grid(k) - ! Calculate rho_a(k), ie average rho above i_grid(k) - ! first part is good - !---------------------------------------------- - - if (k == 2) then - rho_a(2) = (brine_rho(2)*b_grid(2) & - + (ibrine_rho(2) + brine_rho(2)) & - * p5*(i_grid(2)-b_grid(2)) )/i_grid(2) - rho_b(2) = brine_rho(2) - - elseif (k > 2 .AND. k < nblyr+1) then - rho_a(k) = (rho_a(k-1)*i_grid(k-1) + (ibrine_rho(k-1) + brine_rho(k)) & - * p5*(b_grid(k)-i_grid(k-1)) + (ibrine_rho(k ) + brine_rho(k)) & - * p5*(i_grid(k)-b_grid(k)))/i_grid(k) - rho_b(k) = brine_rho(k) - else - rho_a(nblyr+1) = (rho_a(nblyr)*i_grid(nblyr) + (ibrine_rho(nblyr) + & - brine_rho(nblyr+1))*p5*(b_grid(nblyr+1)-i_grid(nblyr)) + & - brine_rho(nblyr+1)*(i_grid(nblyr+1)-b_grid(nblyr+1)))/i_grid(nblyr+1) - rho_a(1) = brine_rho(2) !for k == 1 use grid point value - rho_b(nblyr+1) = brine_rho(nblyr+1) - rho_b(1) = brine_rho(2) - endif - - enddo !k - - !---------------------------------------------- - ! Calculate average above and below k rho_2a - !---------------------------------------------- - - do k = 1, nblyr+1 !i_grid values - if (k == 1) then - rho_2a(1) = (rho_a(1)*b_grid(2) + p5*(brine_rho(2) + ibrine_rho(2)) & - * (i_grid(2)-b_grid(2)))/i_grid(2) - rho_2b(1) = brine_rho(2) - else - mstop = 2*(k-1) + 1 - if (mstop < nblyr+1) then - rho_2a(k) = rho_a(mstop) - mstart = 2 - mstop = 1 - else - mstart = nblyr+2 - mstop = nblyr+3 - endif - - do mm = mstart,mstop - rho_2a(k) =(rho_a(nblyr+1) + rhow*(c2*i_grid(k)-c1))*p5/i_grid(k) - enddo - rho_2b(k) = brine_rho(k+1) - endif - drho(k) = max(rho_b(k) - rho_2b(k),max(c0,c2*(rho_a(k)-rho_2a(k)), & - c2*(brine_rho(k)-brine_rho(k+1))/real(nblyr,kind=dbl_kind))) - enddo - - end subroutine calculate_drho - -!======================================================================= - - end module ice_brine - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_colpkg.F90 b/components/mpas-seaice/src/column/ice_colpkg.F90 deleted file mode 100644 index ac0435b1f842..000000000000 --- a/components/mpas-seaice/src/column/ice_colpkg.F90 +++ /dev/null @@ -1,6290 +0,0 @@ -! SVN:$Id: ice_colpkg.F90 1175 2017-03-02 19:53:26Z akt $ -!========================================================================= -! -! flags and interface routines for the column package -! -! authors: Elizabeth C. Hunke, LANL - - module ice_colpkg - - use ice_kinds_mod - use ice_colpkg_shared ! namelist and other parameters - use ice_warnings, only: add_warning - - implicit none - - private - - ! initialization - public :: & - colpkg_init_itd, & - colpkg_init_itd_hist, & - colpkg_init_thermo, & - colpkg_init_orbit, & - colpkg_init_trcr, & - colpkg_init_bgc, & - colpkg_init_zbgc, & - colpkg_init_hbrine, & - colpkg_init_zsalinity, & - colpkg_init_ocean_conc, & - colpkg_init_OceanConcArray, & - colpkg_init_bgc_trcr, & - colpkg_init_parameters, & - colpkg_init_tracer_flags, & - colpkg_init_tracer_indices, & - colpkg_init_tracer_numbers, & - colpkg_init_active_processes - - ! time stepping - public :: & - colpkg_step_snow, & - colpkg_step_therm1, & - colpkg_biogeochemistry, & - colpkg_step_therm2, & - colpkg_prep_radiation, & - colpkg_step_radiation, & - colpkg_step_ridge - - ! other column routines - public :: & - colpkg_aggregate, & - colpkg_ice_strength, & - colpkg_atm_boundary, & - colpkg_ocn_mixed_layer - - ! temperature inquiry functions - public :: & - colpkg_ice_temperature, & - colpkg_snow_temperature, & - colpkg_liquidus_temperature, & - colpkg_sea_freezing_temperature, & - colpkg_enthalpy_ice, & - colpkg_enthalpy_snow, & - colpkg_salinity_profile - - ! warning messages - public :: & - colpkg_clear_warnings, & - colpkg_get_warnings, & - colpkg_print_warnings - - - -!======================================================================= - - contains - -!======================================================================= -! Initialization routines -!======================================================================= - -! Initialize area fraction and thickness boundaries for the itd model -! -! authors: William H. Lipscomb and Elizabeth C. Hunke, LANL -! C. M. Bitz, UW - - subroutine colpkg_init_itd(ncat, hin_max, l_stop, stop_label) - - use ice_colpkg_shared, only: kcatbound, kitd - use ice_therm_shared, only: hi_min - use ice_constants_colpkg, only: p01, p1, c0, c1, c2, c3, c15, c25, c100 - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), intent(out) :: & - hin_max(0:ncat) ! category limits (m) - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - - integer (kind=int_kind) :: & - n ! thickness category index - - real (kind=dbl_kind) :: & - cc1, cc2, cc3, & ! parameters for kcatbound = 0 - x1 , & - rn , & ! real(n) - rncat , & ! real(ncat) - d1 , & ! parameters for kcatbound = 1 (m) - d2 , & ! - b1 , & ! parameters for kcatbound = 3 - b2 , & ! - b3 - - real (kind=dbl_kind), dimension(5) :: wmo5 ! data for wmo itd - real (kind=dbl_kind), dimension(6) :: wmo6 ! data for wmo itd - real (kind=dbl_kind), dimension(7) :: wmo7 ! data for wmo itd - - l_stop = .false. - - rncat = real(ncat, kind=dbl_kind) - d1 = 3.0_dbl_kind / rncat - d2 = 0.5_dbl_kind / rncat - b1 = p1 ! asymptotic category width (m) - b2 = c3 ! thickness for which participation function is small (m) - b3 = max(rncat*(rncat-1), c2*b2/b1) - - hi_min = p01 ! minimum ice thickness allowed (m) for thermo - ! note hi_min is reset to 0.1 for kitd=0, below - - !----------------------------------------------------------------- - ! Choose category boundaries based on one of four options. - ! - ! The first formula (kcatbound = 0) was used in Lipscomb (2001) - ! and in CICE versions 3.0 and 3.1. - ! - ! The second formula is more user-friendly in the sense that it - ! is easy to obtain round numbers for category boundaries: - ! - ! H(n) = n * [d1 + d2*(n-1)] - ! - ! Default values are d1 = 300/ncat, d2 = 50/ncat. - ! For ncat = 5, boundaries in cm are 60, 140, 240, 360, which are - ! close to the standard values given by the first formula. - ! For ncat = 10, boundaries in cm are 30, 70, 120, 180, 250, 330, - ! 420, 520, 630. - ! - ! The third option provides support for World Meteorological - ! Organization classification based on thickness. The full - ! WMO thickness distribution is used if ncat = 7; if ncat=5 - ! or ncat = 6, some of the thinner categories are combined. - ! For ncat = 5, boundaries are 30, 70, 120, 200, >200 cm. - ! For ncat = 6, boundaries are 15, 30, 70, 120, 200, >200 cm. - ! For ncat = 7, boundaries are 10, 15, 30, 70, 120, 200, >200 cm. - ! - ! The fourth formula asymptotes to a particular category width as - ! the number of categories increases, given by the parameter b1. - ! The parameter b3 is computed so that the category boundaries - ! are even numbers. - ! - ! H(n) = b1 * [n + b3*n*(n+1)/(2*N*(N-1))] for N=ncat - ! - ! kcatbound=-1 is available only for 1-category runs, with - ! boundaries 0 and 100 m. - !----------------------------------------------------------------- - - if (kcatbound == -1) then ! single category - hin_max(0) = c0 - hin_max(1) = c100 - - elseif (kcatbound == 0) then ! original scheme - - if (kitd == 1) then - ! linear remapping itd category limits - cc1 = c3/rncat - cc2 = c15*cc1 - cc3 = c3 - - hin_max(0) = c0 ! minimum ice thickness, m - else - ! delta function itd category limits -#ifndef CCSMCOUPLED - hi_min = p1 ! minimum ice thickness allowed (m) for thermo -#endif - cc1 = max(1.1_dbl_kind/rncat,hi_min) - cc2 = c25*cc1 - cc3 = 2.25_dbl_kind - - ! hin_max(0) should not be zero - ! use some caution in making it less than 0.10 - hin_max(0) = hi_min ! minimum ice thickness, m - endif ! kitd - - do n = 1, ncat - x1 = real(n-1,kind=dbl_kind) / rncat - hin_max(n) = hin_max(n-1) & - + cc1 + cc2*(c1 + tanh(cc3*(x1-c1))) - enddo - - elseif (kcatbound == 1) then ! new scheme - - hin_max(0) = c0 - do n = 1, ncat - rn = real(n, kind=dbl_kind) - hin_max(n) = rn * (d1 + (rn-c1)*d2) - enddo - - elseif (kcatbound == 2) then ! WMO standard - - if (ncat == 5) then - ! thinnest 3 categories combined - data wmo5 / 0.30_dbl_kind, 0.70_dbl_kind, & - 1.20_dbl_kind, 2.00_dbl_kind, & - 999._dbl_kind / - hin_max(0) = c0 - do n = 1, ncat - hin_max(n) = wmo5(n) - enddo - elseif (ncat == 6) then - ! thinnest 2 categories combined - data wmo6 / 0.15_dbl_kind, & - 0.30_dbl_kind, 0.70_dbl_kind, & - 1.20_dbl_kind, 2.00_dbl_kind, & - 999._dbl_kind / -!echmod wmo6a -! data wmo6 /0.30_dbl_kind, 0.70_dbl_kind, & -! 1.20_dbl_kind, 2.00_dbl_kind, & -! 4.56729_dbl_kind, & -! 999._dbl_kind / - - hin_max(0) = c0 - do n = 1, ncat - hin_max(n) = wmo6(n) - enddo - elseif (ncat == 7) then - ! all thickness categories - data wmo7 / 0.10_dbl_kind, 0.15_dbl_kind, & - 0.30_dbl_kind, 0.70_dbl_kind, & - 1.20_dbl_kind, 2.00_dbl_kind, & - 999._dbl_kind / - hin_max(0) = c0 - do n = 1, ncat - hin_max(n) = wmo7(n) - enddo - else - stop_label = 'kcatbound=2 (WMO) must have ncat=5, 6 or 7' - l_stop = .true. - return - endif - - elseif (kcatbound == 3) then ! asymptotic scheme - - hin_max(0) = c0 - do n = 1, ncat - rn = real(n, kind=dbl_kind) - hin_max(n) = b1 * (rn + b3*rn*(rn+c1)/(c2*rncat*(rncat-c1))) - enddo - - endif ! kcatbound - - if (kitd == 1) then - hin_max(ncat) = 999.9_dbl_kind ! arbitrary big number - endif - - end subroutine colpkg_init_itd - -!======================================================================= - -! Initialize area fraction and thickness boundaries for the itd model -! -! authors: William H. Lipscomb and Elizabeth C. Hunke, LANL -! C. M. Bitz, UW - - subroutine colpkg_init_itd_hist (ncat, hin_max, c_hi_range) - - use ice_colpkg_shared, only: kcatbound, kitd - use ice_constants_colpkg, only: p01, p1, c2, c3, c15, c25, c100 - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), intent(in) :: & - hin_max(0:ncat) ! category limits (m) - - character (len=35), intent(out) :: & - c_hi_range(ncat) ! string for history output - - ! local variables - - integer (kind=int_kind) :: & - n ! thickness category index - - character(len=8) :: c_hinmax1,c_hinmax2 - character(len=2) :: c_nc - - character(len=char_len_long) :: & - warning ! warning message - - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'hin_max(n-1) < Cat n < hin_max(n)' - call add_warning(warning) - do n = 1, ncat - write(warning,*) hin_max(n-1),' < Cat ',n, ' < ',hin_max(n) - call add_warning(warning) - ! Write integer n to character string - write (c_nc, '(i2)') n - - ! Write hin_max to character string - write (c_hinmax1, '(f6.3)') hin_max(n-1) - write (c_hinmax2, '(f6.3)') hin_max(n) - - ! Save character string to write to history file - c_hi_range(n)=c_hinmax1//'m < hi Cat '//c_nc//' < '//c_hinmax2//'m' - enddo - - write(warning,*) ' ' - call add_warning(warning) - - end subroutine colpkg_init_itd_hist - -!======================================================================= -! -! Initialize the vertical profile of ice salinity and melting temperature. -! -! authors: C. M. Bitz, UW -! William H. Lipscomb, LANL - - subroutine colpkg_init_thermo(nilyr, sprofile) - - use ice_colpkg_shared, only: saltmax, ktherm, heat_capacity, & - min_salin - use ice_constants_colpkg, only: p5, c0, c1, c2, pi - use ice_therm_shared, only: l_brine - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real (kind=dbl_kind), dimension(:), intent(out) :: & - sprofile ! vertical salinity profile - - real (kind=dbl_kind), parameter :: & - nsal = 0.407_dbl_kind, & - msal = 0.573_dbl_kind - - integer (kind=int_kind) :: k ! ice layer index - real (kind=dbl_kind) :: zn ! normalized ice thickness - - !----------------------------------------------------------------- - ! Determine l_brine based on saltmax. - ! Thermodynamic solver will not converge if l_brine is true and - ! saltmax is close to zero. - ! Set l_brine to false for zero layer thermodynamics - !----------------------------------------------------------------- - - heat_capacity = .true. - if (ktherm == 0) heat_capacity = .false. ! 0-layer thermodynamics - - l_brine = .false. - if (saltmax > min_salin .and. heat_capacity) l_brine = .true. - - !----------------------------------------------------------------- - ! Prescibe vertical profile of salinity and melting temperature. - ! Note this profile is only used for BL99 thermodynamics. - !----------------------------------------------------------------- - - if (l_brine) then - do k = 1, nilyr - zn = (real(k,kind=dbl_kind)-p5) / & - real(nilyr,kind=dbl_kind) - sprofile(k)=(saltmax/c2)*(c1-cos(pi*zn**(nsal/(msal+zn)))) - sprofile(k) = max(sprofile(k), min_salin) - enddo ! k - sprofile(nilyr+1) = saltmax - - else ! .not. l_brine - do k = 1, nilyr+1 - sprofile(k) = c0 - enddo - endif ! l_brine - - end subroutine colpkg_init_thermo - -!======================================================================= -! Initial salinity profile -! -! authors: C. M. Bitz, UW -! William H. Lipscomb, LANL - - function colpkg_salinity_profile(zn) result(salinity) - - use ice_colpkg_shared, only: saltmax - use ice_constants_colpkg, only: c1, c2, pi - - real(kind=dbl_kind), intent(in) :: & - zn ! depth - - real(kind=dbl_kind) :: & - salinity ! initial salinity profile - - real (kind=dbl_kind), parameter :: & - nsal = 0.407_dbl_kind, & - msal = 0.573_dbl_kind - - salinity = (saltmax/c2)*(c1-cos(pi*zn**(nsal/(msal+zn)))) - - end function colpkg_salinity_profile - -!======================================================================= -! Compute orbital parameters for the specified date. -! -! author: Bruce P. Briegleb, NCAR - - subroutine colpkg_init_orbit(l_stop, stop_label) - - use ice_constants_colpkg, only: iyear_AD, eccen, obliqr, lambm0, & - mvelpp, obliq, mvelp, decln, eccf, log_print - -#ifdef CCSMCOUPLED - use shr_orb_mod, only: shr_orb_params -#else - use ice_orbital, only: shr_orb_params -#endif - - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort the model - - character (len=*), intent(out) :: stop_label - - l_stop = .false. ! initialized for CCSMCOUPLED - stop_label = '' ! initialized for CCSMCOUPLED - iyear_AD = 1950 - log_print = .false. ! if true, write out orbital parameters - -#ifdef CCSMCOUPLED - call shr_orb_params( iyear_AD, eccen , obliq , mvelp , & - obliqr , lambm0, mvelpp, log_print) -#else - call shr_orb_params( iyear_AD, eccen , obliq , mvelp , & - obliqr , lambm0, mvelpp, log_print, & - l_stop, stop_label) -#endif - - end subroutine colpkg_init_orbit - -!======================================================================= - - subroutine colpkg_init_trcr(Tair, Tf, & - Sprofile, Tprofile, & - Tsfc, & - nilyr, nslyr, & - qin, qsn) - - use ice_colpkg_shared, only: calc_Tsfc - use ice_constants_colpkg, only: Tsmelt, Tffresh, p5, cp_ice, cp_ocn, & - Lfresh, rhoi, rhos, c0, c1 - use ice_mushy_physics, only: enthalpy_mush - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - Tair, & ! air temperature (C) - Tf ! freezing temperature (C) - - real (kind=dbl_kind), dimension(:), intent(in) :: & - Sprofile, & ! vertical salinity profile (ppt) - Tprofile ! vertical temperature profile (C) - - real (kind=dbl_kind), intent(out) :: & - Tsfc ! surface temperature (C) - - real (kind=dbl_kind), dimension(:), intent(out) :: & - qin, & ! ice enthalpy profile (J/m3) - qsn ! snow enthalpy profile (J/m3) - - ! local variables - - integer (kind=int_kind) :: k - - real (kind=dbl_kind) :: & - slope, Ti - - ! surface temperature - Tsfc = Tf ! default - if (calc_Tsfc) Tsfc = min(Tsmelt, Tair - Tffresh) ! deg C - - if (heat_capacity) then - - ! ice enthalpy - do k = 1, nilyr - ! assume linear temp profile and compute enthalpy - slope = Tf - Tsfc - Ti = Tsfc + slope*(real(k,kind=dbl_kind)-p5) & - /real(nilyr,kind=dbl_kind) - if (ktherm == 2) then - qin(k) = enthalpy_mush(Ti, Sprofile(k)) - else - qin(k) = -(rhoi * (cp_ice*(Tprofile(k)-Ti) & - + Lfresh*(c1-Tprofile(k)/Ti) - cp_ocn*Tprofile(k))) - endif - enddo ! nilyr - - ! snow enthalpy - do k = 1, nslyr - Ti = min(c0, Tsfc) - qsn(k) = -rhos*(Lfresh - cp_ice*Ti) - enddo ! nslyr - - else ! one layer with zero heat capacity - - ! ice energy - qin(1) = -rhoi * Lfresh - - ! snow energy - qsn(1) = -rhos * Lfresh - - endif ! heat_capacity - - end subroutine colpkg_init_trcr - -!======================================================================= - - subroutine colpkg_init_bgc(dt, ncat, nblyr, nilyr, ntrcr_o, cgrid, igrid, & - restart_bgc, ntrcr, nbtrcr, sicen, trcrn, & - sss, nit, amm, sil, dmsp, dms, algalN, & - doc, don, dic, fed, fep, zaeros, hum, & - ocean_bio_all, & - max_algae, max_doc, max_dic, max_don, max_fe, max_nbtrcr, max_aero, & - DOCPoolFractions, use_macromolecules, l_stop, stop_label) - - use ice_constants_colpkg, only: c0, c1, c2, p1, p15, p5 - use ice_zbgc_shared, only: R_S2N, zbgc_frac_init, zbgc_init_frac, remap_zbgc, & - doc_pool_fractions - - ! column package includes - use ice_colpkg_tracers, only: nt_fbri, nt_bgc_S, nt_sice, nt_zbgc_frac, & - bio_index_o, bio_index - use ice_colpkg_shared, only: solve_zsal, ktherm, hs_ssl, & - skl_bgc, scale_bgc, grid_o_t, fe_data_type, & - R_C2N, R_chl2N - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nblyr , & ! number of bio layers - ntrcr_o, & ! number of tracers not including bgc - ntrcr , & ! number of tracers in use - nbtrcr, & ! number of bio tracers in use - max_algae, & - max_doc, & - max_dic, & - max_don, & - max_fe, & - max_nbtrcr, & - max_aero - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(inout) :: & - cgrid ! CICE vertical coordinate - - logical (kind=log_kind), intent(in) :: & - restart_bgc, & ! if .true., read bgc restart file - use_macromolecules ! if .true., doc ocean fractions are determined & - ! by the ocean macromolecules subroutine - - real (kind=dbl_kind), dimension(nilyr, ncat), intent(in) :: & - sicen ! salinity on the cice grid - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! subset of tracer array (only bgc) - - real (kind=dbl_kind), intent(in) :: & - sss ! sea surface salinity (ppt) - - real (kind=dbl_kind), intent(inout) :: & - nit , & ! ocean nitrate (mmol/m^3) - amm , & ! ammonia/um (mmol/m^3) - sil , & ! silicate (mmol/m^3) - dmsp , & ! dmsp (mmol/m^3) - dms , & ! dms (mmol/m^3) - hum ! hum (mmol/m^3) - - real (kind=dbl_kind), dimension (max_algae), intent(inout) :: & - algalN ! ocean algal nitrogen (mmol/m^3) (diatoms, pico, phaeocystis) - - real (kind=dbl_kind), dimension (max_doc), intent(inout) :: & - doc ! ocean doc (mmol/m^3) (proteins, EPS, lipid) - - real (kind=dbl_kind), dimension (max_don), intent(inout) :: & - don ! ocean don (mmol/m^3) - - real (kind=dbl_kind), dimension (max_dic), intent(inout) :: & - dic ! ocean dic (mmol/m^3) - - real (kind=dbl_kind), dimension (max_fe), intent(inout) :: & - fed, fep ! ocean disolved and particulate fe (nM) - - real (kind=dbl_kind), dimension (max_aero), intent(inout) :: & - zaeros ! ocean aerosols (mmol/m^3) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - ocean_bio_all ! fixed order, all values even for tracers false - - real (kind=dbl_kind), dimension (:), intent(out) :: & - DOCPoolFractions ! Fraction of DOC in polysacharids, lipids, and proteins - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(inout) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k , & ! vertical index - n , & ! category index - mm , & ! bio tracer index - ki , & ! loop index - ks , & ! - ntrcr_bgc - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp ! temporary, remapped tracers - - real (kind=dbl_kind), dimension (nblyr+1) :: & - zspace ! vertical grid spacing - - real (kind=dbl_kind) :: & - dvssl , & ! volume of snow surface layer (m) - dvint , & ! volume of snow interior (m) - nit_dum, &! - sil_dum - - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5*zspace(1) - zspace(nblyr+1) = p5*zspace(nblyr+1) - ntrcr_bgc = ntrcr-ntrcr_o - - DOCPoolFractions(:) = c1 - if (.not. use_macromolecules) then - do mm = 1,max_doc - DOCPoolFractions(mm) = doc_pool_fractions(mm) - end do - end if - - call colpkg_init_OceanConcArray(max_nbtrcr, & - max_algae, max_don, max_doc, & - max_dic, max_aero, max_fe, & - nit, amm, sil, & - dmsp, dms, algalN, & - doc, don, dic, & - fed, fep, zaeros, & - ocean_bio_all, hum) - - if (.not. restart_bgc) then ! not restarting - - !----------------------------------------------------------------------------- - ! Skeletal Layer Model - ! All bgc tracers are Bulk quantities in units of mmol or mg per m^3 - ! The skeletal layer model assumes a constant - ! layer depth (sk_l) and porosity (phi_sk) - !----------------------------------------------------------------------------- - if (skl_bgc) then - - do n = 1,ncat - do mm = 1,nbtrcr - ! bulk concentration (mmol or mg per m^3, or 10^-3 mmol/m^3) - trcrn(bio_index(mm)-ntrcr_o, n) = ocean_bio_all(bio_index_o(mm)) - enddo ! nbtrcr - enddo ! n - - !----------------------------------------------------------------------------- - ! zbgc Model - ! All bgc tracers are Bulk quantities in units of mmol or mg per m^3 - ! The vertical layer model uses prognosed porosity and layer depth - !----------------------------------------------------------------------------- - - else ! not skl_bgc - - if (scale_bgc .and. solve_zsal) then ! bulk concentration (mmol or mg per m^3) - do n = 1,ncat - do mm = 1,nbtrcr - do k = 2, nblyr - trcrn(bio_index(mm)+k-1-ntrcr_o,n) = & - (p5*(trcrn(nt_bgc_S+k-1-ntrcr_o,n)+ trcrn(nt_bgc_S+k-2-ntrcr_o,n)) & - / sss*ocean_bio_all(bio_index_o(mm))) - enddo !k - trcrn(nt_zbgc_frac-1+mm-ntrcr_o,n) = zbgc_frac_init(mm) - trcrn(bio_index(mm)-ntrcr_o,n) = (trcrn(nt_bgc_S-ntrcr_o,n) & - / sss*ocean_bio_all(bio_index_o(mm))) - trcrn(bio_index(mm)+nblyr-ntrcr_o,n) = (trcrn(nt_bgc_S+nblyr-1-ntrcr_o,n) & - / sss*ocean_bio_all(bio_index_o(mm))) - trcrn(bio_index(mm)+nblyr+1-ntrcr_o:bio_index(mm)+nblyr+2-ntrcr_o,n) = c0 ! snow - enddo ! mm - enddo ! n - - elseif (scale_bgc .and. ktherm == 2) then - trtmp(:) = c0 - do n = 1,ncat - call remap_zbgc(nilyr, nilyr, & - 1, & - sicen(:,n), trtmp, & - 0, nblyr+1, & - c1, c1, & - cgrid(2:nilyr+1), & - igrid(1:nblyr+1), & - sicen(1,n), & - l_stop, stop_label) - if (l_stop) return - - do mm = 1,nbtrcr - do k = 1, nblyr + 1 - trcrn(bio_index(mm)+k-1-ntrcr_o,n) = & - (trtmp(k)/sss*ocean_bio_all(bio_index_o(mm))) - trcrn(bio_index(mm)+nblyr+1-ntrcr_o:bio_index(mm)+nblyr+2-ntrcr_o,n) = c0 ! snow - enddo ! k - enddo ! mm - enddo ! n - - elseif (nbtrcr > 0 .and. nt_fbri > 0) then ! not scale_bgc - - do n = 1,ncat - do mm = 1,nbtrcr - do k = 1, nblyr+1 - trcrn(bio_index(mm)+k-1-ntrcr_o,n) = ocean_bio_all(bio_index_o(mm)) & - * zbgc_init_frac(mm) - trcrn(bio_index(mm)+nblyr+1-ntrcr_o:bio_index(mm)+nblyr+2-ntrcr_o,n) = c0 ! snow - enddo ! k - trcrn(nt_zbgc_frac-1+mm-ntrcr_o,n) = zbgc_frac_init(mm) - enddo ! mm - enddo ! n - - endif ! scale_bgc - endif ! skl_bgc - endif ! restart - - end subroutine colpkg_init_bgc - -!======================================================================= - - subroutine colpkg_init_zbgc (nblyr, nilyr, nslyr, & - n_algae, n_zaero, n_doc, n_dic, n_don, n_fed, n_fep, & - trcr_base, trcr_depend, n_trcr_strata, nt_strata, nbtrcr_sw, & - tr_brine, nt_fbri, ntrcr, nbtrcr, nt_bgc_Nit, nt_bgc_Am, & - nt_bgc_Sil, nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, nt_bgc_N, & - nt_bgc_C, nt_bgc_chl, nt_bgc_DOC, nt_bgc_DON, nt_bgc_DIC, & - nt_zaero, nt_bgc_DMSPp, nt_bgc_DMSPd, nt_bgc_Fed, nt_bgc_Fep, & - nt_zbgc_frac, tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_PON, tr_bgc_S, tr_bgc_N, tr_bgc_C, tr_bgc_chl, & - tr_bgc_DON, tr_bgc_Fe, tr_zaero, nlt_zaero_sw, nlt_chl_sw, & - nlt_bgc_N, nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & - nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, & - nlt_bgc_C, nlt_bgc_chl, nlt_bgc_DIC, nlt_bgc_DOC, & - nlt_bgc_PON, nlt_bgc_DON, nlt_bgc_Fed, nlt_bgc_Fep, & - nlt_zaero, & - nt_bgc_hum, nlt_bgc_hum, tr_bgc_hum, solve_zsal, & - skl_bgc, z_tracers, dEdd_algae, solve_zbgc, & - frazil_scav, initbio_frac, bio_index_o, bio_index, ntrcr_o, & - max_algae, max_doc, max_dic, max_don, max_fe, & - ratio_Si2N_diatoms, ratio_Si2N_sp, ratio_Si2N_phaeo, & - ratio_S2N_diatoms, ratio_S2N_sp, ratio_S2N_phaeo, & - ratio_Fe2C_diatoms, ratio_Fe2C_sp, ratio_Fe2C_phaeo, & - ratio_Fe2N_diatoms, ratio_Fe2N_sp, ratio_Fe2N_phaeo, & - ratio_Fe2DON, ratio_Fe2DOC_s, ratio_Fe2DOC_l, & - chlabs_diatoms, chlabs_sp, chlabs_phaeo, & - alpha2max_low_diatoms, alpha2max_low_sp, alpha2max_low_phaeo, & - beta2max_diatoms, beta2max_sp, beta2max_phaeo, & - mu_max_diatoms, mu_max_sp, mu_max_phaeo, & - grow_Tdep_diatoms, grow_Tdep_sp, grow_Tdep_phaeo, & - fr_graze_diatoms, fr_graze_sp, fr_graze_phaeo, & - mort_pre_diatoms, mort_pre_sp, mort_pre_phaeo, & - mort_Tdep_diatoms, mort_Tdep_sp, mort_Tdep_phaeo, & - k_exude_diatoms, k_exude_sp, k_exude_phaeo, & - K_Nit_diatoms, K_Nit_sp, K_Nit_phaeo, & - K_Am_diatoms, K_Am_sp, K_Am_phaeo, & - K_Sil_diatoms, K_Sil_sp, K_Sil_phaeo, & - K_Fe_diatoms, K_Fe_sp, K_Fe_phaeo, & - f_don_protein, kn_bac_protein, & - f_don_Am_protein ,f_doc_s, f_doc_l, & - f_exude_s, f_exude_l, k_bac_s, k_bac_l, & - algaltype_diatoms, algaltype_sp, algaltype_phaeo, & - doctype_s, doctype_l, dictype_1, dontype_protein, & - fedtype_1, feptype_1, zaerotype_bc1, zaerotype_bc2, & - zaerotype_dust1, zaerotype_dust2, zaerotype_dust3, & - zaerotype_dust4, & - ratio_C2N_diatoms, ratio_C2N_sp, ratio_C2N_phaeo, & - ratio_chl2N_diatoms, ratio_chl2N_sp, ratio_chl2N_phaeo, & - F_abs_chl_diatoms, F_abs_chl_sp, F_abs_chl_phaeo, & - ratio_C2N_proteins, & - nitratetype, ammoniumtype, dmspptype, dmspdtype, & - silicatetype, humtype, tau_min, tau_max) - - use ice_constants_colpkg, only: c1, p5, c0, c2 - - use ice_colpkg_shared, only: & - algaltype, doctype, dictype, dontype, fedtype, feptype, zaerotype, & - R_C2N, R_chl2N, F_abs_chl, R_C2N_DON - - use ice_zbgc_shared, only: zbgc_init_frac, & - bgc_tracer_type, zbgc_frac_init, & - tau_ret, tau_rel, R_Si2N, R_S2N, R_Fe2C, & - R_Fe2N, R_Fe2DON, R_Fe2DOC, & - chlabs, alpha2max_low, beta2max, & - mu_max, grow_Tdep, fr_graze, & - mort_pre, mort_Tdep, k_exude, & - K_Nit, K_Am, K_Sil, K_Fe, & - f_don, kn_bac, f_don_Am, & - f_doc, f_exude, k_bac - - - integer (kind=int_kind), intent(in) :: & - nblyr , & ! number of bio/brine layers per category - nilyr , & ! number of ice layers per category - nslyr , & ! number of snow layers per category - n_zaero , & ! number of z aerosols in use - n_algae , & ! number of algae in use - n_doc , & ! number of DOC pools in use - n_dic , & ! number of DIC pools in use - n_don , & ! number of DON pools in use - n_fed , & ! number of Fe pools in use dissolved Fe - n_fep , & ! number of Fe pools in use particulate Fe - max_algae , & - max_doc , & - max_dic , & - max_don , & - max_fe - - integer (kind=int_kind), intent(inout) :: & - ntrcr_o, & ! number of non-bio tracers in use - ntrcr, & ! number of tracers - nbtrcr, & ! number of bgc tracers in use - nbtrcr_sw ! size of shorwave tracer vector - - integer (kind=int_kind), dimension (:), intent(inout) :: & - trcr_depend ! = 0 for ice area tracers - ! = 1 for ice volume tracers - ! = 2 for snow volume tracers - - integer (kind=int_kind), dimension (:), intent(inout) :: & - n_trcr_strata ! number of underlying tracer layers - - integer (kind=int_kind), dimension (:,:), intent(inout) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - logical (kind=log_kind), intent(in) :: & - tr_brine, & ! if .true., brine height differs from ice thickness - tr_bgc_S, & ! if .true., use zsalinity - tr_zaero, & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit, & ! if .true. Nitrate tracer in ice - tr_bgc_N, & ! if .true., algal nitrogen tracers (n_algae) - tr_bgc_DON, & ! if .true., DON pools are tracers (n_don) - tr_bgc_C, & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl, & ! if .true., algal chlorophyll tracers - tr_bgc_Am, & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil, & ! if .true., silicon as nutrient tracer - tr_bgc_DMS, & ! if .true., DMS as tracer - tr_bgc_Fe, & ! if .true., Fe as tracer - tr_bgc_PON, & ! if .true., PON as tracer - tr_bgc_hum, & ! if .true., humic material as tracer - solve_zsal, & ! if true, update salinity profile from solve_S_dt - z_tracers, & ! if .true., bgc or aerosol tracers are vertically resolved - solve_zbgc, & ! if .true., solve vertical biochemistry portion of code - dEdd_algae, & ! if .true., algal absorption of Shortwave is computed in the - skl_bgc ! if true, solve skeletal biochemistry - - integer (kind=int_kind), intent(out) :: & - nt_fbri, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - nt_bgc_Nit, & ! nutrients - nt_bgc_Am, & ! - nt_bgc_Sil, & ! - nt_bgc_DMSPp, & ! trace gases (skeletal layer) - nt_bgc_DMSPd, & ! - nt_bgc_DMS, & ! - nt_bgc_PON, & ! zooplankton and detritus - nt_bgc_hum, & ! humic material - ! bio layer indicess - nlt_bgc_Nit, & ! nutrients - nlt_bgc_Am, & ! - nlt_bgc_Sil, & ! - nlt_bgc_DMSPp,& ! trace gases (skeletal layer) - nlt_bgc_DMSPd,& ! - nlt_bgc_DMS, & ! - nlt_bgc_PON, & ! zooplankton and detritus - nlt_bgc_hum, & ! humic material - nlt_chl_sw, & ! points to total chla in trcrn_sw - nt_zbgc_frac, & ! fraction of tracer in the mobile phase - nt_bgc_S ! Bulk salinity in fraction ice with dynamic salinity (Bio grid) - - integer (kind=int_kind), dimension(:), intent(out) :: & - nt_bgc_N , & ! diatoms, phaeocystis, pico/small - nt_bgc_C , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl,& ! diatoms, phaeocystis, pico/small - nlt_bgc_N ,& ! diatoms, phaeocystis, pico/small - nlt_bgc_C ,& ! diatoms, phaeocystis, pico/small - nlt_bgc_chl ! diatoms, phaeocystis, pico/small - - integer (kind=int_kind), dimension(:), intent(out) :: & - nt_bgc_DOC, & ! dissolved organic carbon - nlt_bgc_DOC ! dissolved organic carbon - - integer (kind=int_kind), dimension(:), intent(out) :: & - nt_bgc_DON, & ! dissolved organic nitrogen - nlt_bgc_DON ! dissolved organic nitrogen - - integer (kind=int_kind), dimension(:), intent(out) :: & - nt_bgc_DIC, & ! dissolved inorganic carbon - nlt_bgc_DIC ! dissolved inorganic carbon - - integer (kind=int_kind), dimension(:), intent(out) :: & - nt_bgc_Fed, & ! dissolved iron - nt_bgc_Fep, & ! particulate iron - nlt_bgc_Fed, & ! dissolved iron - nlt_bgc_Fep ! particulate iron - - integer (kind=int_kind), dimension(:), intent(out) :: & - nt_zaero, & ! black carbon and other aerosols - nlt_zaero, & ! black carbon and other aerosols - nlt_zaero_sw - - integer (kind=int_kind), dimension(:), intent(out) :: & - bio_index_o , & ! nlt to appropriate value in ocean data array - bio_index ! nlt to nt - - real (kind=dbl_kind), intent(in) :: & - initbio_frac, & ! fraction of ocean tracer concentration used to initialize tracer - frazil_scav ! multiple of ocean tracer concentration due to frazil scavenging - - real (kind=dbl_kind), intent(in) :: & - ratio_Si2N_diatoms, & ! algal Si to N (mol/mol) - ratio_Si2N_sp , & - ratio_Si2N_phaeo , & - ratio_S2N_diatoms , & ! algal S to N (mol/mol) - ratio_S2N_sp , & - ratio_S2N_phaeo , & - ratio_Fe2C_diatoms, & ! algal Fe to C (umol/mol) - ratio_Fe2C_sp , & - ratio_Fe2C_phaeo , & - ratio_Fe2N_diatoms, & ! algal Fe to N (umol/mol) - ratio_Fe2N_sp , & - ratio_Fe2N_phaeo , & - ratio_Fe2DON , & ! Fe to N of DON (nmol/umol) - ratio_Fe2DOC_s , & ! Fe to C of DOC (nmol/umol) saccharids - ratio_Fe2DOC_l , & ! Fe to C of DOC (nmol/umol) lipids - tau_min , & ! rapid mobile to stationary exchanges (s) = 1.5 hours - tau_max , & ! long time mobile to stationary exchanges (s) = 2 days - chlabs_diatoms , & ! chl absorption (1/m/(mg/m^3)) - chlabs_sp , & ! - chlabs_phaeo , & ! - alpha2max_low_diatoms , & ! light limitation (1/(W/m^2)) - alpha2max_low_sp , & - alpha2max_low_phaeo , & - beta2max_diatoms , & ! light inhibition (1/(W/m^2)) - beta2max_sp , & - beta2max_phaeo , & - mu_max_diatoms , & ! maximum growth rate (1/day) - mu_max_sp , & - mu_max_phaeo , & - grow_Tdep_diatoms, & ! Temperature dependence of growth (1/C) - grow_Tdep_sp , & - grow_Tdep_phaeo , & - fr_graze_diatoms , & ! Fraction grazed - fr_graze_sp , & - fr_graze_phaeo , & - mort_pre_diatoms , & ! Mortality (1/day) - mort_pre_sp , & - mort_pre_phaeo , & - mort_Tdep_diatoms, & ! T dependence of mortality (1/C) - mort_Tdep_sp , & - mort_Tdep_phaeo , & - k_exude_diatoms , & ! algal exudation (1/d) - k_exude_sp , & - k_exude_phaeo , & - K_Nit_diatoms , & ! nitrate half saturation (mmol/m^3) - K_Nit_sp , & - K_Nit_phaeo , & - K_Am_diatoms , & ! ammonium half saturation (mmol/m^3) - K_Am_sp , & - K_Am_phaeo , & - K_Sil_diatoms , & ! silicate half saturation (mmol/m^3) - K_Sil_sp , & - K_Sil_phaeo , & - K_Fe_diatoms , & ! iron half saturation (nM) - K_Fe_sp , & - K_Fe_phaeo , & - f_don_protein , & ! fraction of spilled grazing to proteins - kn_bac_protein , & ! Bacterial degredation of DON (1/d) - f_don_Am_protein , & ! fraction of remineralized DON to ammonium - f_doc_s , & ! fraction of mortality to DOC - f_doc_l , & - f_exude_s , & ! fraction of exudation to DOC - f_exude_l , & - k_bac_s , & ! Bacterial degredation of DOC (1/d) - k_bac_l , & - algaltype_diatoms , & ! mobility type - algaltype_sp , & ! - algaltype_phaeo , & ! - nitratetype , & ! - ammoniumtype , & ! - silicatetype , & ! - dmspptype , & ! - dmspdtype , & ! - humtype , & ! - doctype_s , & ! - doctype_l , & ! - dictype_1 , & ! - dontype_protein , & ! - fedtype_1 , & ! - feptype_1 , & ! - zaerotype_bc1 , & ! - zaerotype_bc2 , & ! - zaerotype_dust1 , & ! - zaerotype_dust2 , & ! - zaerotype_dust3 , & ! - zaerotype_dust4 , & ! - ratio_C2N_diatoms , & ! algal C to N ratio (mol/mol) - ratio_C2N_sp , & ! - ratio_C2N_phaeo , & ! - ratio_chl2N_diatoms, & ! algal chlorophyll to N ratio (mg/mmol) - ratio_chl2N_sp , & ! - ratio_chl2N_phaeo , & ! - F_abs_chl_diatoms , & ! scales absorbed radiation for dEdd - F_abs_chl_sp , & ! - F_abs_chl_phaeo , & ! - ratio_C2N_proteins ! ratio of C to N in proteins (mol/mol) - - ! local variables - - integer (kind=int_kind) :: & - k, mm , & ! loop index - ntd , & ! for tracer dependency calculation - nk , & ! - nt_depend - - ntrcr_o = ntrcr - nt_fbri = 0 - if (tr_brine) then - nt_fbri = ntrcr + 1 ! ice volume fraction with salt - ntrcr = ntrcr + 1 - trcr_depend(nt_fbri) = 1 ! volume-weighted - trcr_base (nt_fbri,1) = c0 ! volume-weighted - trcr_base (nt_fbri,2) = c1 ! volume-weighted - trcr_base (nt_fbri,3) = c0 ! volume-weighted - n_trcr_strata(nt_fbri) = 0 - nt_strata (nt_fbri,1) = 0 - nt_strata (nt_fbri,2) = 0 - endif - - ntd = 0 ! if nt_fbri /= 0 then use fbri dependency - if (nt_fbri == 0) ntd = -1 ! otherwise make tracers depend on ice volume - - if (solve_zsal) then ! .true. only if tr_brine = .true. - nt_bgc_S = ntrcr + 1 - ntrcr = ntrcr + nblyr - do k = 1,nblyr - trcr_depend(nt_bgc_S + k - 1) = 2 + nt_fbri + ntd - trcr_base (nt_bgc_S,1) = c0 ! default: ice area - trcr_base (nt_bgc_S,2) = c1 - trcr_base (nt_bgc_S,3) = c0 - n_trcr_strata(nt_bgc_S) = 1 - nt_strata(nt_bgc_S,1) = nt_fbri - nt_strata(nt_bgc_S,2) = 0 - enddo - endif - - !----------------------------------------------------------------- - ! biogeochemistry - !----------------------------------------------------------------- - - nbtrcr = 0 - nbtrcr_sw = 0 - - ! vectors of size max_algae - nlt_bgc_N(:) = 0 - nlt_bgc_C(:) = 0 - nlt_bgc_chl(:) = 0 - nt_bgc_N(:) = 0 - nt_bgc_C(:) = 0 - nt_bgc_chl(:) = 0 - - ! vectors of size max_dic - nlt_bgc_DIC(:) = 0 - nt_bgc_DIC(:) = 0 - - ! vectors of size max_doc - nlt_bgc_DOC(:) = 0 - nt_bgc_DOC(:) = 0 - - ! vectors of size max_don - nlt_bgc_DON(:) = 0 - nt_bgc_DON(:) = 0 - - ! vectors of size max_fe - nlt_bgc_Fed(:) = 0 - nlt_bgc_Fep(:) = 0 - nt_bgc_Fed(:) = 0 - nt_bgc_Fep(:) = 0 - - ! vectors of size max_aero - nlt_zaero(:) = 0 - nlt_zaero_sw(:) = 0 - nt_zaero(:) = 0 - - nlt_bgc_Nit = 0 - nlt_bgc_Am = 0 - nlt_bgc_Sil = 0 - nlt_bgc_DMSPp = 0 - nlt_bgc_DMSPd = 0 - nlt_bgc_DMS = 0 - nlt_bgc_PON = 0 - nlt_bgc_hum = 0 - nlt_chl_sw = 0 - bio_index(:) = 0 - bio_index_o(:) = 0 - - nt_bgc_Nit = 0 - nt_bgc_Am = 0 - nt_bgc_Sil = 0 - nt_bgc_DMSPp = 0 - nt_bgc_DMSPd = 0 - nt_bgc_DMS = 0 - nt_bgc_PON = 0 - nt_bgc_hum = 0 - - !----------------------------------------------------------------- - ! Define array parameters - !----------------------------------------------------------------- - R_Si2N(1) = ratio_Si2N_diatoms - R_Si2N(2) = ratio_Si2N_sp - R_Si2N(3) = ratio_Si2N_phaeo - - R_S2N(1) = ratio_S2N_diatoms - R_S2N(2) = ratio_S2N_sp - R_S2N(3) = ratio_S2N_phaeo - - R_Fe2C(1) = ratio_Fe2C_diatoms - R_Fe2C(2) = ratio_Fe2C_sp - R_Fe2C(3) = ratio_Fe2C_phaeo - - R_Fe2N(1) = ratio_Fe2N_diatoms - R_Fe2N(2) = ratio_Fe2N_sp - R_Fe2N(3) = ratio_Fe2N_phaeo - - R_C2N(1) = ratio_C2N_diatoms - R_C2N(2) = ratio_C2N_sp - R_C2N(3) = ratio_C2N_phaeo - - R_chl2N(1) = ratio_chl2N_diatoms - R_chl2N(2) = ratio_chl2N_sp - R_chl2N(3) = ratio_chl2N_phaeo - - F_abs_chl(1) = F_abs_chl_diatoms - F_abs_chl(2) = F_abs_chl_sp - F_abs_chl(3) = F_abs_chl_phaeo - - R_Fe2DON(1) = ratio_Fe2DON - R_C2N_DON(1) = ratio_C2N_proteins - - R_Fe2DOC(1) = ratio_Fe2DOC_s - R_Fe2DOC(2) = ratio_Fe2DOC_l - R_Fe2DOC(3) = c0 - - chlabs(1) = chlabs_diatoms - chlabs(2) = chlabs_sp - chlabs(3) = chlabs_phaeo - - alpha2max_low(1) = alpha2max_low_diatoms - alpha2max_low(2) = alpha2max_low_sp - alpha2max_low(3) = alpha2max_low_phaeo - - beta2max(1) = beta2max_diatoms - beta2max(2) = beta2max_sp - beta2max(3) = beta2max_phaeo - - mu_max(1) = mu_max_diatoms - mu_max(2) = mu_max_sp - mu_max(3) = mu_max_phaeo - - grow_Tdep(1) = grow_Tdep_diatoms - grow_Tdep(2) = grow_Tdep_sp - grow_Tdep(3) = grow_Tdep_phaeo - - fr_graze(1) = fr_graze_diatoms - fr_graze(2) = fr_graze_sp - fr_graze(3) = fr_graze_phaeo - - mort_pre(1) = mort_pre_diatoms - mort_pre(2) = mort_pre_sp - mort_pre(3) = mort_pre_phaeo - - mort_Tdep(1) = mort_Tdep_diatoms - mort_Tdep(2) = mort_Tdep_sp - mort_Tdep(3) = mort_Tdep_phaeo - - k_exude(1) = k_exude_diatoms - k_exude(2) = k_exude_sp - k_exude(3) = k_exude_phaeo - - K_Nit(1) = K_Nit_diatoms - K_Nit(2) = K_Nit_sp - K_Nit(3) = K_Nit_phaeo - - K_Am(1) = K_Am_diatoms - K_Am(2) = K_Am_sp - K_Am(3) = K_Am_phaeo - - K_Sil(1) = K_Sil_diatoms - K_Sil(2) = K_Sil_sp - K_Sil(3) = K_Sil_phaeo - - K_Fe(1) = K_Fe_diatoms - K_Fe(2) = K_Fe_sp - K_Fe(3) = K_Fe_phaeo - - f_doc(1) = f_doc_s - f_doc(2) = f_doc_l - - f_don(1) = f_don_protein - kn_bac(1) = kn_bac_protein - f_don_Am(1) = f_don_Am_protein - - f_exude(1) = f_exude_s - f_exude(2) = f_exude_l - k_bac(1) = k_bac_s - k_bac(2) = k_bac_l - - algaltype(1) = algaltype_diatoms - algaltype(2) = algaltype_sp - algaltype(3) = algaltype_phaeo - - doctype(1) = doctype_s - doctype(2) = doctype_l - - dictype(1) = dictype_1 - - dontype(1) = dontype_protein - - fedtype(1) = fedtype_1 - feptype(1) = feptype_1 - - zaerotype(1) = zaerotype_bc1 - zaerotype(2) = zaerotype_bc2 - zaerotype(3) = zaerotype_dust1 - zaerotype(4) = zaerotype_dust2 - zaerotype(5) = zaerotype_dust3 - zaerotype(6) = zaerotype_dust4 - - if (skl_bgc) then - - nk = 1 - nt_depend = 0 - - if (dEdd_algae) then - nlt_chl_sw = 1 - nbtrcr_sw = nilyr+nslyr+2 ! only the bottom layer - ! will be nonzero - endif - - elseif (z_tracers) then ! defined on nblyr+1 in ice - ! and 2 snow layers (snow surface + interior) - - nk = nblyr + 1 - nt_depend = 2 + nt_fbri + ntd - - if (tr_bgc_N) then - if (dEdd_algae) then - nlt_chl_sw = 1 - nbtrcr_sw = nilyr+nslyr+2 - endif - endif ! tr_bgc_N - - endif ! skl_bgc or z_tracers - - if (skl_bgc .or. z_tracers) then - - !----------------------------------------------------------------- - ! assign tracer indices and dependencies - ! bgc_tracer_type: < 0 purely mobile , >= 0 stationary - !------------------------------------------------------------------ - - if (tr_bgc_N) then - do mm = 1, n_algae - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_N(mm), nlt_bgc_N(mm), & - algaltype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_N(mm)) = mm - enddo ! mm - endif ! tr_bgc_N - - if (tr_bgc_Nit) then - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_Nit, nlt_bgc_Nit, & - nitratetype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_Nit) = max_algae + 1 - endif ! tr_bgc_Nit - - if (tr_bgc_C) then - ! - ! Algal C is not yet distinct from algal N - ! * Reqires exudation and/or changing C:N ratios - ! for implementation - ! - ! do mm = 1,n_algae - ! call colpkg_init_bgc_trcr(nk, nt_fbri, & - ! nt_bgc_C(mm), nlt_bgc_C(mm), & - ! algaltype(mm), nt_depend, & - ! ntrcr, nbtrcr, & - ! bgc_tracer_type, trcr_depend, & - ! trcr_base, n_trcr_strata, & - ! nt_strata, bio_index) - ! bio_index_o(nlt_bgc_C(mm)) = max_algae + 1 + mm - ! enddo ! mm - - do mm = 1, n_doc - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_DOC(mm), nlt_bgc_DOC(mm), & - doctype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_DOC(mm)) = max_algae + 1 + mm - enddo ! mm - do mm = 1, n_dic - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_DIC(mm), nlt_bgc_DIC(mm), & - dictype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_DIC(mm)) = max_algae + max_doc + 1 + mm - enddo ! mm - endif ! tr_bgc_C - - if (tr_bgc_chl) then - do mm = 1, n_algae - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_chl(mm), nlt_bgc_chl(mm), & - algaltype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_chl(mm)) = max_algae + 1 + max_doc + max_dic + mm - enddo ! mm - endif ! tr_bgc_chl - - if (tr_bgc_Am) then - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_Am, nlt_bgc_Am, & - ammoniumtype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_Am) = 2*max_algae + max_doc + max_dic + 2 - endif - if (tr_bgc_Sil) then - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_Sil, nlt_bgc_Sil, & - silicatetype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_Sil) = 2*max_algae + max_doc + max_dic + 3 - endif - if (tr_bgc_DMS) then ! all together - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_DMSPp, nlt_bgc_DMSPp, & - dmspptype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_DMSPp) = 2*max_algae + max_doc + max_dic + 4 - - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_DMSPd, nlt_bgc_DMSPd, & - dmspdtype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_DMSPd) = 2*max_algae + max_doc + max_dic + 5 - - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_DMS, nlt_bgc_DMS, & - dmspdtype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_DMS) = 2*max_algae + max_doc + max_dic + 6 - endif - if (tr_bgc_PON) then - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_PON, nlt_bgc_PON, & - nitratetype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_PON) = 2*max_algae + max_doc + max_dic + 7 - endif - if (tr_bgc_DON) then - do mm = 1, n_don - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_DON(mm), nlt_bgc_DON(mm), & - dontype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_DON(mm)) = 2*max_algae + max_doc + max_dic + 7 + mm - enddo ! mm - endif ! tr_bgc_DON - if (tr_bgc_Fe) then - do mm = 1, n_fed - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_Fed(mm), nlt_bgc_Fed(mm), & - fedtype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_Fed(mm)) = 2*max_algae + max_doc + max_dic & - + max_don + 7 + mm - enddo ! mm - do mm = 1, n_fep - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_Fep(mm), nlt_bgc_Fep(mm), & - feptype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_Fep(mm)) = 2*max_algae + max_doc + max_dic & - + max_don + max_fe + 7 + mm - enddo ! mm - endif ! tr_bgc_Fe - - if (tr_bgc_hum) then - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc_hum, nlt_bgc_hum, & - humtype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_bgc_hum) = 2*max_algae + max_doc + 8 + max_dic & - + max_don + 2*max_fe + max_aero - endif - endif ! skl_bgc or z_tracers - - if (z_tracers) then ! defined on nblyr+1 in ice - ! and 2 snow layers (snow surface + interior) - - nk = nblyr + 1 - nt_depend = 2 + nt_fbri + ntd - - ! z layer aerosols - if (tr_zaero) then - do mm = 1, n_zaero - if (dEdd_algae) then - nlt_zaero_sw(mm) = nbtrcr_sw + 1 - nbtrcr_sw = nbtrcr_sw + nilyr + nslyr+2 - endif - call colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_zaero(mm), nlt_zaero(mm), & - zaerotype(mm), nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - bio_index_o(nlt_zaero(mm)) = 2*max_algae + max_doc + max_dic & - + max_don + 2*max_fe + 7 + mm - enddo ! mm - endif ! tr_zaero - - nt_zbgc_frac = 0 - if (nbtrcr > 0) then - nt_zbgc_frac = ntrcr + 1 - ntrcr = ntrcr + nbtrcr - do k = 1,nbtrcr - zbgc_frac_init(k) = c1 - trcr_depend(nt_zbgc_frac+k-1) = 2+nt_fbri - trcr_base(nt_zbgc_frac+ k - 1,1) = c0 - trcr_base(nt_zbgc_frac+ k - 1,2) = c1 - trcr_base(nt_zbgc_frac+ k - 1,3) = c0 - n_trcr_strata(nt_zbgc_frac+ k - 1)= 1 - nt_strata(nt_zbgc_frac+ k - 1,1) = nt_fbri - nt_strata(nt_zbgc_frac+ k - 1,2) = 0 - tau_ret(k) = c1 - tau_rel(k) = c1 - if (bgc_tracer_type(k) >= c0 .and. bgc_tracer_type(k) < p5) then - tau_ret(k) = tau_min - tau_rel(k) = tau_max - zbgc_frac_init(k) = c1 - elseif (bgc_tracer_type(k) >= p5 .and. bgc_tracer_type(k) < c1) then - tau_ret(k) = tau_min - tau_rel(k) = tau_min - zbgc_frac_init(k) = c1 - elseif (bgc_tracer_type(k) >= c1 .and. bgc_tracer_type(k) < c2) then - tau_ret(k) = tau_max - tau_rel(k) = tau_min - zbgc_frac_init(k) = c1 - elseif (bgc_tracer_type(k) >= c2 ) then - tau_ret(k) = tau_max - tau_rel(k) = tau_max - zbgc_frac_init(k) = c1 - endif - enddo - endif - - endif ! z_tracers - - do k = 1, nbtrcr - zbgc_init_frac(k) = frazil_scav - if (bgc_tracer_type(k) < c0) zbgc_init_frac(k) = initbio_frac - enddo - - end subroutine colpkg_init_zbgc - -!======================================================================= - - subroutine colpkg_init_bgc_trcr(nk, nt_fbri, & - nt_bgc, nlt_bgc, & - bgctype, nt_depend, & - ntrcr, nbtrcr, & - bgc_tracer_type, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, bio_index) - - use ice_constants_colpkg, only: c0, c1 - - integer (kind=int_kind), intent(in) :: & - nk , & ! counter - nt_depend , & ! tracer dependency index - nt_fbri - - integer (kind=int_kind), intent(inout) :: & - ntrcr , & ! number of tracers - nbtrcr , & ! number of bio tracers - nt_bgc , & ! tracer index - nlt_bgc ! bio tracer index - - integer (kind=int_kind), dimension(:), intent(inout) :: & - trcr_depend , & ! tracer dependencies - n_trcr_strata, & ! number of underlying tracer layers - bio_index ! - - integer (kind=int_kind), dimension(:,:), intent(inout) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - real (kind=dbl_kind), intent(in) :: & - bgctype ! bio tracer transport type (mobile vs stationary) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - bgc_tracer_type ! bio tracer transport type array - - ! local variables - - integer (kind=int_kind) :: & - k , & ! loop index - n_strata , & ! temporary values - nt_strata1, & ! - nt_strata2 - - real (kind=dbl_kind) :: & - trcr_base1, & ! temporary values - trcr_base2, & - trcr_base3 - - nt_bgc = ntrcr + 1 - nbtrcr = nbtrcr + 1 - nlt_bgc = nbtrcr - bgc_tracer_type(nbtrcr) = bgctype - - if (nk > 1) then - ! include vertical bgc in snow - do k = nk, nk+1 - ntrcr = ntrcr + 1 - trcr_depend (nt_bgc + k ) = 2 ! snow volume - trcr_base (nt_bgc + k,1) = c0 - trcr_base (nt_bgc + k,2) = c0 - trcr_base (nt_bgc + k,3) = c1 - n_trcr_strata(nt_bgc + k ) = 0 - nt_strata (nt_bgc + k,1) = 0 - nt_strata (nt_bgc + k,2) = 0 - enddo - - trcr_base1 = c0 - trcr_base2 = c1 - trcr_base3 = c0 - n_strata = 1 - nt_strata1 = nt_fbri - nt_strata2 = 0 - else ! nk = 1 - trcr_base1 = c1 - trcr_base2 = c0 - trcr_base3 = c0 - n_strata = 0 - nt_strata1 = 0 - nt_strata2 = 0 - endif ! nk - - do k = 1, nk !in ice - ntrcr = ntrcr + 1 - trcr_depend (nt_bgc + k - 1 ) = nt_depend - trcr_base (nt_bgc + k - 1,1) = trcr_base1 - trcr_base (nt_bgc + k - 1,2) = trcr_base2 - trcr_base (nt_bgc + k - 1,3) = trcr_base3 - n_trcr_strata(nt_bgc + k - 1 ) = n_strata - nt_strata (nt_bgc + k - 1,1) = nt_strata1 - nt_strata (nt_bgc + k - 1,2) = nt_strata2 - enddo - - bio_index (nlt_bgc) = nt_bgc - - end subroutine colpkg_init_bgc_trcr - -!======================================================================= -! Temperature functions -!======================================================================= - - function colpkg_liquidus_temperature(Sin) result(Tmlt) - - use ice_colpkg_shared, only: ktherm - use ice_constants_colpkg, only: depressT - use ice_mushy_physics, only: liquidus_temperature_mush - - real(dbl_kind), intent(in) :: Sin - real(dbl_kind) :: Tmlt - - if (ktherm == 2) then - - Tmlt = liquidus_temperature_mush(Sin) - - else - - Tmlt = -depressT * Sin - - endif - - end function colpkg_liquidus_temperature - -!======================================================================= - - function colpkg_sea_freezing_temperature(sss) result(Tf) - - use ice_colpkg_shared, only: tfrz_option - use ice_constants_colpkg, only: depressT, Tocnfrz - - real(dbl_kind), intent(in) :: sss - real(dbl_kind) :: Tf - - if (trim(tfrz_option) == 'mushy') then - - Tf = colpkg_liquidus_temperature(sss) ! deg C - - elseif (trim(tfrz_option) == 'linear_salt') then - - Tf = -depressT * sss ! deg C - - else - - Tf = Tocnfrz - - endif - - end function colpkg_sea_freezing_temperature - -!======================================================================= - - function colpkg_ice_temperature(qin, Sin) result(Tin) - - use ice_colpkg_shared, only: ktherm - use ice_constants_colpkg, only: depressT - use ice_mushy_physics, only: temperature_mush - use ice_therm_shared, only: calculate_Tin_from_qin - - real(kind=dbl_kind), intent(in) :: qin, Sin - real(kind=dbl_kind) :: Tin - - real(kind=dbl_kind) :: Tmlts - - if (ktherm == 2) then - - Tin = temperature_mush(qin, Sin) - - else - - Tmlts = -depressT * Sin - Tin = calculate_Tin_from_qin(qin,Tmlts) - - endif - - end function colpkg_ice_temperature - -!======================================================================= - - function colpkg_snow_temperature(qin) result(Tsn) - - use ice_colpkg_shared, only: ktherm - use ice_mushy_physics, only: temperature_snow - use ice_constants_colpkg, only: Lfresh, rhos, cp_ice - - real(kind=dbl_kind), intent(in) :: qin - real(kind=dbl_kind) :: Tsn - - if (ktherm == 2) then - - Tsn = temperature_snow(qin) - - else - - Tsn = (Lfresh + qin/rhos)/cp_ice - - endif - - end function colpkg_snow_temperature - -!======================================================================= - - function colpkg_enthalpy_ice(zTin, zSin) result(qin) - - use ice_colpkg_shared, only: ktherm - use ice_mushy_physics, only: enthalpy_mush - use ice_constants_colpkg, only: depressT, rhoi, cp_ice, Lfresh, cp_ocn, c1 - - real(kind=dbl_kind), intent(in) :: zTin - real(kind=dbl_kind), intent(in) :: zSin - real(kind=dbl_kind) :: qin - - real(kind=dbl_kind) :: Tmlt - - if (ktherm == 2) then - - qin = enthalpy_mush(zTin, zSin) - - else - - Tmlt = -zSin*depressT - qin = -(rhoi * (cp_ice*(Tmlt-zTin) + Lfresh*(c1-Tmlt/zTin) - cp_ocn*Tmlt)) - - endif - - end function colpkg_enthalpy_ice - -!======================================================================= - - function colpkg_enthalpy_snow(zTsn) result(qsn) - - use ice_mushy_physics, only: enthalpy_snow - - real(kind=dbl_kind), intent(in) :: zTsn - real(kind=dbl_kind) :: qsn - - qsn = enthalpy_snow(zTsn) - - end function colpkg_enthalpy_snow - -!======================================================================= -! Time-stepping routines -!======================================================================= - -! Driver for thermodynamic changes not needed for coupling: -! transport in thickness space, lateral growth and melting. -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine colpkg_step_therm1(dt, ncat, nilyr, nslyr, n_aero, & - aice0 , & - aicen_init , & - vicen_init , vsnon_init , & - aice , aicen , & - vice , vicen , & - vsno , vsnon , & - uvel , vvel , & - Tsfc , zqsn , & - zqin , zSin , & - smice , smliq , & - alvl , vlvl , & - apnd , hpnd , & - ipnd , & - iage , FY , & - rsnw , use_smliq_pnd,& - aerosno , aeroice , & - uatm , vatm , & - wind , zlvl , & - Qa , rhoa , & - Tair , Tref , & - Qref , Uref , & - Cdn_atm_ratio, & - Cdn_ocn , Cdn_ocn_skin, & - Cdn_ocn_floe, Cdn_ocn_keel, & - Cdn_atm , Cdn_atm_skin, & - Cdn_atm_floe, Cdn_atm_pond, & - Cdn_atm_rdg , hfreebd , & - hdraft , hridge , & - distrdg , hkeel , & - dkeel , lfloe , & - dfloe , & - strax , stray , & - strairxT , strairyT , & - potT , sst , & - sss , Tf , & - strocnxT , strocnyT , & - fbot , & - frzmlt , rside , & - fsnow , frain , & - fpond , fsloss , & - fsurf , fsurfn , & - fcondtop , fcondtopn , & - fswsfcn , fswintn , & - fswthrun , fswabs , & - flwout , & - Sswabsn , Iswabsn , & - flw , coszen , & - fsens , fsensn , & - flat , flatn , & - evap , & - fresh , fsalt , & - fhocn , fswthru , & - flatn_f , fsensn_f , & - fsurfn_f , fcondtopn_f , & - faero_atm , faero_ocn , & - dhsn , ffracn , & - meltt , melttn , & - meltb , meltbn , & - meltl , & - melts , meltsn , & - meltsliq , meltsliqn , & - congel , congeln , & - snoice , snoicen , & - dsnown , frazil , & - lmask_n , lmask_s , & - mlt_onset , frz_onset , & - yday , l_stop , & - stop_label , prescribed_ice) - - use ice_aerosol, only: update_aerosol - use ice_atmo, only: neutral_drag_coeffs - use ice_age, only: increment_age - use ice_constants_colpkg, only: rhofresh, rhoi, rhos, c0, c1, puny - use ice_firstyear, only: update_FYarea - use ice_flux_colpkg, only: set_sfcflux, merge_fluxes - use ice_meltpond_cesm, only: compute_ponds_cesm - use ice_meltpond_lvl, only: compute_ponds_lvl - use ice_meltpond_topo, only: compute_ponds_topo - use ice_snow, only: drain_snow - use ice_therm_shared, only: hi_min - use ice_therm_vertical, only: frzmlt_bottom_lateral, thermo_vertical - use ice_colpkg_tracers, only: tr_iage, tr_FY, tr_aero, tr_pond, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_snow, tr_rsnw - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero ! number of aerosol tracers in use - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - uvel , & ! x-component of velocity (m/s) - vvel , & ! y-component of velocity (m/s) - strax , & ! wind stress components (N/m^2) - stray , & ! - yday ! day of year - - logical (kind=log_kind), intent(in) :: & - lmask_n , & ! northern hemisphere mask - lmask_s , & ! southern hemisphere mask - use_smliq_pnd ! if true, use snow liquid tracer for ponds - - logical (kind=log_kind), intent(in), optional :: & - prescribed_ice ! if .true., use prescribed ice instead of computed - - !NJ: for bulk conservation fix - !real (kind=dbl_kind), intent(in) :: & - ! frain , & ! rainfall rate (kg/m^2 s) - ! fsnow ! snowfall rate (kg/m^2 s) - - real (kind=dbl_kind), intent(inout) :: & - aice0 , & ! open water fraction - aice , & ! sea ice concentration - vice , & ! volume per unit area of ice (m) - vsno , & ! volume per unit area of snow (m) - zlvl , & ! atm level height (m) - uatm , & ! wind velocity components (m/s) - vatm , & - wind , & ! wind speed (m/s) - potT , & ! air potential temperature (K) - Tair , & ! air temperature (K) - Qa , & ! specific humidity (kg/kg) - rhoa , & ! air density (kg/m^3) - frain , & ! rainfall rate (kg/m^2 s) - fsnow , & ! snowfall rate (kg/m^2 s) - fsloss , & ! blowing snow loss to leads (kg/m^2/s) - fpond , & ! fresh water flux to ponds (kg/m^2/s) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fsalt , & ! salt flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fswthru , & ! shortwave penetrating to ocean (W/m^2) - fsurf , & ! net surface heat flux (excluding fcondtop)(W/m^2) - fcondtop , & ! top surface conductive flux (W/m^2) - fsens , & ! sensible heat flux (W/m^2) - flat , & ! latent heat flux (W/m^2) - fswabs , & ! shortwave flux absorbed in ice and ocean (W/m^2) - coszen , & ! cosine solar zenith angle, < 0 for sun below horizon - flw , & ! incoming longwave radiation (W/m^2) - flwout , & ! outgoing longwave radiation (W/m^2) - evap , & ! evaporative water flux (kg/m^2/s) - congel , & ! basal ice growth (m/step-->cm/day) - frazil , & ! frazil ice growth (m/step-->cm/day) - snoice , & ! snow-ice formation (m/step-->cm/day) - Tref , & ! 2m atm reference temperature (K) - Qref , & ! 2m atm reference spec humidity (kg/kg) - Uref , & ! 10m atm reference wind speed (m/s) - Cdn_atm , & ! atm drag coefficient - Cdn_ocn , & ! ocn drag coefficient - hfreebd , & ! freeboard (m) - hdraft , & ! draft of ice + snow column (Stoessel1993) - hridge , & ! ridge height - distrdg , & ! distance between ridges - hkeel , & ! keel depth - dkeel , & ! distance between keels - lfloe , & ! floe length - dfloe , & ! distance between floes - Cdn_atm_skin, & ! neutral skin drag coefficient - Cdn_atm_floe, & ! neutral floe edge drag coefficient - Cdn_atm_pond, & ! neutral pond edge drag coefficient - Cdn_atm_rdg , & ! neutral ridge drag coefficient - Cdn_ocn_skin, & ! skin drag coefficient - Cdn_ocn_floe, & ! floe edge drag coefficient - Cdn_ocn_keel, & ! keel drag coefficient - Cdn_atm_ratio,& ! ratio drag atm / neutral drag atm - strairxT , & ! stress on ice by air, x-direction - strairyT , & ! stress on ice by air, y-direction - strocnxT , & ! ice-ocean stress, x-direction - strocnyT , & ! ice-ocean stress, y-direction - fbot , & ! ice-ocean heat flux at bottom surface (W/m^2) - frzmlt , & ! freezing/melting potential (W/m^2) - rside , & ! fraction of ice that melts laterally - sst , & ! sea surface temperature (C) - Tf , & ! freezing temperature (C) - sss , & ! sea surface salinity (ppt) - meltt , & ! top ice melt (m/step-->cm/day) - melts , & ! snow melt (m/step-->cm/day) - meltsliq , & ! snow melt mass (kg/m^2/step-->kg/m^2/day) - meltb , & ! basal ice melt (m/step-->cm/day) - meltl , & ! lateral ice melt (m/step-->cm/day) - mlt_onset , & ! day of year that sfc melting begins - frz_onset ! day of year that freezing begins (congel or frazil) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - aicen_init , & ! fractional area of ice - vicen_init , & ! volume per unit area of ice (m) - vsnon_init , & ! volume per unit area of snow (m) - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon , & ! volume per unit area of snow (m) - Tsfc , & ! ice/snow surface temperature, Tsfcn - alvl , & ! level ice area fraction - vlvl , & ! level ice volume fraction - apnd , & ! melt pond area fraction - hpnd , & ! melt pond depth (m) - ipnd , & ! melt pond refrozen lid thickness (m) - iage , & ! volume-weighted ice age - FY , & ! area-weighted first-year ice area - fsurfn , & ! net flux to top surface, excluding fcondtop - fcondtopn , & ! downward cond flux at top surface (W m-2) - flatn , & ! latent heat flux (W m-2) - fsensn , & ! sensible heat flux (W m-2) - fsurfn_f , & ! net flux to top surface, excluding fcondtop - fcondtopn_f , & ! downward cond flux at top surface (W m-2) - flatn_f , & ! latent heat flux (W m-2) - fsensn_f , & ! sensible heat flux (W m-2) - fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) - fswthrun , & ! SW through ice to ocean (W/m^2) - fswintn , & ! SW absorbed in ice interior, below surface (W m-2) - faero_atm , & ! aerosol deposition rate (kg/m^2 s) - faero_ocn , & ! aerosol flux to ocean (kg/m^2/s) - dhsn , & ! depth difference for snow on sea ice and pond ice - ffracn , & ! fraction of fsurfn used to melt ipond - meltsn , & ! snow melt (m) - meltsliqn , & ! snow melt mass (kg/m^2) - melttn , & ! top ice melt (m) - meltbn , & ! bottom ice melt (m) - congeln , & ! congelation ice growth (m) - snoicen , & ! snow-ice growth (m) - dsnown ! change in snow thickness (m/step-->cm/day) - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - zqsn , & ! snow layer enthalpy (J m-3) - zqin , & ! ice layer enthalpy (J m-3) - zSin , & ! internal ice layer salinities - smice , & ! ice mass tracer in snow (kg/m^3) - smliq , & ! liquid water mass tracer in snow (kg/m^3) - Sswabsn , & ! SW radiation absorbed in snow layers (W m-2) - Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) - rsnw ! snow grain radius (10^-6 m) in snow layers - - real (kind=dbl_kind), dimension(:,:,:), intent(inout) :: & - aerosno , & ! snow aerosol tracer (kg/m^2) - aeroice ! ice aerosol tracer (kg/m^2) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - - integer (kind=int_kind) :: & - n ! category index - - real (kind=dbl_kind) :: & - worka, workb ! temporary variables - - ! 2D coupler variables (computed for each category, then aggregated) - real (kind=dbl_kind) :: & - fswabsn , & ! shortwave absorbed by ice (W/m^2) - flwoutn , & ! upward LW at surface (W/m^2) - evapn , & ! flux of vapor, atmos to ice (kg m-2 s-1) - freshn , & ! flux of water, ice to ocean (kg/m^2/s) - fsaltn , & ! flux of salt, ice to ocean (kg/m^2/s) - fhocnn , & ! fbot corrected for leftover energy (W/m^2) - strairxn , & ! air/ice zonal stress, (N/m^2) - strairyn , & ! air/ice meridional stress, (N/m^2) - Cdn_atm_ratio_n, & ! drag coefficient ratio - Trefn , & ! air tmp reference level (K) - Urefn , & ! air speed reference level (m/s) - Qrefn , & ! air sp hum reference level (kg/kg) - Tbot , & ! ice bottom surface temperature (deg C) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - rfrac ! water fraction retained for melt ponds - - real (kind=dbl_kind) :: & - raice , & ! 1/aice - pond ! water retained in ponds (m) - - !--------------------------------------------------------------- - ! Initialize rate of snow loss to leads - !--------------------------------------------------------------- - - fsloss = fsnow*aice0 - !NJ: for bulk conservation fix - !fsloss = c0 - - !--------------------------------------------------------------- - ! 30% rule for snow redistribution: precip factor - !--------------------------------------------------------------- - - if (trim(snwredist) == '30percent') then - worka = c0 - do n = 1, ncat - worka = worka + alvl(n)*aicen(n) - enddo - worka = worka * snwlvlfac/(c1+snwlvlfac)/aice - fsloss = fsloss + fsnow * worka - fsnow = fsnow * (c1-worka) - !NJ: for bulk conservation fix. - !don't change fsnow above - !fsloss = fsnow * worka - endif ! snwredist - - !----------------------------------------------------------------- - ! Adjust frzmlt to account for ice-ocean heat fluxes since last - ! call to coupler. - ! Compute lateral and bottom heat fluxes. - !----------------------------------------------------------------- - - call frzmlt_bottom_lateral (dt, ncat, & - nilyr, nslyr, & - aice, frzmlt, & - vicen, vsnon, & - zqin, zqsn, & - sst, Tf, & - ustar_min, & - fbot_xfer_type, & - strocnxT, strocnyT, & - Tbot, fbot, & - rside, Cdn_ocn) - - !----------------------------------------------------------------- - ! Update the neutral drag coefficients to account for form drag - ! Oceanic and atmospheric drag coefficients - !----------------------------------------------------------------- - - if (formdrag) then - call neutral_drag_coeffs (apnd , & - hpnd , ipnd , & - alvl , vlvl , & - aice , vice, & - vsno , aicen , & - vicen , vsnon , & - Cdn_ocn , Cdn_ocn_skin, & - Cdn_ocn_floe, Cdn_ocn_keel, & - Cdn_atm , Cdn_atm_skin, & - Cdn_atm_floe, Cdn_atm_pond, & - Cdn_atm_rdg , hfreebd , & - hdraft , hridge , & - distrdg , hkeel , & - dkeel , lfloe , & - dfloe , ncat) - endif - - do n = 1, ncat - - meltsn (n) = c0 - meltsliqn(n) = c0 - melttn (n) = c0 - meltbn (n) = c0 - congeln(n) = c0 - snoicen(n) = c0 - dsnown (n) = c0 - - Trefn = c0 - Qrefn = c0 - Urefn = c0 - lhcoef = c0 - shcoef = c0 - worka = c0 - workb = c0 - - if (aicen_init(n) > puny) then - - if (calc_Tsfc .or. calc_strair) then - - !----------------------------------------------------------------- - ! Atmosphere boundary layer calculation; compute coefficients - ! for sensible and latent heat fluxes. - ! - ! NOTE: The wind stress is computed here for later use if - ! calc_strair = .true. Otherwise, the wind stress - ! components are set to the data values. - !----------------------------------------------------------------- - - call colpkg_atm_boundary( 'ice', & - Tsfc(n), potT, & - uatm, vatm, & - wind, zlvl, & - Qa, rhoa, & - strairxn, strairyn, & - Trefn, Qrefn, & - worka, workb, & - lhcoef, shcoef, & - Cdn_atm, & - Cdn_atm_ratio_n, & - uvel, vvel, & - Uref=Urefn) - - endif ! calc_Tsfc or calc_strair - - if (.not.(calc_strair)) then -#ifndef CICE_IN_NEMO - ! Set to data values (on T points) - strairxn = strax - strairyn = stray -#else - ! NEMO wind stress is supplied on u grid, multipied - ! by ice concentration and set directly in evp, so - ! strairxT/yT = 0. Zero u-components here for safety. - strairxn = c0 - strairyn = c0 -#endif - endif - - !----------------------------------------------------------------- - ! Update ice age - ! This is further adjusted for freezing in the thermodynamics. - ! Melting does not alter the ice age. - !----------------------------------------------------------------- - - if (tr_iage) call increment_age (dt, iage(n)) - if (tr_FY) call update_FYarea (dt, & - lmask_n, lmask_s, & - yday, FY(n)) - - !----------------------------------------------------------------- - ! Vertical thermodynamics: Heat conduction, growth and melting. - !----------------------------------------------------------------- - - if (.not.(calc_Tsfc)) then - - ! If not calculating surface temperature and fluxes, set - ! surface fluxes (flatn, fsurfn, and fcondtopn) to be used - ! in thickness_changes - - ! hadgem routine sets fluxes to default values in ice-only mode - call set_sfcflux(aicen (n), & - flatn_f (n), fsensn_f (n), & - fcondtopn_f(n), & - fsurfn_f (n), & - flatn (n), fsensn (n), & - fsurfn (n), & - fcondtopn (n)) - endif - - call thermo_vertical(nilyr, nslyr, & - dt, aicen (n), & - vicen (n), vsnon (n), & - Tsfc (n), zSin (:,n), & - zqin (:,n), zqsn (:,n), & - smice (:,n), smliq (:,n), & - tr_snow, apnd (n), & - hpnd (n), iage (n), & - tr_pond_topo, & - flw, potT, & - Qa, rhoa, & - fsnow, fpond, & - fbot, Tbot, & - sss, rsnw (:,n), & - lhcoef, shcoef, & - fswsfcn (n), fswintn (n), & - Sswabsn(:,n), Iswabsn(:,n), & - fsurfn (n), fcondtopn(n), & - fsensn (n), flatn (n), & - flwoutn, evapn, & - freshn, fsaltn, & - fhocnn, frain, & - melttn (n), meltsn (n), & - meltbn (n), meltsliqn(n), & - congeln (n), snoicen (n), & - mlt_onset, frz_onset, & - yday, dsnown (n), & - tr_rsnw, & - !NJ: for bulk conservation fix - !tr_rsnw, fsloss , & - l_stop, stop_label, & - prescribed_ice) - - if (l_stop) then - stop_label = 'ice: Vertical thermo error: '//trim(stop_label) - return - endif - - !----------------------------------------------------------------- - ! Total absorbed shortwave radiation - !----------------------------------------------------------------- - - fswabsn = fswsfcn(n) + fswintn(n) + fswthrun(n) - - !----------------------------------------------------------------- - ! Aerosol update - !----------------------------------------------------------------- - - if (tr_aero) then - call update_aerosol (dt, & - nilyr, nslyr, n_aero, & - melttn (n), meltsn (n), & - meltbn (n), congeln (n), & - snoicen (n), fsnow, & - aerosno(:,:,n), aeroice(:,:,n), & - aicen_init (n), vicen_init (n), & - vsnon_init (n), & - vicen (n), vsnon (n), & - aicen (n), & - faero_atm , faero_ocn) - endif - - endif ! aicen_init - - !----------------------------------------------------------------- - ! Transport liquid water in snow between layers and - ! compute the meltpond contribution - !----------------------------------------------------------------- - if (tr_rsnw) & - call drain_snow (dt, nslyr, & - vsnon (n) , aicen (n), & - smice (:,n), smliq (:,n), & - meltsliqn(n), use_smliq_pnd) - - - !----------------------------------------------------------------- - ! Melt ponds - ! If using tr_pond_cesm, the full calculation is performed here. - ! If using tr_pond_topo, the rest of the calculation is done after - ! the surface fluxes are merged, below. - !----------------------------------------------------------------- - - !call ice_timer_start(timer_ponds) - if (tr_pond) then - if (tr_pond_cesm) then - rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) - call compute_ponds_cesm(dt, hi_min, & - pndaspect, rfrac, & - melttn(n), meltsn(n), & - frain, & - aicen (n), vicen (n), & - vsnon (n), Tsfc (n), & - apnd (n), hpnd (n), & - meltsliqn(n), & - use_smliq_pnd) - - elseif (tr_pond_lvl) then - rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) - call compute_ponds_lvl(dt, nilyr, & - ktherm, & - hi_min, & - dpscale, frzpnd, & - pndaspect, rfrac, & - melttn(n), meltsn(n), & - frain, Tair, & - fsurfn(n), & - dhsn (n), ffracn(n), & - aicen (n), vicen (n), & - vsnon (n), & - zqin(:,n), zSin(:,n), & - Tsfc (n), alvl (n), & - apnd (n), hpnd (n), & - ipnd (n), & - meltsliqn(n), & - use_smliq_pnd) - - elseif (tr_pond_topo) then - if (aicen_init(n) > puny) then - - ! collect liquid water in ponds - ! assume salt still runs off - rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) - if (use_smliq_pnd) then - pond = rfrac/rhofresh * (melttn(n)*rhoi & - + meltsliqn(n)) - else - pond = rfrac/rhofresh * (melttn(n)*rhoi & - + meltsn(n)*rhos & - + frain *dt) - endif - ! if pond does not exist, create new pond over full ice area - ! otherwise increase pond depth without changing pond area - if (apnd(n) < puny) then - hpnd(n) = c0 - apnd(n) = c1 - endif - hpnd(n) = (pond + hpnd(n)*apnd(n)) / apnd(n) - fpond = fpond + pond * aicen(n) ! m - endif ! aicen_init - endif - - endif ! tr_pond - !call ice_timer_stop(timer_ponds) - - !----------------------------------------------------------------- - ! Increment area-weighted fluxes. - !----------------------------------------------------------------- - - if (aicen_init(n) > puny) & - call merge_fluxes (aicen_init(n), & - flw, coszen, & - strairxn, strairyn, & - Cdn_atm_ratio_n, & - fsurfn(n), fcondtopn(n), & - fsensn(n), flatn(n), & - fswabsn, flwoutn, & - evapn, & - Trefn, Qrefn, & - freshn, fsaltn, & - fhocnn, fswthrun(n), & - strairxT, strairyT, & - Cdn_atm_ratio, & - fsurf, fcondtop, & - fsens, flat, & - fswabs, flwout, & - evap, & - Tref, Qref, & - fresh, fsalt, & - fhocn, fswthru, & - melttn (n), meltsn(n), & - meltbn (n), congeln(n), & - snoicen(n), meltsliqn(n), & - meltt, melts, & - meltb, congel, & - snoice, meltsliq, & - Uref, Urefn) - - enddo ! ncat - - !----------------------------------------------------------------- - ! Calculate ponds from the topographic scheme - !----------------------------------------------------------------- - !call ice_timer_start(timer_ponds) - if (tr_pond_topo) then - call compute_ponds_topo(dt, ncat, nilyr, & - ktherm, heat_capacity, & - aice, aicen, & - vice, vicen, & - vsno, vsnon, & - potT, meltt, & - fsurf, fpond, & - Tsfc, Tf, & - zqin, zSin, & - apnd, hpnd, ipnd, & - l_stop, stop_label) - endif - !call ice_timer_stop(timer_ponds) - - end subroutine colpkg_step_therm1 - -!======================================================================= -! Driver for thermodynamic changes not needed for coupling: -! transport in thickness space, lateral growth and melting. -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine colpkg_step_therm2 (dt, ncat, n_aero, nbtrcr, & - nilyr, nslyr, & - hin_max, nblyr, & - aicen, & - vicen, vsnon, & - aicen_init, vicen_init, & - trcrn, & - aice0, aice, & - trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, & - Tf, sss, & - salinz, & - rside, meltl, & - frzmlt, frazil, & - frain, fpond, & - fresh, fsalt, & - fhocn, update_ocn_f, & - bgrid, cgrid, & - igrid, faero_ocn, & - first_ice, fzsal, & - flux_bio, ocean_bio, & - l_stop, stop_label, & - frazil_diag, & - frz_onset, yday) - - use ice_constants_colpkg, only: puny, c0 - use ice_itd, only: aggregate_area, reduce_area, cleanup_itd - use ice_therm_itd, only: linear_itd, add_new_ice, lateral_melt - use ice_colpkg_tracers, only: ntrcr, tr_aero, tr_pond_topo, tr_brine, nt_fbri, bio_index - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nbtrcr , & ! number of zbgc tracers - nblyr , & ! number of bio layers - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero ! number of aerosol tracers - - logical (kind=log_kind), intent(in) :: & - update_ocn_f ! if true, update fresh water and salt fluxes - - real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & - hin_max ! category boundaries (m) - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - Tf , & ! freezing temperature (C) - sss , & ! sea surface salinity (ppt) - rside , & ! fraction of ice that melts laterally - frzmlt ! freezing/melting potential (W/m^2) - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), dimension(:), intent(in) :: & - salinz , & ! initial salinity profile - ocean_bio ! ocean concentration of biological tracer - - real (kind=dbl_kind), intent(inout) :: & - aice , & ! sea ice concentration - aice0 , & ! concentration of open water - frain , & ! rainfall rate (kg/m^2 s) - fpond , & ! fresh water flux to ponds (kg/m^2/s) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fsalt , & ! salt flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fzsal , & ! salt flux to ocean from zsalinity (kg/m^2/s) - meltl , & ! lateral ice melt (m/step-->cm/day) - frazil , & ! frazil ice growth (m/step-->cm/day) - frazil_diag ! frazil ice growth diagnostic (m/step-->cm/day) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - aicen_init,& ! initial concentration of ice - vicen_init,& ! initial volume per unit area of ice (m) - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon , & ! volume per unit area of snow (m) - faero_ocn, & ! aerosol flux to ocean (kg/m^2/s) - flux_bio ! all bio fluxes to ocean - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - trcrn ! tracers - - logical (kind=log_kind), dimension(:), intent(inout) :: & - first_ice ! true until ice forms - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort model - - character (len=*), intent(out) :: stop_label - - real (kind=dbl_kind), intent(inout), optional :: & - frz_onset ! day of year that freezing begins (congel or frazil) - - real (kind=dbl_kind), intent(in), optional :: & - yday ! day of year - - l_stop = .false. - - !----------------------------------------------------------------- - ! Let rain drain through to the ocean. - !----------------------------------------------------------------- - - fresh = fresh + frain * aice - - !----------------------------------------------------------------- - ! Given thermodynamic growth rates, transport ice between - ! thickness categories. - !----------------------------------------------------------------- - -! call ice_timer_start(timer_catconv) ! category conversions - - !----------------------------------------------------------------- - ! Compute fractional ice area in each grid cell. - !----------------------------------------------------------------- - - flux_bio(:) = c0 - - call aggregate_area (ncat, aicen, aice, aice0) - - if (kitd == 1) then - - !----------------------------------------------------------------- - ! Identify grid cells with ice. - !----------------------------------------------------------------- - - if (aice > puny) then - - call linear_itd (ncat, hin_max, & - nilyr, nslyr, & - ntrcr, trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen_init, & - vicen_init, & - aicen, & - trcrn, & - vicen, & - vsnon, & - aice, & - aice0, & - fpond, l_stop, & - stop_label) - - if (l_stop) return - - endif ! aice > puny - - endif ! kitd = 1 - -! call ice_timer_stop(timer_catconv) ! category conversions - - !----------------------------------------------------------------- - ! Add frazil ice growing in leads. - !----------------------------------------------------------------- - - ! identify ice-ocean cells - - call add_new_ice (ncat, nilyr, & - nblyr, & - n_aero, dt, & - ntrcr, nbtrcr, & - hin_max, ktherm, & - aicen, trcrn, & - vicen, vsnon(1), & - aice0, aice, & - frzmlt, frazil, & - frz_onset, yday, & - update_ocn_f, & - fresh, fsalt, & - Tf, sss, & - salinz, phi_init, & - dSin0_frazil, bgrid, & - cgrid, igrid, & - flux_bio, & - ocean_bio, fzsal, & - frazil_diag, & - l_stop, stop_label) - - if (l_stop) return - - !----------------------------------------------------------------- - ! Melt ice laterally. - !----------------------------------------------------------------- - - call lateral_melt (dt, ncat, & - nilyr, nslyr, & - n_aero, fpond, & - fresh, fsalt, & - fhocn, faero_ocn, & - rside, meltl, & - aicen, vicen, & - vsnon, trcrn, & - fzsal, flux_bio, & - nbtrcr, nblyr) - - !----------------------------------------------------------------- - ! For the special case of a single category, adjust the area and - ! volume (assuming that half the volume change decreases the - ! thickness, and the other half decreases the area). - !----------------------------------------------------------------- - -!echmod: test this - if (ncat==1) & - call reduce_area (hin_max (0), & - aicen (1), vicen (1), & - aicen_init(1), vicen_init(1)) - - !----------------------------------------------------------------- - ! ITD cleanup: Rebin thickness categories if necessary, and remove - ! categories with very small areas. - !----------------------------------------------------------------- - - call cleanup_itd (dt, Tf, & - ntrcr, & - nilyr, nslyr, & - ncat, hin_max, & - aicen, trcrn(1:ntrcr,:), & - vicen, vsnon, & - aice0, aice, & - n_aero, & - nbtrcr, nblyr, & - l_stop, stop_label, & - tr_aero, & - tr_pond_topo, heat_capacity, & - first_ice, & - trcr_depend, trcr_base, & - n_trcr_strata, nt_strata, & - fpond, fresh, & - fsalt, fhocn, & - faero_ocn, fzsal, & - flux_bio) - - end subroutine colpkg_step_therm2 - -!======================================================================= -! -! Scales radiation fields computed on the previous time step. -! -! authors: Elizabeth Hunke, LANL - - subroutine colpkg_prep_radiation (ncat, nilyr, nslyr, & - aice, aicen, & - swvdr, swvdf, & - swidr, swidf, & - alvdr_ai, alvdf_ai, & - alidr_ai, alidf_ai, & - scale_factor, & - fswsfcn, fswintn, & - fswthrun, fswpenln, & - Sswabsn, Iswabsn) - - use ice_constants_colpkg, only: c0, c1, puny - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of ice thickness categories - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - aice , & ! ice area fraction - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf , & ! sw down, near IR, diffuse (W/m^2) - ! grid-box-mean albedos aggregated over categories (if calc_Tsfc) - alvdr_ai , & ! visible, direct (fraction) - alidr_ai , & ! near-ir, direct (fraction) - alvdf_ai , & ! visible, diffuse (fraction) - alidf_ai ! near-ir, diffuse (fraction) - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen ! ice area fraction in each category - - real (kind=dbl_kind), intent(inout) :: & - scale_factor ! shortwave scaling factor, ratio new:old - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) - fswintn , & ! SW absorbed in ice interior, below surface (W m-2) - fswthrun ! SW through ice to ocean (W/m^2) - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - fswpenln , & ! visible SW entering ice layers (W m-2) - Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) - Sswabsn ! SW radiation absorbed in snow layers (W m-2) - - ! local variables - - integer (kind=int_kind) :: & - k , & ! vertical index - n ! thickness category index - - real (kind=dbl_kind) :: netsw - - !----------------------------------------------------------------- - ! Compute netsw scaling factor (new netsw / old netsw) - !----------------------------------------------------------------- - - if (aice > c0 .and. scale_factor > puny) then - netsw = swvdr*(c1 - alvdr_ai) & - + swvdf*(c1 - alvdf_ai) & - + swidr*(c1 - alidr_ai) & - + swidf*(c1 - alidf_ai) - scale_factor = netsw / scale_factor - else - scale_factor = c1 - endif - - do n = 1, ncat - - if (aicen(n) > puny) then - - !----------------------------------------------------------------- - ! Scale absorbed solar radiation for change in net shortwave - !----------------------------------------------------------------- - - fswsfcn(n) = scale_factor*fswsfcn (n) - fswintn(n) = scale_factor*fswintn (n) - fswthrun(n) = scale_factor*fswthrun(n) - do k = 1,nilyr+1 - fswpenln(k,n) = scale_factor*fswpenln(k,n) - enddo !k - do k=1,nslyr - Sswabsn(k,n) = scale_factor*Sswabsn(k,n) - enddo - do k=1,nilyr - Iswabsn(k,n) = scale_factor*Iswabsn(k,n) - enddo - - endif - enddo ! ncat - - end subroutine colpkg_prep_radiation - -!======================================================================= -! -! Computes radiation fields -! -! authors: William H. Lipscomb, LANL -! David Bailey, NCAR -! Elizabeth C. Hunke, LANL - - subroutine colpkg_step_radiation (dt, ncat, & - n_algae, & - nblyr, ntrcr, & - nbtrcr, nbtrcr_sw, & - nilyr, nslyr, & - n_aero, n_zaero, & - dEdd_algae, & - nlt_chl_sw, & - nlt_zaero_sw, & - swgrid, igrid, & - fbri, & - aicen, vicen, & - vsnon, Tsfcn, & - alvln, apndn, & - hpndn, ipndn, & - snwredist, & - rsnow, & - aeron, & - zbion, & - trcrn, & - TLAT, TLON, & - calendar_type, & - days_per_year, & - nextsw_cday, & - yday, sec, & - kaer_tab, waer_tab, & - gaer_tab, & - kaer_bc_tab, & - waer_bc_tab, & - gaer_bc_tab, & - bcenh, & - modal_aero, & - swvdr, swvdf, & - swidr, swidf, & - coszen, fsnow, & - alvdrn, alvdfn, & - alidrn, alidfn, & - fswsfcn, fswintn, & - fswthrun, fswpenln, & - Sswabsn, Iswabsn, & - albicen, albsnon, & - albpndn, apeffn, & - snowfracn, & - dhsn, ffracn, & - l_print_point, & - initonly, & - asm_prm_ice_drc, & - asm_prm_ice_dfs, & - ss_alb_ice_drc, & - ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, & - ext_cff_mss_ice_dfs, & - kaer_tab_5bd, & - waer_tab_5bd, & - gaer_tab_5bd, & - kaer_bc_tab_5bd, & - waer_bc_tab_5bd, & - gaer_bc_tab_5bd, & - bcenh_5bd, & - rsnw_dEddn) - - use ice_constants_colpkg, only: c0, puny - use ice_shortwave, only: run_dEdd, shortwave_ccsm3, compute_shortwave_trcr - use ice_colpkg_tracers, only: tr_pond_cesm, tr_pond_lvl, tr_pond_topo, & - tr_bgc_N, tr_aero, tr_rsnw, tr_zaero - - use ice_colpkg_shared, only: z_tracers, skl_bgc - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of ice thickness categories - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero , & ! number of aerosols - n_zaero , & ! number of zaerosols - nlt_chl_sw, & ! index for chla - nblyr , & - ntrcr , & - nbtrcr , & - nbtrcr_sw , & - n_algae - - integer (kind=int_kind), dimension(:), intent(in) :: & - nlt_zaero_sw ! index for zaerosols - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf , & ! sw down, near IR, diffuse (W/m^2) - fsnow , & ! snowfall rate (kg/m^2 s) - TLAT, TLON ! latitude and longitude (radian) - - character (len=char_len), intent(in) :: & - calendar_type ! differentiates Gregorian from other calendars - - integer (kind=int_kind), intent(in) :: & - days_per_year, & ! number of days in one year - sec ! elapsed seconds into date - - real (kind=dbl_kind), intent(in) :: & - nextsw_cday , & ! julian day of next shortwave calculation - yday ! day of the year - - real (kind=dbl_kind), intent(inout) :: & - coszen ! cosine solar zenith angle, < 0 for sun below horizon - - real (kind=dbl_kind), dimension (:), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (:), intent(in) :: & - swgrid ! grid for ice tracers used in dEdd scheme - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_tab, & ! aerosol single scatter albedo (fraction) - gaer_tab, & ! aerosol asymmetry parameter (cos(theta)) - rsnow ! snow grain radius tracer (10^-6 m) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & - bcenh - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen , & ! ice area fraction in each category - vicen , & ! ice volume in each category (m) - vsnon , & ! snow volume in each category (m) - Tsfcn , & ! surface temperature (deg C) - alvln , & ! level-ice area fraction - apndn , & ! pond area fraction - hpndn , & ! pond depth (m) - ipndn , & ! pond refrozen lid thickness (m) - fbri ! brine fraction - - character(len=char_len), intent(in) :: & - snwredist ! type of snow redistribution - - real(kind=dbl_kind), dimension(:,:), intent(in) :: & - aeron , & ! aerosols (kg/m^3) - trcrn ! tracers - - real(kind=dbl_kind), dimension(:,:), intent(inout) :: & - zbion ! zaerosols (kg/m^3) and chla (mg/m^3) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - alvdrn , & ! visible, direct albedo (fraction) - alidrn , & ! near-ir, direct (fraction) - alvdfn , & ! visible, diffuse (fraction) - alidfn , & ! near-ir, diffuse (fraction) - fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) - fswintn , & ! SW absorbed in ice interior, below surface (W m-2) - fswthrun , & ! SW through ice to ocean (W/m^2) - snowfracn , & ! snow fraction on each category - dhsn , & ! depth difference for snow on sea ice and pond ice - ffracn , & ! fraction of fsurfn used to melt ipond - ! albedo components for history - albicen , & ! bare ice - albsnon , & ! snow - albpndn , & ! pond - rsnw_dEddn, & ! snow grain radius (um) - apeffn ! effective pond area used for radiation calculation - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - fswpenln , & ! visible SW entering ice layers (W m-2) - Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) - Sswabsn ! SW radiation absorbed in snow layers (W m-2) - - logical (kind=log_kind), intent(in) :: & - l_print_point, & ! flag for printing diagnostics - dEdd_algae , & ! .true. use prognostic chla in dEdd - modal_aero ! .true. use modal aerosol optical treatment - - logical (kind=log_kind), optional :: & - initonly ! flag to indicate init only, default is false - - - ! snow grain single-scattering properties for - ! direct (drc) and diffuse (dfs) shortwave incidents - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Model SNICAR snow SSP - asm_prm_ice_drc, & ! snow asymmetry factor (cos(theta)) - asm_prm_ice_dfs, & ! snow asymmetry factor (cos(theta)) - ss_alb_ice_drc, & ! snow single scatter albedo (fraction) - ss_alb_ice_dfs, & ! snow single scatter albedo (fraction) - ext_cff_mss_ice_drc, & ! snow mass extinction cross section (m2/kg) - ext_cff_mss_ice_dfs ! snow mass extinction cross section (m2/kg) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab_5bd, & ! aerosol mass extinction cross section (m2/kg) - waer_tab_5bd, & ! aerosol single scatter albedo (fraction) - gaer_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab_5bd, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab_5bd, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh_5bd ! BC absorption enhancement factor - - ! local variables - - integer (kind=int_kind) :: & - n ! thickness category index - - logical (kind=log_kind) :: & - l_stop ,& ! if true, abort the model - linitonly ! local flag for initonly - - character (char_len) :: stop_label - - real(kind=dbl_kind) :: & - hin, & ! Ice thickness (m) - hbri ! brine thickness (m) - - hin = c0 - hbri = c0 - linitonly = .false. - if (present(initonly)) then - linitonly = initonly - endif - - ! Initialize - do n = 1, ncat - alvdrn (n) = c0 - alidrn (n) = c0 - alvdfn (n) = c0 - alidfn (n) = c0 - fswsfcn (n) = c0 - fswintn (n) = c0 - fswthrun(n) = c0 - enddo ! ncat - fswpenln (:,:) = c0 - Iswabsn (:,:) = c0 - Sswabsn (:,:) = c0 - zbion(:,:) = c0 - - ! Interpolate z-shortwave tracers to shortwave grid - if (dEdd_algae) then - do n = 1, ncat - if (aicen(n) .gt. puny) then - hin = vicen(n)/aicen(n) - hbri= fbri(n)*hin - call compute_shortwave_trcr(n_algae, nslyr, & - trcrn(1:ntrcr,n), & - zbion(1:nbtrcr_sw,n), & - swgrid, hin, & - hbri, ntrcr, & - nilyr, nblyr, & - igrid, & - nbtrcr_sw, n_zaero, & - skl_bgc, z_tracers, & - l_stop, stop_label) - endif - enddo - endif - - if (calc_Tsfc) then - if (trim(shortwave) == 'dEdd') then ! delta Eddington - - call run_dEdd(dt, tr_aero, & - tr_pond_cesm, & - tr_pond_lvl, & - tr_pond_topo, & - ncat, n_aero, & - n_zaero, dEdd_algae, & - nlt_chl_sw, nlt_zaero_sw, & - tr_bgc_N, tr_zaero, & - nilyr, nslyr, & - aicen, vicen, & - vsnon, Tsfcn, & - alvln, apndn, & - hpndn, ipndn, & - snwredist, & - rsnow, tr_rsnw, & - aeron, kalg, & - zbion, & - heat_capacity, & - TLAT, TLON, & - calendar_type,days_per_year, & - nextsw_cday, yday, & - sec, R_ice, & - R_pnd, R_snw, & - dT_mlt, rsnw_mlt, & - hs0, hs1, & - hp1, pndaspect, & - kaer_tab, waer_tab, & - gaer_tab, & - kaer_bc_tab, & - waer_bc_tab, & - gaer_bc_tab, & - bcenh, & - modal_aero, & - swvdr, swvdf, & - swidr, swidf, & - coszen, fsnow, & - alvdrn, alvdfn, & - alidrn, alidfn, & - fswsfcn, fswintn, & - fswthrun, fswpenln, & - Sswabsn, Iswabsn, & - albicen, albsnon, & - albpndn, apeffn, & - snowfracn, & - dhsn, ffracn, & - rsnw_dEddn, & - l_print_point, & - linitonly, & - use_snicar, & - asm_prm_ice_drc, & - asm_prm_ice_dfs, & - ss_alb_ice_drc, & - ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, & - ext_cff_mss_ice_dfs, & - kaer_tab_5bd, & - waer_tab_5bd, & - gaer_tab_5bd, & - kaer_bc_tab_5bd, & - waer_bc_tab_5bd, & - gaer_bc_tab_5bd, & - bcenh_5bd) - - else ! .not. dEdd - - call shortwave_ccsm3(aicen, vicen, & - vsnon, & - Tsfcn, & - swvdr, swvdf, & - swidr, swidf, & - heat_capacity, & - albedo_type, & - albicev, albicei, & - albsnowv, albsnowi, & - ahmax, & - alvdrn, alidrn, & - alvdfn, alidfn, & - fswsfcn, fswintn, & - fswthrun, & - fswpenln, & - Iswabsn, & - Sswabsn, & - albicen, albsnon, & - coszen, ncat) - - endif ! shortwave - - else ! .not. calc_Tsfc - - ! Calculate effective pond area for HadGEM - - if (tr_pond_topo) then - do n = 1, ncat - apeffn(n) = c0 - if (aicen(n) > puny) then - ! Lid effective if thicker than hp1 - if (apndn(n)*aicen(n) > puny .and. ipndn(n) < hp1) then - apeffn(n) = apndn(n) - else - apeffn(n) = c0 - endif - if (apndn(n) < puny) apeffn(n) = c0 - endif - enddo ! ncat - - endif ! tr_pond_topo - - ! Initialize for safety - do n = 1, ncat - alvdrn(n) = c0 - alidrn(n) = c0 - alvdfn(n) = c0 - alidfn(n) = c0 - fswsfcn(n) = c0 - fswintn(n) = c0 - fswthrun(n) = c0 - enddo ! ncat - Iswabsn(:,:) = c0 - Sswabsn(:,:) = c0 - - endif ! calc_Tsfc - - end subroutine colpkg_step_radiation - -!======================================================================= -! -! Computes sea ice mechanical deformation -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine colpkg_step_ridge (dt, ndtd, & - nilyr, nslyr, & - nblyr, & - ncat, hin_max, & - rdg_conv, rdg_shear, & - Tf, & - aicen, & - trcrn, & - vicen, vsnon, & - aice0, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, & - dardg1dt, dardg2dt, & - dvirdgdt, opening, & - fpond, & - fresh, fhocn, & - n_aero, & - faero_ocn, & - aparticn, krdgn, & - aredistn, vredistn, & - dardg1ndt, dardg2ndt, & - dvirdgndt, & - araftn, vraftn, & - aice, fsalt, & - first_ice, fzsal, & - flux_bio, & - l_stop, stop_label) - - use ice_mechred, only: ridge_ice - use ice_itd, only: cleanup_itd - use ice_colpkg_tracers, only: tr_pond_topo, tr_aero, tr_brine, ntrcr, nbtrcr - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - Tf ! ocean freezing temperature - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - ndtd , & ! number of dynamics supercycles - nblyr , & ! number of bio layers - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero ! number of aerosol tracers - - real (kind=dbl_kind), dimension(0:ncat), intent(inout) :: & - hin_max ! category limits (m) - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), intent(inout) :: & - aice , & ! sea ice concentration - aice0 , & ! concentration of open water - rdg_conv , & ! convergence term for ridging (1/s) - rdg_shear, & ! shear term for ridging (1/s) - dardg1dt , & ! rate of area loss by ridging ice (1/s) - dardg2dt , & ! rate of area gain by new ridges (1/s) - dvirdgdt , & ! rate of ice volume ridged (m/s) - opening , & ! rate of opening due to divergence/shear (1/s) - fpond , & ! fresh water flux to ponds (kg/m^2/s) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fsalt , & ! salt flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fzsal ! zsalinity flux to ocean(kg/m^2/s) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon , & ! volume per unit area of snow (m) - dardg1ndt, & ! rate of area loss by ridging ice (1/s) - dardg2ndt, & ! rate of area gain by new ridges (1/s) - dvirdgndt, & ! rate of ice volume ridged (m/s) - aparticn , & ! participation function - krdgn , & ! mean ridge thickness/thickness of ridging ice - araftn , & ! rafting ice area - vraftn , & ! rafting ice volume - aredistn , & ! redistribution function: fraction of new ridge area - vredistn , & ! redistribution function: fraction of new ridge volume - faero_ocn, & ! aerosol flux to ocean (kg/m^2/s) - flux_bio ! all bio fluxes to ocean - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - trcrn ! tracers - - !logical (kind=log_kind), intent(in) :: & - !tr_pond_topo,& ! if .true., use explicit topography-based ponds - !tr_aero ,& ! if .true., use aerosol tracers - !tr_brine !,& ! if .true., brine height differs from ice thickness - !heat_capacity ! if true, ice has nonzero heat capacity - - logical (kind=log_kind), dimension(:), intent(inout) :: & - first_ice ! true until ice forms - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort the model - - character (len=*), intent(out) :: & - stop_label ! diagnostic information for abort - - ! local variables - - real (kind=dbl_kind) :: & - dtt , & ! thermo time step - atmp , & ! temporary ice area - atmp0 ! temporary open water area - - l_stop = .false. - - !----------------------------------------------------------------- - ! Identify ice-ocean cells. - ! Note: We can not limit the loop here using aice>puny because - ! aice has not yet been updated since the transport (and - ! it may be out of whack, which the ridging helps fix).-ECH - !----------------------------------------------------------------- - - call ridge_ice (dt, ndtd, & - ncat, n_aero, & - nilyr, nslyr, & - ntrcr, hin_max, & - rdg_conv, rdg_shear, & - aicen, & - trcrn, & - vicen, vsnon, & - aice0, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, & - l_stop, & - stop_label, & - krdg_partic, krdg_redist, & - mu_rdg, & - dardg1dt, dardg2dt, & - dvirdgdt, opening, & - fpond, & - fresh, fhocn, & - tr_brine, faero_ocn, & - aparticn, krdgn, & - aredistn, vredistn, & - dardg1ndt, dardg2ndt, & - dvirdgndt, & - araftn, vraftn, & - Tf) - - if (l_stop) return - - !----------------------------------------------------------------- - ! ITD cleanup: Rebin thickness categories if necessary, and remove - ! categories with very small areas. - !----------------------------------------------------------------- - - dtt = dt * ndtd ! for proper averaging over thermo timestep - call cleanup_itd (dtt, Tf, & - ntrcr, & - nilyr, nslyr, & - ncat, hin_max, & - aicen, trcrn, & - vicen, vsnon, & - aice0, aice, & - n_aero, & - nbtrcr, nblyr, & - l_stop, stop_label, & - tr_aero, & - tr_pond_topo, heat_capacity, & - first_ice, & - trcr_depend, trcr_base, & - n_trcr_strata, nt_strata, & - fpond, fresh, & - fsalt, fhocn, & - faero_ocn, fzsal, & - flux_bio) - - if (l_stop) then - stop_label = 'ice: ITD cleanup error in colpkg_step_ridge' - endif - - end subroutine colpkg_step_ridge - -!======================================================================= - -! Aggregate ice state variables over thickness categories. -! -! authors: C. M. Bitz, UW -! W. H. Lipscomb, LANL - - subroutine colpkg_aggregate (ncat, Tf, & - aicen, trcrn, & - vicen, vsnon, & - aice, trcr, & - vice, vsno, & - aice0, & - ntrcr, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata) - - use ice_constants_colpkg, only: c0, c1 - use ice_colpkg_tracers, only: colpkg_compute_tracers - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - ntrcr ! number of tracers in use - - real (kind=dbl_kind), intent(in) :: & - Tf ! ocean freezing temperature (Celsius) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), & - intent(inout) :: & - trcrn ! ice tracers - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), intent(out) :: & - aice , & ! concentration of ice - vice , & ! volume per unit area of ice (m) - vsno , & ! volume per unit area of snow (m) - aice0 ! concentration of open water - - real (kind=dbl_kind), dimension (:), & - intent(out) :: & - trcr ! ice tracers - - ! local variables - - integer (kind=int_kind) :: & - n, it, itl, & ! loop indices - ntr ! tracer index - - real (kind=dbl_kind), dimension (:), allocatable :: & - atrcr ! sum of aicen*trcrn or vicen*trcrn or vsnon*trcrn - - real (kind=dbl_kind) :: & - atrcrn ! category value - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - aice0 = c1 - aice = c0 - vice = c0 - vsno = c0 - - allocate (atrcr(ntrcr)) - - !----------------------------------------------------------------- - ! Aggregate - !----------------------------------------------------------------- - - atrcr(:) = c0 - - do n = 1, ncat - - aice = aice + aicen(n) - vice = vice + vicen(n) - vsno = vsno + vsnon(n) - - do it = 1, ntrcr - atrcrn = trcrn(it,n)*(trcr_base(it,1) * aicen(n) & - + trcr_base(it,2) * vicen(n) & - + trcr_base(it,3) * vsnon(n)) - if (n_trcr_strata(it) > 0) then ! additional tracer layers - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - atrcrn = atrcrn * trcrn(ntr,n) - enddo - endif - atrcr(it) = atrcr(it) + atrcrn - enddo ! ntrcr - enddo ! ncat - - ! Open water fraction - aice0 = max (c1 - aice, c0) - - ! Tracers - call colpkg_compute_tracers (ntrcr, trcr_depend, & - atrcr, aice, & - vice , vsno, & - trcr_base, n_trcr_strata, & - nt_strata, trcr, & - Tf) - - deallocate (atrcr) - - end subroutine colpkg_aggregate - -!======================================================================= - -! Compute the strength of the ice pack, defined as the energy (J m-2) -! dissipated per unit area removed from the ice pack under compression, -! and assumed proportional to the change in potential energy caused -! by ridging. -! -! See Rothrock (1975) and Hibler (1980). -! -! For simpler strength parameterization, see this reference: -! Hibler, W. D. III, 1979: A dynamic-thermodynamic sea ice model, -! J. Phys. Oceanog., 9, 817-846. -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine colpkg_ice_strength (ncat, & - aice, vice, & - aice0, aicen, & - vicen, & - strength) - - use ice_constants_colpkg, only: p333, c0, c1, c2, Cp, Pstar, Cstar, & - rhoi, puny - use ice_colpkg_shared, only: Cf - use ice_mechred, only: asum_ridging, ridge_itd - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), intent(in) :: & - aice , & ! concentration of ice - vice , & ! volume per unit area of ice (m) - aice0 ! concentration of open water - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen , & ! concentration of ice - vicen ! volume per unit area of ice (m) - - real (kind=dbl_kind), intent(inout) :: & - strength ! ice strength (N/m) - - ! local variables - - real (kind=dbl_kind) :: & - asum , & ! sum of ice and open water area - aksum ! ratio of area removed to area ridged - - real (kind=dbl_kind), dimension (0:ncat) :: & - apartic ! participation function; fraction of ridging - ! and closing associated w/ category n - - real (kind=dbl_kind), dimension (ncat) :: & - hrmin , & ! minimum ridge thickness - hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) - krdg ! mean ridge thickness/thickness of ridging ice - - integer (kind=int_kind) :: & - n ! thickness category index - - real (kind=dbl_kind) :: & - hi , & ! ice thickness (m) - h2rdg , & ! mean value of h^2 for new ridge - dh2rdg ! change in mean value of h^2 per unit area - ! consumed by ridging - - if (kstrength == 1) then ! Rothrock '75 formulation - - !----------------------------------------------------------------- - ! Compute thickness distribution of ridging and ridged ice. - !----------------------------------------------------------------- - - call asum_ridging (ncat, aicen, aice0, asum) - - call ridge_itd (ncat, aice0, & - aicen, vicen, & - krdg_partic, krdg_redist, & - mu_rdg, & - aksum, apartic, & - hrmin, hrmax, & - hrexp, krdg) - - !----------------------------------------------------------------- - ! Compute ice strength based on change in potential energy, - ! as in Rothrock (1975) - !----------------------------------------------------------------- - - if (krdg_redist==0) then ! Hibler 1980 formulation - - do n = 1, ncat - if (aicen(n) > puny .and. apartic(n) > c0)then - hi = vicen(n) / aicen(n) - h2rdg = p333 * (hrmax(n)**3 - hrmin(n)**3) & - / (hrmax(n) - hrmin(n)) - dh2rdg = -hi*hi + h2rdg/krdg(n) - strength = strength + apartic(n) * dh2rdg - endif ! aicen > puny - enddo ! n - - elseif (krdg_redist==1) then ! exponential formulation - - do n = 1, ncat - if (aicen(n) > puny .and. apartic(n) > c0) then - hi = vicen(n) / aicen(n) - h2rdg = hrmin(n)*hrmin(n) & - + c2*hrmin(n)*hrexp(n) & - + c2*hrexp(n)*hrexp(n) - dh2rdg = -hi*hi + h2rdg/krdg(n) - strength = strength + apartic(n) * dh2rdg - endif - enddo ! n - - endif ! krdg_redist - - strength = Cf * Cp * strength / aksum - ! Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) - ! Cf accounts for frictional dissipation - - else ! kstrength /= 1: Hibler (1979) form - - !----------------------------------------------------------------- - ! Compute ice strength as in Hibler (1979) - !----------------------------------------------------------------- - - strength = Pstar*vice*exp(-Cstar*(c1-aice)) - - endif ! kstrength - - end subroutine colpkg_ice_strength - -!======================================================================= - - subroutine colpkg_atm_boundary(sfctype, & - Tsf, potT, & - uatm, vatm, & - wind, zlvl, & - Qa, rhoa, & - strx, stry, & - Tref, Qref, & - delt, delq, & - lhcoef, shcoef, & - Cdn_atm, & - Cdn_atm_ratio_n, & - uvel, vvel, & - Uref) - - use ice_atmo, only: atmo_boundary_const, atmo_boundary_layer - use ice_constants_colpkg, only: c0, c1 - - character (len=3), intent(in) :: & - sfctype ! ice or ocean - - real (kind=dbl_kind), intent(in) :: & - Tsf , & ! surface temperature of ice or ocean - potT , & ! air potential temperature (K) - uatm , & ! x-direction wind speed (m/s) - vatm , & ! y-direction wind speed (m/s) - wind , & ! wind speed (m/s) - zlvl , & ! atm level height (m) - Qa , & ! specific humidity (kg/kg) - rhoa ! air density (kg/m^3) - - real (kind=dbl_kind), intent(inout) :: & - Cdn_atm , & ! neutral drag coefficient - Cdn_atm_ratio_n ! ratio drag coeff / neutral drag coeff - - real (kind=dbl_kind), & - intent(inout) :: & - strx , & ! x surface stress (N) - stry ! y surface stress (N) - - real (kind=dbl_kind), intent(inout) :: & - Tref , & ! reference height temperature (K) - Qref , & ! reference height specific humidity (kg/kg) - delt , & ! potential T difference (K) - delq , & ! humidity difference (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - real (kind=dbl_kind), optional, intent(in) :: & - uvel , & ! x-direction ice speed (m/s) - vvel ! y-direction ice speed (m/s) - - real (kind=dbl_kind), optional, intent(out) :: & - Uref ! reference height wind speed (m/s) - - real (kind=dbl_kind) :: & - worku, workv, workr - - worku = c0 - workv = c0 - workr = c0 - if (present(uvel)) then - worku = uvel - endif - - if (present(vvel)) then - workv = vvel - endif - - ! NJ keeps icepack/colpkg BFB when atmbndy = 'constant' - Cdn_atm_ratio_n = c1 - - if (trim(atmbndy) == 'constant') then - call atmo_boundary_const (sfctype, calc_strair, & - uatm, vatm, & - wind, rhoa, & - strx, stry, & - Tsf, potT, & - Qa, & - delt, delq, & - lhcoef, shcoef, & - Cdn_atm) - else ! default - call atmo_boundary_layer (sfctype, & - calc_strair, formdrag, & - highfreq, natmiter, & - Tsf, potT, & - uatm, vatm, & - wind, zlvl, & - Qa, rhoa, & - strx, stry, & - Tref, Qref, & - delt, delq, & - lhcoef, shcoef, & - Cdn_atm, & - Cdn_atm_ratio_n, & - worku, workv, & - workr) - endif ! atmbndy - - if (present(Uref)) then - Uref = workr - endif - - end subroutine colpkg_atm_boundary - -!======================================================================= -! Compute the mixed layer heat balance and update the SST. -! Compute the energy available to freeze or melt ice. -! NOTE: SST changes due to fluxes through the ice are computed in -! ice_therm_vertical. - - subroutine colpkg_ocn_mixed_layer (alvdr_ocn, swvdr, & - alidr_ocn, swidr, & - alvdf_ocn, swvdf, & - alidf_ocn, swidf, & - sst, flwout_ocn, & - fsens_ocn, shcoef, & - flat_ocn, lhcoef, & - evap_ocn, flw, & - delt, delq, & - aice, fhocn, & - fswthru, hmix, & - Tf, qdp, & - frzmlt, dt) - - use ice_constants_colpkg, only: c0, c1, c1000, & - cp_ocn, Tffresh, stefan_boltzmann, Lvap, cprho - - real (kind=dbl_kind), intent(in) :: & - alvdr_ocn , & ! visible, direct (fraction) - alidr_ocn , & ! near-ir, direct (fraction) - alvdf_ocn , & ! visible, diffuse (fraction) - alidf_ocn , & ! near-ir, diffuse (fraction) - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf , & ! sw down, near IR, diffuse (W/m^2) - flw , & ! incoming longwave radiation (W/m^2) - Tf , & ! freezing temperature (C) - hmix , & ! mixed layer depth (m) - delt , & ! potential temperature difference (K) - delq , & ! specific humidity difference (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - fhocn , & ! net heat flux to ocean (W/m^2) - fswthru , & ! shortwave penetrating to ocean (W/m^2) - aice , & ! ice area fraction - dt ! time step (s) - - real (kind=dbl_kind), intent(inout) :: & - flwout_ocn, & ! outgoing longwave radiation (W/m^2) - fsens_ocn , & ! sensible heat flux (W/m^2) - flat_ocn , & ! latent heat flux (W/m^2) - evap_ocn , & ! evaporative water flux (kg/m^2/s) - qdp , & ! deep ocean heat flux (W/m^2), negative upward - sst , & ! sea surface temperature (C) - frzmlt ! freezing/melting potential (W/m^2) - - ! local variables - - real (kind=dbl_kind), parameter :: & - frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) - - real (kind=dbl_kind) :: & - TsfK , & ! surface temperature (K) - swabs ! surface absorbed shortwave heat flux (W/m^2) - - ! shortwave radiative flux - swabs = (c1-alvdr_ocn) * swvdr + (c1-alidr_ocn) * swidr & - + (c1-alvdf_ocn) * swvdf + (c1-alidf_ocn) * swidf - - ! ocean surface temperature in Kelvin - TsfK = sst + Tffresh - - ! longwave radiative flux - flwout_ocn = -stefan_boltzmann * TsfK**4 - - ! downward latent and sensible heat fluxes - fsens_ocn = shcoef * delt - flat_ocn = lhcoef * delq - evap_ocn = -flat_ocn / Lvap - - ! Compute sst change due to exchange with atm/ice above - sst = sst + dt * ( & - (fsens_ocn + flat_ocn + flwout_ocn + flw + swabs) * (c1-aice) & - + fhocn + fswthru) & ! these are *aice - / (cprho*hmix) - - ! adjust qdp if cooling of mixed layer would occur when sst <= Tf - if (sst <= Tf .and. qdp > c0) qdp = c0 - - ! computed T change due to exchange with deep layers: - sst = sst - qdp*dt/(cprho*hmix) - - ! compute potential to freeze or melt ice - frzmlt = (Tf-sst)*cprho*hmix/dt - frzmlt = min(max(frzmlt,-frzmlt_max),frzmlt_max) - - ! if sst is below freezing, reset sst to Tf - if (sst <= Tf) sst = Tf - - end subroutine colpkg_ocn_mixed_layer - -!======================================================================= -! -! Updates snow tracers -! -! authors: Elizabeth C. Hunke, LANL -! Nicole Jeffery, LANL - - subroutine colpkg_step_snow (dt, wind, & - nilyr, & - nslyr, ncat, & - aice, aicen, & - vicen, vsnon, & - alvl, vlvl, & - smice, smliq, & - rhos_cmpn, rhos_cmp, & - rsnw, zqin1, & - zSin1, Tsfc, & - zqsn, & - fresh, fhocn, & - fsloss, fsnow, & - rhosnew, rhosmax, & - windmin, drhosdwind, & - snwlvlfac, snowage_tau, & - snowage_kappa, & - snowage_drdt0, & - idx_T_max, & - idx_Tgrd_max, & - idx_rhos_max, & - l_stop, & - stop_label) - - use ice_colpkg_tracers, only: tr_snow, tr_rsnw - use ice_constants_colpkg, only: c0, puny, rhos - use ice_snow, only: snow_effective_density, update_snow_radius, & - snow_redist - - integer (kind=int_kind), intent(in) :: & - nslyr, & ! number of snow layers - nilyr, & ! number of ice layers - ncat, & ! number of thickness categories - idx_T_max, & ! dimensions of snow parameter matrix - idx_Tgrd_max, & - idx_rhos_max - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - wind , & ! wind speed (m/s) - fsnow , & ! snowfall rate (kg m-2 s-1) - aice , & ! ice area fraction - rhosnew, & ! new snow density (kg/m^3) - rhosmax, & ! maximum snow density (kg/m^3) - windmin, & ! minimum wind speed to compact snow (m/s) - drhosdwind, & ! wind compaction factor (kg s/m^4) - snwlvlfac ! snow loss factor for wind redistribution - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen, & ! ice area fraction - vicen, & ! ice volume (m) - Tsfc , & ! surface temperature (C) - zqin1, & ! ice upper layer enthalpy - zSin1, & ! ice upper layer salinity - alvl, & ! level ice area tracer - vlvl ! level ice volume tracer - - real (kind=dbl_kind), intent(inout) :: & - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fsloss ! snow loss to leads (kg/m^2/s) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - vsnon ! snow volume (m) - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - zqsn , & ! snow enthalpy (J/m^3) - smice , & ! mass of ice in snow (kg/m^3) - smliq , & ! mass of liquid in snow (kg/m^3) - rsnw , & ! snow grain radius (10^-6 m) - rhos_cmpn ! effective snow density: compaction (kg/m^3) - - real (kind=dbl_kind), intent(inout) :: & - rhos_cmp ! mean effective snow density: compaction (kg/m^3) - - ! dry snow aging parameters - real (kind=dbl_kind), dimension(idx_rhos_max,idx_Tgrd_max,idx_T_max), intent(in) :: & - snowage_tau, & ! (10^-6 m) - snowage_kappa, & ! - snowage_drdt0 ! (10^-6 m/hr) - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local temporary variables - - integer (kind=int_kind) :: n - - real (kind=dbl_kind), dimension(ncat) :: & - zTin, & ! ice upper layer temperature (oC) - hsn , & ! snow thickness (m) - hin ! ice thickness - - real (kind=dbl_kind) :: & - vsno, & ! snow volume (m) - tmp1, tmp2 - - character(len=char_len_long) :: & - warning ! warning message - - l_stop = .false. - stop_label = '' - - if (tr_snow) then - - !----------------------------------------------------------------- - ! Compute effective density of snow - !----------------------------------------------------------------- - - vsno = c0 - do n = 1, ncat - vsno = vsno + vsnon(n) - enddo - - call snow_effective_density(nslyr, ncat, & - vsnon, vsno, & - rhosnew, & - rhos_cmpn, rhos_cmp) - - !----------------------------------------------------------------- - ! Redistribute snow based on wind - !----------------------------------------------------------------- - - tmp1 = rhos*vsno + fresh*dt - - if (snwredist(1:3) == 'ITD' .and. aice > puny) then - call snow_redist(dt, & - nslyr, ncat, & - wind, aicen(:), & - vicen(:), vsnon(:), & - zqsn(:,:),snwredist, & - alvl(:), vlvl(:), & - fresh, fhocn, & - fsloss, rhos_cmpn, & - fsnow, rhosmax, & - windmin, drhosdwind, & - snwlvlfac, & - l_stop, stop_label) - endif - - vsno = c0 - do n = 1, ncat - vsno = vsno + vsnon(n) - enddo - tmp2 = rhos*vsno + fresh*dt - if (abs(tmp1-tmp2)>puny) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*)'tmp1 ne tmp2',tmp1, tmp2 - call add_warning(warning) - stop_label ='snow redistribution error' - l_stop = .true. - endif - - endif ! tr_snow - - !----------------------------------------------------------------- - ! Adjust snow grain radius - !----------------------------------------------------------------- - - if (tr_rsnw) then - do n = 1, ncat - zTin(n)= c0 - hsn(n) = c0 - hin(n) = c0 - if (aicen(n) > puny) then - zTin(n) = colpkg_ice_temperature(zqin1(n),zSin1(n)) - hsn(n) = vsnon(n)/aicen(n) - hin(n) = vicen(n)/aicen(n) - endif - enddo - - call update_snow_radius (dt, ncat, & - nslyr, nilyr, & - rsnw, hin, & - Tsfc, zTin, & - hsn, zqsn, & - smice, smliq, & - rsnw_fall, rsnw_tmax, & - snowage_tau, & - snowage_kappa, & - snowage_drdt0, & - idx_T_max, & - idx_Tgrd_max, & - idx_rhos_max) - endif - - end subroutine colpkg_step_snow - -!======================================================================= -! subroutine to set the column package internal parameters - - subroutine colpkg_init_parameters(& - ktherm_in, & - conduct_in, & - fbot_xfer_type_in, & - calc_Tsfc_in, & - ustar_min_in, & - dragio_in, & - ksno_in, & - a_rapid_mode_in, & - Rac_rapid_mode_in, & - aspect_rapid_mode_in, & - dSdt_slow_mode_in, & - phi_c_slow_mode_in, & - phi_i_mushy_in, & - shortwave_in, & - use_snicar_in, & - albedo_type_in, & - albicev_in, & - albicei_in, & - albsnowv_in, & - albsnowi_in, & - ahmax_in, & - R_ice_in, & - R_pnd_in, & - R_snw_in, & - dT_mlt_in, & - rsnw_mlt_in, & - kalg_in, & - kstrength_in, & - krdg_partic_in, & - krdg_redist_in, & - mu_rdg_in, & - Cf_in, & - atmbndy_in, & - calc_strair_in, & - formdrag_in, & - highfreq_in, & - natmiter_in, & - oceanmixed_ice_in, & - tfrz_option_in, & - kitd_in, & - kcatbound_in, & - hs0_in, & - frzpnd_in, & - dpscale_in, & - rfracmin_in, & - rfracmax_in, & - pndaspect_in, & - hs1_in, & - hp1_in, & - ! bgc_data_dir_in, & - ! sil_data_type_in, & - ! nit_data_type_in, & - ! fe_data_type_in, & - bgc_flux_type_in, & - z_tracers_in, & - scale_bgc_in, & - solve_zbgc_in, & - dEdd_algae_in, & - modal_aero_in, & - skl_bgc_in, & - solve_zsal_in, & - grid_o_in, & - l_sk_in, & - grid_o_t_in, & - initbio_frac_in, & - frazil_scav_in, & - grid_oS_in, & - l_skS_in, & - phi_snow_in, & - ratio_Si2N_diatoms_in, & - ratio_Si2N_sp_in, & - ratio_Si2N_phaeo_in, & - ratio_S2N_diatoms_in, & - ratio_S2N_sp_in, & - ratio_S2N_phaeo_in, & - ratio_Fe2C_diatoms_in, & - ratio_Fe2C_sp_in, & - ratio_Fe2C_phaeo_in, & - ratio_Fe2N_diatoms_in, & - ratio_Fe2N_sp_in, & - ratio_Fe2N_phaeo_in, & - ratio_Fe2DON_in, & - ratio_Fe2DOC_s_in, & - ratio_Fe2DOC_l_in, & - fr_resp_in, & - tau_min_in, & - tau_max_in, & - algal_vel_in, & - R_dFe2dust_in, & - dustFe_sol_in, & - chlabs_diatoms_in, & - chlabs_sp_in, & - chlabs_phaeo_in, & - alpha2max_low_diatoms_in, & - alpha2max_low_sp_in, & - alpha2max_low_phaeo_in, & - beta2max_diatoms_in, & - beta2max_sp_in, & - beta2max_phaeo_in, & - mu_max_diatoms_in, & - mu_max_sp_in, & - mu_max_phaeo_in, & - grow_Tdep_diatoms_in, & - grow_Tdep_sp_in, & - grow_Tdep_phaeo_in, & - fr_graze_diatoms_in, & - fr_graze_sp_in, & - fr_graze_phaeo_in, & - mort_pre_diatoms_in, & - mort_pre_sp_in, & - mort_pre_phaeo_in, & - mort_Tdep_diatoms_in, & - mort_Tdep_sp_in, & - mort_Tdep_phaeo_in, & - k_exude_diatoms_in, & - k_exude_sp_in, & - k_exude_phaeo_in, & - K_Nit_diatoms_in, & - K_Nit_sp_in, & - K_Nit_phaeo_in, & - K_Am_diatoms_in, & - K_Am_sp_in, & - K_Am_phaeo_in, & - K_Sil_diatoms_in, & - K_Sil_sp_in, & - K_Sil_phaeo_in, & - K_Fe_diatoms_in, & - K_Fe_sp_in, & - K_Fe_phaeo_in, & - f_don_protein_in, & - kn_bac_protein_in, & - f_don_Am_protein_in, & - f_doc_s_in, & - f_doc_l_in, & - f_exude_s_in, & - f_exude_l_in, & - k_bac_s_in, & - k_bac_l_in, & - T_max_in, & - fsal_in, & - op_dep_min_in, & - fr_graze_s_in, & - fr_graze_e_in, & - fr_mort2min_in, & - fr_dFe_in, & - k_nitrif_in, & - t_iron_conv_in, & - max_loss_in, & - max_dfe_doc1_in, & - fr_resp_s_in, & - y_sk_DMS_in, & - t_sk_conv_in, & - t_sk_ox_in, & - algaltype_diatoms_in, & - algaltype_sp_in, & - algaltype_phaeo_in, & - nitratetype_in, & - ammoniumtype_in, & - silicatetype_in, & - dmspptype_in, & - dmspdtype_in, & - humtype_in, & - doctype_s_in, & - doctype_l_in, & - dictype_1_in, & - dontype_protein_in, & - fedtype_1_in, & - feptype_1_in, & - zaerotype_bc1_in, & - zaerotype_bc2_in, & - zaerotype_dust1_in, & - zaerotype_dust2_in, & - zaerotype_dust3_in, & - zaerotype_dust4_in, & - ratio_C2N_diatoms_in, & - ratio_C2N_sp_in, & - ratio_C2N_phaeo_in, & - ratio_chl2N_diatoms_in, & - ratio_chl2N_sp_in, & - ratio_chl2N_phaeo_in, & - F_abs_chl_diatoms_in, & - F_abs_chl_sp_in, & - F_abs_chl_phaeo_in, & - ratio_C2N_proteins_in, & - snwredist_in, & - use_smliq_pnd_in, & - rsnw_fall_in, & - rsnw_tmax_in, & - rhosnew_in, & - rhosmax_in, & - windmin_in, & - snwlvlfac_in, & - drhosdwind_in) - !restore_bgc_in) - - use ice_colpkg_shared, only: & - ktherm, & - conduct, & - fbot_xfer_type, & - calc_Tsfc, & - ustar_min, & - dragio, & - ksno, & - a_rapid_mode, & - Rac_rapid_mode, & - aspect_rapid_mode, & - dSdt_slow_mode, & - phi_c_slow_mode, & - phi_i_mushy, & - shortwave, & - use_snicar, & - albedo_type, & - albicev, & - albicei, & - albsnowv, & - albsnowi, & - ahmax, & - R_ice, & - R_pnd, & - R_snw, & - dT_mlt, & - rsnw_mlt, & - kalg, & - kstrength, & - krdg_partic, & - krdg_redist, & - mu_rdg, & - Cf, & - atmbndy, & - calc_strair, & - formdrag, & - highfreq, & - natmiter, & - oceanmixed_ice, & - tfrz_option, & - kitd, & - kcatbound, & - hs0, & - frzpnd, & - dpscale, & - rfracmin, & - rfracmax, & - pndaspect, & - hs1, & - hp1, & - ! bgc_data_dir, & - ! sil_data_type, & - ! nit_data_type, & - ! fe_data_type, & - bgc_flux_type, & - z_tracers, & - scale_bgc, & - solve_zbgc, & - dEdd_algae, & - modal_aero, & - skl_bgc, & - solve_zsal, & - grid_o, & - l_sk, & - grid_o_t, & - initbio_frac, & - frazil_scav, & - grid_oS, & - l_skS, & - phi_snow, & - ratio_Si2N_diatoms, & - ratio_Si2N_sp , & - ratio_Si2N_phaeo , & - ratio_S2N_diatoms , & - ratio_S2N_sp , & - ratio_S2N_phaeo , & - ratio_Fe2C_diatoms, & - ratio_Fe2C_sp , & - ratio_Fe2C_phaeo , & - ratio_Fe2N_diatoms, & - ratio_Fe2N_sp , & - ratio_Fe2N_phaeo , & - ratio_Fe2DON , & - ratio_Fe2DOC_s , & - ratio_Fe2DOC_l , & - fr_resp , & - tau_min , & - tau_max , & - algal_vel , & - R_dFe2dust , & - dustFe_sol , & - chlabs_diatoms , & - chlabs_sp , & - chlabs_phaeo , & - alpha2max_low_diatoms , & - alpha2max_low_sp , & - alpha2max_low_phaeo , & - beta2max_diatoms , & - beta2max_sp , & - beta2max_phaeo , & - mu_max_diatoms , & - mu_max_sp , & - mu_max_phaeo , & - grow_Tdep_diatoms, & - grow_Tdep_sp , & - grow_Tdep_phaeo , & - fr_graze_diatoms , & - fr_graze_sp , & - fr_graze_phaeo , & - mort_pre_diatoms , & - mort_pre_sp , & - mort_pre_phaeo , & - mort_Tdep_diatoms, & - mort_Tdep_sp , & - mort_Tdep_phaeo , & - k_exude_diatoms , & - k_exude_sp , & - k_exude_phaeo , & - K_Nit_diatoms , & - K_Nit_sp , & - K_Nit_phaeo , & - K_Am_diatoms , & - K_Am_sp , & - K_Am_phaeo , & - K_Sil_diatoms , & - K_Sil_sp , & - K_Sil_phaeo , & - K_Fe_diatoms , & - K_Fe_sp , & - K_Fe_phaeo , & - f_don_protein , & - kn_bac_protein , & - f_don_Am_protein , & - f_doc_s , & - f_doc_l , & - f_exude_s , & - f_exude_l , & - k_bac_s , & - k_bac_l , & - T_max , & - fsal , & - op_dep_min , & - fr_graze_s , & - fr_graze_e , & - fr_mort2min , & - fr_dFe , & - k_nitrif , & - t_iron_conv , & - max_loss , & - max_dfe_doc1 , & - fr_resp_s , & - y_sk_DMS , & - t_sk_conv , & - t_sk_ox , & - algaltype_diatoms , & - algaltype_sp , & - algaltype_phaeo , & - nitratetype , & - ammoniumtype , & - silicatetype , & - dmspptype , & - dmspdtype , & - humtype , & - doctype_s , & - doctype_l , & - dictype_1 , & - dontype_protein , & - fedtype_1 , & - feptype_1 , & - zaerotype_bc1 , & - zaerotype_bc2 , & - zaerotype_dust1 , & - zaerotype_dust2 , & - zaerotype_dust3 , & - zaerotype_dust4 , & - ratio_C2N_diatoms , & - ratio_C2N_sp , & - ratio_C2N_phaeo , & - ratio_chl2N_diatoms, & - ratio_chl2N_sp , & - ratio_chl2N_phaeo , & - F_abs_chl_diatoms , & - F_abs_chl_sp , & - F_abs_chl_phaeo , & - ratio_C2N_proteins , & - snwredist, & - use_smliq_pnd, & - rsnw_fall, & - rsnw_tmax, & - rhosnew, & - rhosmax, & - windmin, & - snwlvlfac, & - drhosdwind - !restore_bgc - -!----------------------------------------------------------------------- -! Parameters for thermodynamics -!----------------------------------------------------------------------- - - integer (kind=int_kind), intent(in) :: & - ktherm_in ! type of thermodynamics - ! 0 = 0-layer approximation - ! 1 = Bitz and Lipscomb 1999 - ! 2 = mushy layer theory - - character (char_len), intent(in) :: & - conduct_in, & ! 'MU71' or 'bubbly' - fbot_xfer_type_in ! transfer coefficient type for ice-ocean heat flux - - logical (kind=log_kind), intent(in) :: & - calc_Tsfc_in ! if true, calculate surface temperature - ! if false, Tsfc is computed elsewhere and - ! atmos-ice fluxes are provided to CICE - - real (kind=dbl_kind), intent(in) :: & - ustar_min_in ! minimum friction velocity for ice-ocean heat flux - - ! mushy thermo - real(kind=dbl_kind), intent(in) :: & - a_rapid_mode_in , & ! channel radius for rapid drainage mode (m) - Rac_rapid_mode_in , & ! critical Rayleigh number for rapid drainage mode - aspect_rapid_mode_in , & ! aspect ratio for rapid drainage mode (larger=wider) - dSdt_slow_mode_in , & ! slow mode drainage strength (m s-1 K-1) - phi_c_slow_mode_in , & ! liquid fraction porosity cutoff for slow mode - phi_i_mushy_in ! liquid fraction of congelation ice - -!----------------------------------------------------------------------- -! Parameters for radiation -!----------------------------------------------------------------------- - - character (len=char_len), intent(in) :: & - shortwave_in, & ! shortwave method, 'default' ('ccsm3') or 'dEdd' - albedo_type_in ! albedo parameterization, 'default' ('ccsm3') or 'constant' - ! shortwave='dEdd' overrides this parameter - - ! baseline albedos for ccsm3 shortwave, set in namelist - real (kind=dbl_kind), intent(in) :: & - albicev_in , & ! visible ice albedo for h > ahmax - albicei_in , & ! near-ir ice albedo for h > ahmax - albsnowv_in , & ! cold snow albedo, visible - albsnowi_in , & ! cold snow albedo, near IR - ahmax_in ! thickness above which ice albedo is constant (m) - - ! dEdd tuning parameters, set in namelist - real (kind=dbl_kind), intent(in) :: & - R_ice_in , & ! sea ice tuning parameter; +1 > 1sig increase in albedo - R_pnd_in , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo - R_snw_in , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt_in , & ! change in temp for non-melt to melt snow grain - ! radius change (C) - rsnw_mlt_in , & ! maximum melting snow grain radius (10^-6 m) - kalg_in ! algae absorption coefficient for 0.5 m thick layer - - ! snicar 5 band system, set in namelist - logical (kind=log_kind), intent(in) :: & - use_snicar_in ! if true, use 5-band snicar IOPs for - ! shortwave radiative calculation of - ! snow-coverd sea ice - -!----------------------------------------------------------------------- -! Parameters for ridging and strength -!----------------------------------------------------------------------- - - integer (kind=int_kind), intent(in) :: & ! defined in namelist - kstrength_in , & ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - krdg_partic_in, & ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - krdg_redist_in ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - - real (kind=dbl_kind), intent(in) :: & - mu_rdg_in, & ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) - Cf_in ! ratio of ridging work to PE change in ridging (kstrength = 1) - -!----------------------------------------------------------------------- -! Parameters for atmosphere -!----------------------------------------------------------------------- - - character (len=char_len), intent(in) :: & - atmbndy_in ! atmo boundary method, 'default' ('ccsm3') or 'constant' - - logical (kind=log_kind), intent(in) :: & - calc_strair_in, & ! if true, calculate wind stress components - formdrag_in, & ! if true, calculate form drag - highfreq_in ! if true, use high frequency coupling - - integer (kind=int_kind), intent(in) :: & - natmiter_in ! number of iterations for boundary layer calculations - -!----------------------------------------------------------------------- -! Parameters for ocean -!----------------------------------------------------------------------- - - real (kind=dbl_kind), intent(in) :: & - dragio_in ! ice-ocean drago coefficient - - logical (kind=log_kind), intent(in) :: & - oceanmixed_ice_in ! if true, use ocean mixed layer - - character(len=char_len), intent(in) :: & - tfrz_option_in ! form of ocean freezing temperature - ! 'minus1p8' = -1.8 C - ! 'linear_salt' = -depressT * sss - ! 'mushy' conforms with ktherm=2 - -!----------------------------------------------------------------------- -! Parameters for the ice thickness distribution -!----------------------------------------------------------------------- - - integer (kind=int_kind), intent(in) :: & - kitd_in , & ! type of itd conversions - ! 0 = delta function - ! 1 = linear remap - kcatbound_in ! 0 = old category boundary formula - ! 1 = new formula giving round numbers - ! 2 = WMO standard - ! 3 = asymptotic formula - -!----------------------------------------------------------------------- -! Parameters for biogeochemistry -!----------------------------------------------------------------------- - - ! character(char_len_long), intent(in) :: & - ! bgc_data_dir_in ! directory for biogeochemistry data - - character(char_len), intent(in) :: & - bgc_flux_type_in ! type of ocean-ice piston velocity - ! 'constant', 'Jin2006' - ! sil_data_type_in , & ! 'default', 'clim' - ! nit_data_type_in , & ! 'default', 'clim' - ! fe_data_type_in , & ! 'default', 'clim' - - logical (kind=log_kind), intent(in) :: & - z_tracers_in, & ! if .true., bgc or aerosol tracers are vertically resolved - scale_bgc_in, & ! if .true., initialize bgc tracers proportionally with salinity - solve_zbgc_in, & ! if .true., solve vertical biochemistry portion of code - dEdd_algae_in, & ! if .true., algal absorptionof Shortwave is computed in the - modal_aero_in ! if .true., use modal aerosol formulation in shortwave - - logical (kind=log_kind), intent(in) :: & - skl_bgc_in, & ! if true, solve skeletal biochemistry - solve_zsal_in ! if true, update salinity profile from solve_S_dt - - real (kind=dbl_kind), intent(in) :: & - grid_o_in , & ! for bottom flux - l_sk_in , & ! characteristic diffusive scale (zsalinity) (m) - grid_o_t_in , & ! top grid point length scale - initbio_frac_in, & ! fraction of ocean tracer concentration used to initialize tracer - frazil_scav_in , & ! multiple of ocean tracer concentration due to frazil scavenging - phi_snow_in ! snow porosity at the ice/snow interface - - real (kind=dbl_kind), intent(in) :: & - grid_oS_in , & ! for bottom flux (zsalinity) - l_skS_in ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) - - real (kind=dbl_kind), intent(in) :: & - ratio_Si2N_diatoms_in, & ! algal Si to N (mol/mol) - ratio_Si2N_sp_in , & - ratio_Si2N_phaeo_in , & - ratio_S2N_diatoms_in , & ! algal S to N (mol/mol) - ratio_S2N_sp_in , & - ratio_S2N_phaeo_in , & - ratio_Fe2C_diatoms_in, & ! algal Fe to C (umol/mol) - ratio_Fe2C_sp_in , & - ratio_Fe2C_phaeo_in , & - ratio_Fe2N_diatoms_in, & ! algal Fe to N (umol/mol) - ratio_Fe2N_sp_in , & - ratio_Fe2N_phaeo_in , & - ratio_Fe2DON_in , & ! Fe to N of DON (nmol/umol) - ratio_Fe2DOC_s_in , & ! Fe to C of DOC (nmol/umol) saccharids - ratio_Fe2DOC_l_in , & ! Fe to C of DOC (nmol/umol) lipids - fr_resp_in , & ! fraction of algal growth lost due to respiration - tau_min_in , & ! rapid mobile to stationary exchanges (s) = 1.5 hours - tau_max_in , & ! long time mobile to stationary exchanges (s) = 2 days - algal_vel_in , & ! 0.5 cm/d(m/s) Lavoie 2005 1.5 cm/day - R_dFe2dust_in , & ! g/g (3.5% content) Tagliabue 2009 - dustFe_sol_in , & ! solubility fraction - chlabs_diatoms_in , & ! chl absorption (1/m/(mg/m^3)) - chlabs_sp_in , & ! - chlabs_phaeo_in , & ! - alpha2max_low_diatoms_in , & ! light limitation (1/(W/m^2)) - alpha2max_low_sp_in , & - alpha2max_low_phaeo_in , & - beta2max_diatoms_in , & ! light inhibition (1/(W/m^2)) - beta2max_sp_in , & - beta2max_phaeo_in , & - mu_max_diatoms_in , & ! maximum growth rate (1/day) - mu_max_sp_in , & - mu_max_phaeo_in , & - grow_Tdep_diatoms_in, & ! Temperature dependence of growth (1/C) - grow_Tdep_sp_in , & - grow_Tdep_phaeo_in , & - fr_graze_diatoms_in , & ! Fraction grazed - fr_graze_sp_in , & - fr_graze_phaeo_in , & - mort_pre_diatoms_in , & ! Mortality (1/day) - mort_pre_sp_in , & - mort_pre_phaeo_in , & - mort_Tdep_diatoms_in, & ! T dependence of mortality (1/C) - mort_Tdep_sp_in , & - mort_Tdep_phaeo_in , & - k_exude_diatoms_in , & ! algal exudation (1/d) - k_exude_sp_in , & - k_exude_phaeo_in , & - K_Nit_diatoms_in , & ! nitrate half saturation (mmol/m^3) - K_Nit_sp_in , & - K_Nit_phaeo_in , & - K_Am_diatoms_in , & ! ammonium half saturation (mmol/m^3) - K_Am_sp_in , & - K_Am_phaeo_in , & - K_Sil_diatoms_in , & ! silicate half saturation (mmol/m^3) - K_Sil_sp_in , & - K_Sil_phaeo_in , & - K_Fe_diatoms_in , & ! iron half saturation (nM) - K_Fe_sp_in , & - K_Fe_phaeo_in , & - f_don_protein_in , & ! fraction of spilled grazing to proteins - kn_bac_protein_in , & ! Bacterial degredation of DON (1/d) - f_don_Am_protein_in , & ! fraction of remineralized DON to ammonium - f_doc_s_in , & ! fraction of mortality to DOC - f_doc_l_in , & - f_exude_s_in , & ! fraction of exudation to DOC - f_exude_l_in , & - k_bac_s_in , & ! Bacterial degredation of DOC (1/d) - k_bac_l_in , & - T_max_in , & ! maximum temperature (C) - fsal_in , & ! Salinity limitation (ppt) - op_dep_min_in , & ! Light attenuates for optical depths exceeding min - fr_graze_s_in , & ! fraction of grazing spilled or slopped - fr_graze_e_in , & ! fraction of assimilation excreted - fr_mort2min_in , & ! fractionation of mortality to Am - fr_dFe_in , & ! fraction of remineralized nitrogen - ! (in units of algal iron) - k_nitrif_in , & ! nitrification rate (1/day) - t_iron_conv_in , & ! desorption loss pFe to dFe (day) - max_loss_in , & ! restrict uptake to % of remaining value - max_dfe_doc1_in , & ! max ratio of dFe to saccharides in the ice - ! (nM Fe/muM C) - fr_resp_s_in , & ! DMSPd fraction of respiration loss as DMSPd - y_sk_DMS_in , & ! fraction conversion given high yield - t_sk_conv_in , & ! Stefels conversion time (d) - t_sk_ox_in , & ! DMS oxidation time (d) - algaltype_diatoms_in , & ! mobility type - algaltype_sp_in , & ! - algaltype_phaeo_in , & ! - nitratetype_in , & ! - ammoniumtype_in , & ! - silicatetype_in , & ! - dmspptype_in , & ! - dmspdtype_in , & ! - humtype_in , & ! - doctype_s_in , & ! - doctype_l_in , & ! - dictype_1_in , & ! - dontype_protein_in , & ! - fedtype_1_in , & ! - feptype_1_in , & ! - zaerotype_bc1_in , & ! - zaerotype_bc2_in , & ! - zaerotype_dust1_in , & ! - zaerotype_dust2_in , & ! - zaerotype_dust3_in , & ! - zaerotype_dust4_in , & ! - ratio_C2N_diatoms_in , & ! algal C to N ratio (mol/mol) - ratio_C2N_sp_in , & ! - ratio_C2N_phaeo_in , & ! - ratio_chl2N_diatoms_in, & ! algal chlorophyll to N ratio (mg/mmol) - ratio_chl2N_sp_in , & ! - ratio_chl2N_phaeo_in , & ! - F_abs_chl_diatoms_in , & ! scales absorbed radiation for dEdd - F_abs_chl_sp_in , & ! - F_abs_chl_phaeo_in , & ! - ratio_C2N_proteins_in ! ratio of C to N in proteins (mol/mol) - - !logical (kind=log_kind), intent(in) :: & - ! restore_bgc_in ! if true, restore nitrate - -!----------------------------------------------------------------------- -! Parameters for melt ponds -!----------------------------------------------------------------------- - - real (kind=dbl_kind), intent(in) :: & - hs0_in ! snow depth for transition to bare sea ice (m) - - ! level-ice ponds - character (len=char_len), intent(in) :: & - frzpnd_in ! pond refreezing parameterization - - real (kind=dbl_kind), intent(in) :: & - dpscale_in, & ! alter e-folding time scale for flushing - rfracmin_in, & ! minimum retained fraction of meltwater - rfracmax_in, & ! maximum retained fraction of meltwater - pndaspect_in, & ! ratio of pond depth to pond fraction - hs1_in ! tapering parameter for snow on pond ice - - ! topo ponds - real (kind=dbl_kind), intent(in) :: & - hp1_in ! critical parameter for pond ice thickness - -!----------------------------------------------------------------------- -! Parameters for snow -!----------------------------------------------------------------------- - - ! snow metamorphism parameters, set in namelist - real (kind=dbl_kind), intent(in) :: & - rsnw_fall_in , & ! fallen snow grain radius (10^-6 m)) 54.5 um CLM ** - ! 30 um is minimum for defined mie properties - rsnw_tmax_in , & ! maximum dry metamorphism snow grain radius (10^-6 m) - ! 1500 um is maximum for defined mie properties - rhosnew_in , & ! new snow density (kg/m^3) - rhosmax_in , & ! maximum snow density (kg/m^3) - windmin_in , & ! minimum wind speed to compact snow (m/s) - snwlvlfac_in , & ! snow loss factor for wind redistribution - drhosdwind_in, & ! wind compaction factor (kg s/m^4) - ksno_in ! snow thermal conductivity (W/m/deg) - - character(len=char_len), intent(in) :: & - snwredist_in ! type of snow redistribution - ! '30percent' = 30% rule, precip only - ! '30percentsw' = 30% rule with shortwave - ! 'ITDsd' = Lecomte PhD, 2014 - ! 'ITDrdg' = like ITDsd but use level/ridged ice - ! 'default' or 'none' = none - - logical (kind=log_kind), intent(in) :: & - use_smliq_pnd_in ! if true, use snow liquid tracer for ponds - - ktherm = ktherm_in - conduct = conduct_in - fbot_xfer_type = fbot_xfer_type_in - calc_Tsfc = calc_Tsfc_in - ustar_min = ustar_min_in - dragio = dragio_in - ksno = ksno_in - a_rapid_mode = a_rapid_mode_in - Rac_rapid_mode = Rac_rapid_mode_in - aspect_rapid_mode = aspect_rapid_mode_in - dSdt_slow_mode = dSdt_slow_mode_in - phi_c_slow_mode = phi_c_slow_mode_in - phi_i_mushy = phi_i_mushy_in - shortwave = shortwave_in - use_snicar = use_snicar_in - albedo_type = albedo_type_in - albicev = albicev_in - albicei = albicei_in - albsnowv = albsnowv_in - albsnowi = albsnowi_in - ahmax = ahmax_in - R_ice = R_ice_in - R_pnd = R_pnd_in - R_snw = R_snw_in - dT_mlt = dT_mlt_in - rsnw_mlt = rsnw_mlt_in - kalg = kalg_in - kstrength = kstrength_in - krdg_partic = krdg_partic_in - krdg_redist = krdg_redist_in - mu_rdg = mu_rdg_in - Cf = Cf_in - atmbndy = atmbndy_in - calc_strair = calc_strair_in - formdrag = formdrag_in - highfreq = highfreq_in - natmiter = natmiter_in - oceanmixed_ice = oceanmixed_ice_in - tfrz_option = tfrz_option_in - kitd = kitd_in - kcatbound = kcatbound_in - hs0 = hs0_in - frzpnd = frzpnd_in - dpscale = dpscale_in - rfracmin = rfracmin_in - rfracmax = rfracmax_in - pndaspect = pndaspect_in - hs1 = hs1_in - hp1 = hp1_in - ! bgc_data_dir = bgc_data_dir_in - ! sil_data_type= sil_data_type_in - ! nit_data_type = nit_data_type_in - ! fe_data_type = fe_data_type_in - bgc_flux_type = bgc_flux_type_in - z_tracers = z_tracers_in - scale_bgc = scale_bgc_in - solve_zbgc = solve_zbgc_in - dEdd_algae = dEdd_algae_in - skl_bgc = skl_bgc_in - grid_o = grid_o_in - l_sk = l_sk_in - grid_o_t = grid_o_t_in - initbio_frac = initbio_frac_in - frazil_scav = frazil_scav_in - grid_oS = grid_oS_in - l_skS = l_skS_in - phi_snow = phi_snow_in - ! restore_bgc = restore_bgc_in - ratio_Si2N_diatoms= ratio_Si2N_diatoms_in - ratio_Si2N_sp = ratio_Si2N_sp_in - ratio_Si2N_phaeo = ratio_Si2N_phaeo_in - ratio_S2N_diatoms = ratio_S2N_diatoms_in - ratio_S2N_sp = ratio_S2N_sp_in - ratio_S2N_phaeo = ratio_S2N_phaeo_in - ratio_Fe2C_diatoms= ratio_Fe2C_diatoms_in - ratio_Fe2C_sp = ratio_Fe2C_sp_in - ratio_Fe2C_phaeo = ratio_Fe2C_phaeo_in - ratio_Fe2N_diatoms= ratio_Fe2N_diatoms_in - ratio_Fe2N_sp = ratio_Fe2N_sp_in - ratio_Fe2N_phaeo = ratio_Fe2N_phaeo_in - ratio_Fe2DON = ratio_Fe2DON_in - ratio_Fe2DOC_s = ratio_Fe2DOC_s_in - ratio_Fe2DOC_l = ratio_Fe2DOC_l_in - fr_resp = fr_resp_in - tau_min = tau_min_in - tau_max = tau_max_in - algal_vel = algal_vel_in - R_dFe2dust = R_dFe2dust_in - dustFe_sol = dustFe_sol_in - chlabs_diatoms = chlabs_diatoms_in - chlabs_sp = chlabs_sp_in - chlabs_phaeo = chlabs_phaeo_in - alpha2max_low_diatoms = alpha2max_low_diatoms_in - alpha2max_low_sp = alpha2max_low_sp_in - alpha2max_low_phaeo = alpha2max_low_phaeo_in - beta2max_diatoms = beta2max_diatoms_in - beta2max_sp = beta2max_sp_in - beta2max_phaeo = beta2max_phaeo_in - mu_max_diatoms = mu_max_diatoms_in - mu_max_sp = mu_max_sp_in - mu_max_phaeo = mu_max_phaeo_in - grow_Tdep_diatoms= grow_Tdep_diatoms_in - grow_Tdep_sp = grow_Tdep_sp_in - grow_Tdep_phaeo = grow_Tdep_phaeo_in - fr_graze_diatoms = fr_graze_diatoms_in - fr_graze_sp = fr_graze_sp_in - fr_graze_phaeo = fr_graze_phaeo_in - mort_pre_diatoms = mort_pre_diatoms_in - mort_pre_sp = mort_pre_sp_in - mort_pre_phaeo = mort_pre_phaeo_in - mort_Tdep_diatoms= mort_Tdep_diatoms_in - mort_Tdep_sp = mort_Tdep_sp_in - mort_Tdep_phaeo = mort_Tdep_phaeo_in - k_exude_diatoms = k_exude_diatoms_in - k_exude_sp = k_exude_sp_in - k_exude_phaeo = k_exude_phaeo_in - K_Nit_diatoms = K_Nit_diatoms_in - K_Nit_sp = K_Nit_sp_in - K_Nit_phaeo = K_Nit_phaeo_in - K_Am_diatoms = K_Am_diatoms_in - K_Am_sp = K_Am_sp_in - K_Am_phaeo = K_Am_phaeo_in - K_Sil_diatoms = K_Sil_diatoms_in - K_Sil_sp = K_Sil_sp_in - K_Sil_phaeo = K_Sil_phaeo_in - K_Fe_diatoms = K_Fe_diatoms_in - K_Fe_sp = K_Fe_sp_in - K_Fe_phaeo = K_Fe_phaeo_in - f_don_protein = f_don_protein_in - kn_bac_protein = kn_bac_protein_in - f_don_Am_protein = f_don_Am_protein_in - f_doc_s = f_doc_s_in - f_doc_l = f_doc_l_in - f_exude_s = f_exude_s_in - f_exude_l = f_exude_l_in - k_bac_s = k_bac_s_in - k_bac_l = k_bac_l_in - T_max = T_max_in - fsal = fsal_in - op_dep_min = op_dep_min_in - fr_graze_s = fr_graze_s_in - fr_graze_e = fr_graze_e_in - fr_mort2min = fr_mort2min_in - fr_dFe = fr_dFe_in - k_nitrif = k_nitrif_in - t_iron_conv = t_iron_conv_in - max_loss = max_loss_in - max_dfe_doc1 = max_dfe_doc1_in - fr_resp_s = fr_resp_s_in - y_sk_DMS = y_sk_DMS_in - t_sk_conv = t_sk_conv_in - t_sk_ox = t_sk_ox_in - algaltype_diatoms = algaltype_diatoms_in - algaltype_sp = algaltype_sp_in - algaltype_phaeo = algaltype_phaeo_in - nitratetype = nitratetype_in - ammoniumtype = ammoniumtype_in - silicatetype = silicatetype_in - dmspptype = dmspptype_in - dmspdtype = dmspdtype_in - humtype = humtype_in - doctype_s = doctype_s_in - doctype_l = doctype_l_in - dictype_1 = dictype_1_in - dontype_protein = dontype_protein_in - fedtype_1 = fedtype_1_in - feptype_1 = feptype_1_in - zaerotype_bc1 = zaerotype_bc1_in - zaerotype_bc2 = zaerotype_bc2_in - zaerotype_dust1 = zaerotype_dust1_in - zaerotype_dust2 = zaerotype_dust2_in - zaerotype_dust3 = zaerotype_dust3_in - zaerotype_dust4 = zaerotype_dust4_in - ratio_C2N_diatoms = ratio_C2N_diatoms_in - ratio_C2N_sp = ratio_C2N_sp_in - ratio_C2N_phaeo = ratio_C2N_phaeo_in - ratio_chl2N_diatoms= ratio_chl2N_diatoms_in - ratio_chl2N_sp = ratio_chl2N_sp_in - ratio_chl2N_phaeo = ratio_chl2N_phaeo_in - F_abs_chl_diatoms = F_abs_chl_diatoms_in - F_abs_chl_sp = F_abs_chl_sp_in - F_abs_chl_phaeo = F_abs_chl_phaeo_in - ratio_C2N_proteins = ratio_C2N_proteins_in - snwredist = snwredist_in - use_smliq_pnd = use_smliq_pnd_in - rsnw_fall = rsnw_fall_in - rsnw_tmax = rsnw_tmax_in - rhosnew = rhosnew_in - rhosmax = rhosmax_in - windmin = windmin_in - snwlvlfac = snwlvlfac_in - drhosdwind = drhosdwind_in - - end subroutine colpkg_init_parameters - -!======================================================================= -! set tracer active flags - - subroutine colpkg_init_tracer_flags(& - tr_iage_in , & ! if .true., use age tracer - tr_FY_in , & ! if .true., use first-year area tracer - tr_lvl_in , & ! if .true., use level ice tracer - tr_pond_in , & ! if .true., use melt pond tracer - tr_pond_cesm_in , & ! if .true., use cesm pond tracer - tr_pond_lvl_in , & ! if .true., use level-ice pond tracer - tr_pond_topo_in , & ! if .true., use explicit topography-based ponds - tr_snow_in , & ! if .true., use snow density tracer (rhos_cmp) - tr_rsnw_in , & ! if .true., use snow grain radius, liquid and mass tracers (smice, smliq, rsnw) - tr_aero_in , & ! if .true., use aerosol tracers - tr_brine_in , & ! if .true., brine height differs from ice thickness - tr_bgc_S_in , & ! if .true., use zsalinity - tr_zaero_in , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit_in , & ! if .true., Nitrate tracer in ice - tr_bgc_N_in , & ! if .true., algal nitrogen tracers (n_algae) - tr_bgc_DON_in , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C_in , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl_in , & ! if .true., algal chlorophyll tracers - tr_bgc_Am_in , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil_in , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS_in , & ! if .true., DMS as product tracer - tr_bgc_Fe_in , & ! if .true., Fe as product tracer - tr_bgc_hum_in , & ! if .true., hum as tracer - tr_bgc_PON_in) ! if .true., PON as product tracer - - - use ice_colpkg_tracers, only: & - tr_iage , & ! if .true., use age tracer - tr_FY , & ! if .true., use first-year area tracer - tr_lvl , & ! if .true., use level ice tracer - tr_pond , & ! if .true., use melt pond tracer - tr_pond_cesm , & ! if .true., use cesm pond tracer - tr_pond_lvl , & ! if .true., use level-ice pond tracer - tr_pond_topo , & ! if .true., use explicit topography-based ponds - tr_snow , & ! if .true., use snow density tracer (rhos_cmp) - tr_rsnw , & ! if .true., use snow grain radius, liquid and mass tracers (smice, smliq, rsnw) - tr_aero , & ! if .true., use aerosol tracers - tr_brine , & ! if .true., brine height differs from ice thickness - tr_bgc_S , & ! if .true., use zsalinity - tr_zaero , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit , & ! if .true., Nitrate tracer in ice - tr_bgc_N , & ! if .true., algal nitrogen tracers (n_algae) - tr_bgc_DON , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl , & ! if .true., algal chlorophyll tracers - tr_bgc_Am , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS , & ! if .true., DMS as product tracer - tr_bgc_Fe , & ! if .true., Fe as product tracer - tr_bgc_hum , & ! if .true., hum as product tracer - tr_bgc_PON ! if .true., PON as product tracer - - - logical, intent(in) :: & - tr_iage_in , & ! if .true., use age tracer - tr_FY_in , & ! if .true., use first-year area tracer - tr_lvl_in , & ! if .true., use level ice tracer - tr_pond_in , & ! if .true., use melt pond tracer - tr_pond_cesm_in , & ! if .true., use cesm pond tracer - tr_pond_lvl_in , & ! if .true., use level-ice pond tracer - tr_pond_topo_in , & ! if .true., use explicit topography-based ponds - tr_snow_in , & ! if .true., use snow density tracer (rhos_cmp) - tr_rsnw_in , & ! if .true., use snow grain radius, liquid and mass tracers (smice, smliq, rsnw) - tr_aero_in , & ! if .true., use aerosol tracers - tr_brine_in , & ! if .true., brine height differs from ice thickness - tr_bgc_S_in , & ! if .true., use zsalinity - tr_zaero_in , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit_in , & ! if .true., Nitrate tracer in ice - tr_bgc_N_in , & ! if .true., algal nitrogen tracers (n_algae) - tr_bgc_DON_in , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C_in , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl_in , & ! if .true., algal chlorophyll tracers - tr_bgc_Am_in , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil_in , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS_in , & ! if .true., DMS as product tracer - tr_bgc_Fe_in , & ! if .true., Fe as product tracer - tr_bgc_hum_in , & ! if .true., hum as product tracer - tr_bgc_PON_in ! if .true., PON as product tracer - - tr_iage = tr_iage_in - tr_FY = tr_FY_in - tr_lvl = tr_lvl_in - tr_pond = tr_pond_in - tr_pond_cesm = tr_pond_cesm_in - tr_pond_lvl = tr_pond_lvl_in - tr_pond_topo = tr_pond_topo_in - tr_snow = tr_snow_in - tr_rsnw = tr_rsnw_in - tr_aero = tr_aero_in - tr_brine = tr_brine_in - tr_bgc_S = tr_bgc_S_in - tr_zaero = tr_zaero_in - tr_bgc_Nit = tr_bgc_Nit_in - tr_bgc_N = tr_bgc_N_in - tr_bgc_DON = tr_bgc_DON_in - tr_bgc_C = tr_bgc_C_in - tr_bgc_chl = tr_bgc_chl_in - tr_bgc_Am = tr_bgc_Am_in - tr_bgc_Sil = tr_bgc_Sil_in - tr_bgc_DMS = tr_bgc_DMS_in - tr_bgc_Fe = tr_bgc_Fe_in - tr_bgc_hum = tr_bgc_hum_in - tr_bgc_PON = tr_bgc_PON_in - - end subroutine colpkg_init_tracer_flags - -!======================================================================= - - subroutine colpkg_init_tracer_indices(& - nt_Tsfc_in, & ! ice/snow temperature - nt_qice_in, & ! volume-weighted ice enthalpy (in layers) - nt_qsno_in, & ! volume-weighted snow enthalpy (in layers) - nt_sice_in, & ! volume-weighted ice bulk salinity (CICE grid layers) - nt_fbri_in, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - nt_iage_in, & ! volume-weighted ice age - nt_FY_in, & ! area-weighted first-year ice area - nt_alvl_in, & ! level ice area fraction - nt_vlvl_in, & ! level ice volume fraction - nt_apnd_in, & ! melt pond area fraction - nt_hpnd_in, & ! melt pond depth - nt_ipnd_in, & ! melt pond refrozen lid thickness - nt_aero_in, & ! starting index for aerosols in ice - nt_smice_in, & ! snow ice mass - nt_smliq_in, & ! snow liquid mass - nt_rsnw_in, & ! snow grain radius - nt_rhos_in, & ! snow density - nt_zaero_in, & ! black carbon and other aerosols - nt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl_in, & ! diatoms, phaeocystis, pico/small - nt_bgc_DOC_in, & ! dissolved organic carbon - nt_bgc_DON_in, & ! dissolved organic nitrogen - nt_bgc_DIC_in, & ! dissolved inorganic carbon - nt_bgc_Fed_in, & ! dissolved iron - nt_bgc_Fep_in, & ! particulate iron - nt_bgc_Nit_in, & ! nutrients - nt_bgc_Am_in, & ! - nt_bgc_Sil_in, & ! - nt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nt_bgc_DMSPd_in,&! - nt_bgc_DMS_in, & ! - nt_bgc_hum_in, & ! - nt_bgc_PON_in, & ! zooplankton and detritus - nlt_zaero_in, & ! black carbon and other aerosols - nlt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl_in,& ! diatoms, phaeocystis, pico/small - nlt_bgc_DOC_in,& ! dissolved organic carbon - nlt_bgc_DON_in,& ! dissolved organic nitrogen - nlt_bgc_DIC_in,& ! dissolved inorganic carbon - nlt_bgc_Fed_in,& ! dissolved iron - nlt_bgc_Fep_in,& ! particulate iron - nlt_bgc_Nit_in,& ! nutrients - nlt_bgc_Am_in, & ! - nlt_bgc_Sil_in,& ! - nlt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nlt_bgc_DMSPd_in,&! - nlt_bgc_DMS_in,& ! - nlt_bgc_hum_in,& ! - nlt_bgc_PON_in,& ! zooplankton and detritus - nt_zbgc_frac_in,&! fraction of tracer in the mobile phase - nt_bgc_S_in, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) - nlt_chl_sw_in, & ! points to total chla in trcrn_sw - nlt_zaero_sw_in,&! black carbon and dust in trcrn_sw - ! Index Dimensions: - n_algae, n_algalC, & ! - n_algalchl, n_DOC, & ! - n_DON,n_DIC,n_dFe, & ! - n_pFe, n_aerosols, & ! - bio_index_o_in, & ! nlt index to fixed data array - bio_index_in, & ! nlt index to nt index - nbtrcr) - - use ice_colpkg_tracers, only: & - nt_Tsfc, & ! ice/snow temperature - nt_qice, & ! volume-weighted ice enthalpy (in layers) - nt_qsno, & ! volume-weighted snow enthalpy (in layers) - nt_sice, & ! volume-weighted ice bulk salinity (CICE grid layers) - nt_fbri, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - nt_iage, & ! volume-weighted ice age - nt_FY, & ! area-weighted first-year ice area - nt_alvl, & ! level ice area fraction - nt_vlvl, & ! level ice volume fraction - nt_apnd, & ! melt pond area fraction - nt_hpnd, & ! melt pond depth - nt_ipnd, & ! melt pond refrozen lid thickness - nt_aero, & ! starting index for aerosols in ice - nt_smice, & ! snow ice mass - nt_smliq, & ! snow liquid mass - nt_rsnw, & ! snow grain radius - nt_rhos, & ! snow density - nt_zaero, & ! black carbon and other aerosols - nt_bgc_N , & ! diatoms, phaeocystis, pico/small - nt_bgc_C , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl, & ! diatoms, phaeocystis, pico/small - nt_bgc_DOC, & ! dissolved organic carbon - nt_bgc_DON, & ! dissolved organic nitrogen - nt_bgc_DIC, & ! dissolved inorganic carbon - nt_bgc_Fed, & ! dissolved iron - nt_bgc_Fep, & ! particulate iron - nt_bgc_Nit, & ! nutrients - nt_bgc_Am, & ! - nt_bgc_Sil, & ! - nt_bgc_DMSPp,&! trace gases (skeletal layer) - nt_bgc_DMSPd,&! - nt_bgc_DMS, & ! - nt_bgc_hum, & ! - nt_bgc_PON, & ! zooplankton and detritus - nlt_zaero, & ! black carbon and other aerosols - nlt_bgc_N , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl,& ! diatoms, phaeocystis, pico/small - nlt_bgc_DOC,& ! dissolved organic carbon - nlt_bgc_DON,& ! dissolved organic nitrogen - nlt_bgc_DIC,& ! dissolved inorganic carbon - nlt_bgc_Fed,& ! dissolved iron - nlt_bgc_Fep,& ! particulate iron - nlt_bgc_Nit,& ! nutrients - nlt_bgc_Am, & ! - nlt_bgc_Sil,& ! - nlt_bgc_DMSPp,&! trace gases (skeletal layer) - nlt_bgc_DMSPd,&! - nlt_bgc_DMS,& ! - nlt_bgc_hum,& ! - nlt_bgc_PON,& ! zooplankton and detritus - nt_zbgc_frac,&! fraction of tracer in the mobile phase - nt_bgc_S, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) - nlt_chl_sw, & ! points to total chla in trcrn_sw - nlt_zaero_sw,&! black carbon and dust in trcrn_sw - bio_index_o,& ! - bio_index - - integer, intent(in) :: & - nt_Tsfc_in, & ! ice/snow temperature - nt_qice_in, & ! volume-weighted ice enthalpy (in layers) - nt_qsno_in, & ! volume-weighted snow enthalpy (in layers) - nt_sice_in, & ! volume-weighted ice bulk salinity (CICE grid layers) - nt_fbri_in, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - nt_iage_in, & ! volume-weighted ice age - nt_FY_in, & ! area-weighted first-year ice area - nt_alvl_in, & ! level ice area fraction - nt_vlvl_in, & ! level ice volume fraction - nt_apnd_in, & ! melt pond area fraction - nt_hpnd_in, & ! melt pond depth - nt_ipnd_in, & ! melt pond refrozen lid thickness - nt_aero_in, & ! starting index for aerosols in ice - nt_smice_in, & ! snow ice mass - nt_smliq_in, & ! snow liquid mass - nt_rsnw_in, & ! snow grain radius - nt_rhos_in, & ! snow density - nt_bgc_Nit_in, & ! nutrients - nt_bgc_Am_in, & ! - nt_bgc_Sil_in, & ! - nt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nt_bgc_DMSPd_in,&! - nt_bgc_DMS_in, & ! - nt_bgc_hum_in, & ! - nt_bgc_PON_in, & ! zooplankton and detritus - nlt_bgc_Nit_in,& ! nutrients - nlt_bgc_Am_in, & ! - nlt_bgc_Sil_in,& ! - nlt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nlt_bgc_DMSPd_in,&! - nlt_bgc_DMS_in,& ! - nlt_bgc_hum_in,& ! - nlt_bgc_PON_in,& ! zooplankton and detritus - nt_zbgc_frac_in,&! fraction of tracer in the mobile phase - nt_bgc_S_in, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) - nlt_chl_sw_in ! points to total chla in trcrn_sw - - integer, intent(in) :: & - n_algae, & ! Dimensions - n_algalC, & ! - n_algalchl, & ! - n_DOC, & ! - n_DON, & ! - n_DIC, & ! - n_dFe, & ! - n_pFe, & ! - n_aerosols, & ! - nbtrcr - - integer (kind=int_kind), dimension(:), intent(in) :: & - bio_index_o_in, & - bio_index_in - - integer (kind=int_kind), dimension(:), intent(in) :: & - nt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl_in, & ! diatoms, phaeocystis, pico/small - nlt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl_in ! diatoms, phaeocystis, pico/small - - integer (kind=int_kind), dimension(:), intent(in) :: & - nt_bgc_DOC_in, & ! dissolved organic carbon - nlt_bgc_DOC_in ! dissolved organic carbon - - integer (kind=int_kind), dimension(:), intent(in) :: & - nt_bgc_DON_in, & ! dissolved organic nitrogen - nlt_bgc_DON_in ! dissolved organic nitrogen - - integer (kind=int_kind), dimension(:), intent(in) :: & - nt_bgc_DIC_in, & ! dissolved inorganic carbon - nlt_bgc_DIC_in ! dissolved inorganic carbon - - integer (kind=int_kind), dimension(:), intent(in) :: & - nt_bgc_Fed_in, & ! dissolved iron - nt_bgc_Fep_in, & ! particulate iron - nlt_bgc_Fed_in,& ! dissolved iron - nlt_bgc_Fep_in ! particulate iron - - integer (kind=int_kind), dimension(:), intent(in) :: & - nt_zaero_in, & ! black carbon and other aerosols - nlt_zaero_in, & ! black carbon and other aerosols - nlt_zaero_sw_in ! black carbon and dust in trcrn_sw - - ! local - integer (kind=int_kind) :: k - - nt_Tsfc = nt_Tsfc_in - nt_qice = nt_qice_in - nt_qsno = nt_qsno_in - nt_sice = nt_sice_in - nt_fbri = nt_fbri_in - nt_iage = nt_iage_in - nt_FY = nt_FY_in - nt_alvl = nt_alvl_in - nt_vlvl = nt_vlvl_in - nt_apnd = nt_apnd_in - nt_hpnd = nt_hpnd_in - nt_ipnd = nt_ipnd_in - nt_aero = nt_aero_in - nt_smice = nt_smice_in - nt_smliq = nt_smliq_in - nt_rsnw = nt_rsnw_in - nt_rhos = nt_rhos_in - nt_bgc_Nit = nt_bgc_Nit_in - nt_bgc_Am = nt_bgc_Am_in - nt_bgc_Sil = nt_bgc_Sil_in - nt_bgc_DMSPp=nt_bgc_DMSPp_in - nt_bgc_DMSPd=nt_bgc_DMSPd_in - nt_bgc_DMS = nt_bgc_DMS_in - nt_bgc_hum = nt_bgc_hum_in - nt_bgc_PON = nt_bgc_PON_in - nlt_bgc_Nit = nlt_bgc_Nit_in - nlt_bgc_Am = nlt_bgc_Am_in - nlt_bgc_Sil = nlt_bgc_Sil_in - nlt_bgc_DMSPp=nlt_bgc_DMSPp_in - nlt_bgc_DMSPd=nlt_bgc_DMSPd_in - nlt_bgc_DMS = nlt_bgc_DMS_in - nlt_bgc_hum = nlt_bgc_hum_in - nlt_bgc_PON = nlt_bgc_PON_in - nlt_chl_sw = nlt_chl_sw_in - nt_zbgc_frac=nt_zbgc_frac_in - nt_bgc_S = nt_bgc_S_in - - nt_bgc_N(:) = 0 - nt_bgc_C(:) = 0 - nt_bgc_chl(:) = 0 - nlt_bgc_N(:) = 0 - nlt_bgc_C(:) = 0 - nlt_bgc_chl(:) = 0 - nt_bgc_DOC(:) = 0 - nlt_bgc_DOC(:) = 0 - nt_bgc_DIC(:) = 0 - nlt_bgc_DIC(:) = 0 - nt_bgc_DON(:) = 0 - nlt_bgc_DON(:) = 0 - nt_bgc_Fed(:) = 0 - nt_bgc_Fep(:) = 0 - nlt_bgc_Fed(:) = 0 - nlt_bgc_Fep(:) = 0 - nt_zaero(:) = 0 - nlt_zaero(:) = 0 - nlt_zaero_sw(:)= 0 - bio_index(:) = 0 - bio_index_o(:) = 0 - - do k = 1, nbtrcr - bio_index_o(k)= bio_index_o_in(k) - bio_index(k) = bio_index_in(k) - enddo - do k = 1, n_algae - nt_bgc_N(k) = nt_bgc_N_in(k) - nlt_bgc_N(k)= nlt_bgc_N_in(k) - enddo - do k = 1, n_algalC - nt_bgc_C(k) = nt_bgc_C_in(k) - nlt_bgc_C(k)= nlt_bgc_C_in(k) - enddo - do k = 1, n_algalchl - nt_bgc_chl(k) = nt_bgc_chl_in(k) - nlt_bgc_chl(k)= nlt_bgc_chl_in(k) - enddo - do k = 1, n_DOC - nt_bgc_DOC(k) = nt_bgc_DOC_in(k) - nlt_bgc_DOC(k)= nlt_bgc_DOC_in(k) - enddo - do k = 1, n_DON - nt_bgc_DON(k) = nt_bgc_DON_in(k) - nlt_bgc_DON(k)= nlt_bgc_DON_in(k) - enddo - do k = 1, n_DIC - nt_bgc_DIC(k) = nt_bgc_DIC_in(k) - nlt_bgc_DIC(k)= nlt_bgc_DIC_in(k) - enddo - do k = 1, n_dFe - nt_bgc_Fed(k) = nt_bgc_Fed_in(k) - nlt_bgc_Fed(k)= nlt_bgc_Fed_in(k) - enddo - do k = 1, n_pFe - nt_bgc_Fep(k) = nt_bgc_Fep_in(k) - nlt_bgc_Fep(k)= nlt_bgc_Fep_in(k) - enddo - do k = 1, n_aerosols - nt_zaero(k) = nt_zaero_in(k) - nlt_zaero(k) = nlt_zaero_in(k) - nlt_zaero_sw(k)= nlt_zaero_sw_in(k) - enddo - - end subroutine colpkg_init_tracer_indices - -!======================================================================= -! set the number of column tracers - - subroutine colpkg_init_tracer_numbers(& - ntrcr_in, nbtrcr_in, nbtrcr_sw_in) - - use ice_colpkg_tracers, only: & - ntrcr, nbtrcr, nbtrcr_sw - - integer (kind=int_kind), intent(in) :: & - ntrcr_in , &! number of tracers in use - nbtrcr_in , &! number of bio tracers in use - nbtrcr_sw_in ! number of shortwave bio tracers in use - - ntrcr = ntrcr_in - nbtrcr = nbtrcr_in - nbtrcr_sw = nbtrcr_sw_in - - end subroutine colpkg_init_tracer_numbers - -!======================================================================= -! set active processes - - subroutine colpkg_init_active_processes(& - latent_processes_active, & - lateral_melt_active, & - congel_basal_melt_active) - - use ice_atmo, only: & - latentHeatActive - - use ice_therm_vertical, only: & - lateralMeltActive, & - congelBasalMeltActive - - use ice_constants_colpkg, only: & - c0, c1 - - logical (kind=log_kind), intent(in) :: & - latent_processes_active, & - lateral_melt_active, & - congel_basal_melt_active - - if (latent_processes_active) then - latentHeatActive = c1 - else - latentHeatActive = c0 - endif - - if (lateral_melt_active) then - lateralMeltActive = c1 - else - lateralMeltActive = c0 - endif - - if (congel_basal_melt_active) then - congelBasalMeltActive = c1 - else - congelBasalMeltActive = c0 - endif - - end subroutine colpkg_init_active_processes - -!======================================================================= - - subroutine colpkg_biogeochemistry(dt, & - ntrcr, nbtrcr, & - upNO, upNH, iDi, iki, zfswin, & - zsal_tot, darcy_V, grow_net, & - PP_net, hbri,dhbr_bot, dhbr_top, Zoo,& - fbio_snoice, fbio_atmice, & - ocean_bio, & - first_ice, fswpenln, bphi, bTiz, ice_bio_net, & - snow_bio_net, totalChla, fswthrun, Rayleigh_criteria, & - sice_rho, fzsal, fzsal_g, & - bgrid, igrid, icgrid, cgrid, & - nblyr, nilyr, nslyr, n_algae, n_zaero, ncat, & - n_doc, n_dic, n_don, n_fed, n_fep, & - meltbn, melttn, congeln, snoicen, & - sst, sss, Tf, fsnow, meltsn, hmix, salinz, & - hin_old, flux_bio, flux_bio_atm, & - aicen_init, vicen_init, aicen, vicen, vsnon, & - aice0, trcrn, vsnon_init, skl_bgc, & - max_algae, max_nbtrcr, & - flux_bion, bioPorosityIceCell, & - bioSalinityIceCell, bioTemperatureIceCell, & - l_stop, stop_label) - - use ice_algae, only: zbio, sklbio - use ice_brine, only: preflushing_changes, compute_microS_mushy, & - update_hbrine, compute_microS - use ice_colpkg_shared, only: solve_zsal, z_tracers, phi_snow - use ice_colpkg_tracers, only: nt_fbri, tr_brine, & - nt_bgc_S, nt_qice, nt_sice, nt_zbgc_frac, bio_index, bio_index_o - use ice_constants_colpkg, only: c0, c1, puny, p5 - use ice_zsalinity, only: zsalinity - use ice_zbgc_shared, only: zbgc_frac_init - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - integer (kind=int_kind), intent(in) :: & - ncat, & - nilyr, & - nslyr, & - nblyr, & - ntrcr, & - nbtrcr, & - n_algae, n_zaero, & - n_doc, n_dic, n_don, n_fed, n_fep, & - max_algae, max_nbtrcr - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - bgrid , & ! biology nondimensional vertical grid points - igrid , & ! biology vertical interface points - cgrid , & ! CICE vertical coordinate - icgrid , & ! interface grid for CICE (shortwave variable) - ocean_bio , & ! contains all the ocean bgc tracer concentrations - fbio_snoice , & ! fluxes from snow to ice - fbio_atmice , & ! fluxes from atm to ice - dhbr_top , & ! brine top change - dhbr_bot , & ! brine bottom change - darcy_V , & ! darcy velocity positive up (m/s) - hin_old , & ! old ice thickness - sice_rho , & ! avg sea ice density (kg/m^3) - ice_bio_net , & ! depth integrated tracer (mmol/m^2) - snow_bio_net , & ! depth integrated snow tracer (mmol/m^2) - flux_bio ! all bio fluxes to ocean - - logical (kind=log_kind), dimension (:), intent(inout) :: & - first_ice ! distinguishes ice that disappears (e.g. melts) - ! and reappears (e.g. transport) in a grid cell - ! during a single time step from ice that was - ! there the entire time step (true until ice forms) - - real (kind=dbl_kind), dimension (:,:), intent(out) :: & - flux_bion ! per categeory ice to ocean biogeochemistry flux (mmol/m2/s) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - bioPorosityIceCell, & ! category average porosity on the interface bio grid - bioSalinityIceCell, & ! (ppt) category average porosity on the interface bio grid - bioTemperatureIceCell ! (oC) category average porosity on the interface bio grid - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - Zoo , & ! N losses accumulated in timestep (ie. zooplankton/bacteria) - ! mmol/m^3 - bphi , & ! porosity of layers - bTiz , & ! layer temperatures interpolated on bio grid (C) - zfswin , & ! Shortwave flux into layers interpolated on bio grid (W/m^2) - iDi , & ! igrid Diffusivity (m^2/s) - iki , & ! Ice permeability (m^2) - trcrn ! tracers - - real (kind=dbl_kind), intent(inout) :: & - grow_net , & ! Specific growth rate (/s) per grid cell - PP_net , & ! Total production (mg C/m^2/s) per grid cell - hbri , & ! brine height, area-averaged for comparison with hi (m) - zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) - fzsal , & ! Total flux of salt to ocean at time step for conservation - fzsal_g , & ! Total gravity drainage flux - upNO , & ! nitrate uptake rate (mmol/m^2/d) times aice - upNH , & ! ammonium uptake rate (mmol/m^2/d) times aice - totalChla ! ice integrated chla and summed over all algal groups (mg/m^2) - - logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. means Ra_c was reached - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - fswpenln ! visible SW entering ice layers (W m-2) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - fswthrun , & ! SW through ice to ocean (W/m^2) - meltsn , & ! snow melt in category n (m) - melttn , & ! top melt in category n (m) - meltbn , & ! bottom melt in category n (m) - congeln , & ! congelation ice formation in category n (m) - snoicen , & ! snow-ice formation in category n (m) - salinz , & ! initial salinity profile (ppt) - flux_bio_atm, & ! all bio fluxes to ice from atmosphere - aicen_init , & ! initial ice concentration, for linear ITD - vicen_init , & ! initial ice volume (m), for linear ITD - vsnon_init , & ! initial snow volume (m), for aerosol - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), intent(in) :: & - aice0 , & ! open water area fraction - sss , & ! sea surface salinity (ppt) - sst , & ! sea surface temperature (C) - hmix , & ! mixed layer depth (m) - Tf , & ! basal freezing temperature (C) - fsnow ! snowfall rate (kg/m^2 s) - - logical (kind=log_kind), intent(in) :: & - skl_bgc ! if true, solve skeletal biochemistry - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort the model - - character (len=*), intent(inout) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k , & ! vertical index - n, mm ! thickness category index - - real (kind=dbl_kind) :: & - hin , & ! new ice thickness - hsn , & ! snow thickness (m) - hbr_old , & ! old brine thickness before growh/melt - dhice , & ! change due to sublimation/condensation (m) - kavg , & ! average ice permeability (m^2) - bphi_o , & ! surface ice porosity - hbrin , & ! brine height - dh_direct ! surface flooding or runoff - - real (kind=dbl_kind), dimension (nblyr+2) :: & - ! Defined on Bio Grid points - bSin , & ! salinity on the bio grid (ppt) - brine_sal , & ! brine salinity (ppt) - brine_rho ! brine_density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr+1) :: & - ! Defined on Bio Grid interfaces - iphin , & ! porosity - ibrine_sal , & ! brine salinity (ppt) - ibrine_rho , & ! brine_density (kg/m^3) - iSin , & ! Salinity on the interface grid (ppt) - iTin ! Temperature on the interface grid (oC) - - real (kind=dbl_kind) :: & - sloss ! brine flux contribution from surface runoff (g/m^2) - - real (kind=dbl_kind), dimension (ncat) :: & - hbrnInitial, & ! inital brine height - hbrnFinal ! category initial and final brine heights - - ! for bgc sk - real (kind=dbl_kind) :: & - dh_bot_chl , & ! Chlorophyll may or may not flush - dh_top_chl , & ! Chlorophyll may or may not flush - darcy_V_chl - - real (kind=dbl_kind), dimension (nblyr+1) :: & - zspace ! vertical grid spacing - - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5*zspace(1) - zspace(nblyr+1) = p5*zspace(nblyr+1) - - l_stop = .false. - bioPorosityIceCell(:) = c0 - bioSalinityIceCell(:) = c0 - bioTemperatureIceCell(:) = c0 - - do n = 1, ncat - - !----------------------------------------------------------------- - ! initialize - !----------------------------------------------------------------- - flux_bion(:,n) = c0 - hin_old(n) = c0 - hbrnFinal(n) = c0 - hbrnInitial(n) = c0 - - if (aicen_init(n) > puny) then - hin_old(n) = vicen_init(n) & - / aicen_init(n) - else - - first_ice(n) = .true. - if (tr_brine) trcrn(nt_fbri,n) = c1 - do mm = 1,nbtrcr - trcrn(nt_zbgc_frac-1+mm,n) = zbgc_frac_init(mm) - enddo - if (n == 1) Rayleigh_criteria = .false. - if (solve_zsal) trcrn(nt_bgc_S:nt_bgc_S+nblyr-1,n) = c0 - endif - - if (aicen(n) > puny) then - - dh_top_chl = c0 - dh_bot_chl = c0 - darcy_V_chl= c0 - bSin(:) = c0 - hsn = c0 - hin = c0 - hbrin = c0 - kavg = c0 - bphi_o = c0 - sloss = c0 - - !----------------------------------------------------------------- - ! brine dynamics - !----------------------------------------------------------------- - - dhbr_top(n) = c0 - dhbr_bot(n) = c0 - - if (tr_brine) then - - dhice = c0 - call preflushing_changes (n, aicen (n), & - vicen (n), vsnon (n), & - meltbn (n), melttn (n), & - congeln (n), snoicen(n), & - hin_old (n), dhice, & - trcrn(nt_fbri,n), & - dhbr_top(n), dhbr_bot(n), & - hbr_old, hin, & - hsn, first_ice(n), & - l_stop, stop_label) - - hbrnInitial(n) = hbr_old - - if (l_stop) return - - if (solve_zsal) then - - call compute_microS (n, nilyr, nblyr, & - bgrid, cgrid, igrid, & - trcrn(1:ntrcr,n), hin_old(n), hbr_old, & - sss, sst, bTiz(:,n), & - iTin, bphi(:,n), kavg, & - bphi_o, phi_snow, Rayleigh_criteria, & - first_ice(n), bSin, brine_sal, & - brine_rho, iphin, ibrine_rho, & - ibrine_sal, sice_rho(n), sloss, & - salinz(1:nilyr), iSin(:), l_stop, stop_label) - - if (l_stop) return - else - - ! Requires the average ice permeability = kavg(:) - ! and the surface ice porosity = zphi_o(:) - ! computed in "compute_microS" or from "thermosaline_vertical" - - iDi(:,n) = c0 - - call compute_microS_mushy (n, nilyr, nblyr, & - bgrid, cgrid, igrid, & - trcrn(:,n), hin_old(n), hbr_old, & - sss, sst, bTiz(:,n), & - iTin(:), bphi(:,n), kavg, & - bphi_o, phi_snow, bSin(:), & - brine_sal(:), brine_rho(:), iphin(:), & - ibrine_rho(:), ibrine_sal(:), sice_rho(n), & - iDi(:,n), iSin(:), l_stop, & - stop_label) - - endif ! solve_zsal - - call update_hbrine (meltbn (n), melttn(n), & - meltsn (n), dt, & - hin, hsn, & - hin_old (n), hbrin, & - - hbr_old, phi_snow, & - trcrn(nt_fbri,n), & - snoicen(n), & - dhbr_top(n), dhbr_bot(n), & - dh_top_chl, dh_bot_chl, & - kavg, bphi_o, & - darcy_V (n), darcy_V_chl, & - bphi(2,n), aice0, & - dh_direct) - - hbri = hbri + hbrin * aicen(n) - hbrnFinal(n) = hbrin - - if (solve_zsal) then - - call zsalinity (n, dt, & - nilyr, bgrid, & - cgrid, igrid, & - trcrn(nt_bgc_S:nt_bgc_S+nblyr-1,n), & - trcrn(nt_qice:nt_qice+nilyr-1,n), & - trcrn(nt_sice:nt_sice+nilyr-1,n), & - ntrcr, trcrn(nt_fbri,n), & - bSin, bTiz(:,n), & - bphi(:,n), iphin, & - iki(:,n), hbr_old, & - hbrin, hin, & - hin_old(n), iDi(:,n), & - darcy_V(n), brine_sal, & - brine_rho, ibrine_sal, & - ibrine_rho, dh_direct, & - Rayleigh_criteria, & - first_ice(n), sss, & - sst, dhbr_top(n), & - dhbr_bot(n), & - l_stop, stop_label, & - fzsal, fzsal_g, & - bphi_o, nblyr, & - vicen(n), aicen_init(n), & - zsal_tot) - - if (l_stop) return - - endif ! solve_zsal - - endif ! tr_brine - - !----------------------------------------------------------------- - ! biogeochemistry - !----------------------------------------------------------------- - - if (z_tracers) then - - call zbio (dt, nblyr, & - nslyr, nilyr, & - melttn(n), & - meltsn(n), meltbn (n), & - congeln(n), snoicen(n), & - nbtrcr, fsnow, & - ntrcr, trcrn(1:ntrcr,n), & - bio_index(1:nbtrcr), bio_index_o(:), & - aicen_init(n), & - vicen_init(n), vsnon_init(n), & - vicen(n), vsnon(n), & - aicen(n), flux_bio_atm(:), & - n, n_algae, & - n_doc, n_dic, & - n_don, & - n_fed, n_fep, & - n_zaero, first_ice(n), & - hin_old(n), ocean_bio(1:nbtrcr), & - bphi(:,n), iphin, & - iDi(:,n), sss, & - fswpenln(:,n), & - dhbr_top(n), dhbr_bot(n), & - dh_top_chl, dh_bot_chl, & - zfswin(:,n), & - hbrin, hbr_old, & - darcy_V(n), darcy_V_chl, & - bgrid, cgrid, & - igrid, icgrid, & - bphi_o, & - dhice, iTin, & - Zoo(:,n), & - flux_bio(:), dh_direct, & - upNO, upNH, & - fbio_snoice, fbio_atmice, & - PP_net, ice_bio_net (:), & - snow_bio_net(:), grow_net, & - totalChla, & - flux_bion(:,n), iSin, & - bioPorosityIceCell(:), bioSalinityIceCell(:), & - bioTemperatureIceCell(:), & - l_stop, stop_label) - - if (l_stop) return - - elseif (skl_bgc) then - - call sklbio (dt, Tf, & - ntrcr, nilyr, & - nbtrcr, n_algae, & - n_zaero, n_doc, & - n_dic, n_don, & - n_fed, n_fep, & - flux_bio (1:nbtrcr), ocean_bio(:), & - hmix, aicen (n), & - meltbn (n), congeln (n), & - fswthrun (n), first_ice(n), & - trcrn (1:ntrcr,n), hin, & - PP_net, upNO, & - upNH, grow_net, & - totalChla, & - l_stop, stop_label) - - if (l_stop) return - - endif ! skl_bgc - - first_ice(n) = .false. - else - do mm = 1, nbtrcr - do k = 1, nblyr+1 - flux_bion(mm,n) = flux_bion(mm,n) + trcrn(bio_index(mm) + k-1,n) * & - hin_old(n) * zspace(k)/dt * trcrn(nt_fbri,n) - flux_bio(mm) = flux_bio(mm) + trcrn(bio_index(mm) + k-1,n) * & - vicen_init(n) * zspace(k)/dt * trcrn(nt_fbri,n) - trcrn(bio_index(mm) + k-1,n) = c0 - enddo - enddo - endif ! aicen > puny - enddo ! ncat - - end subroutine colpkg_biogeochemistry - -!======================================================================= - -! Initialize brine height tracer - - subroutine colpkg_init_hbrine(bgrid, igrid, cgrid, & - icgrid, swgrid, nblyr, nilyr, phi_snow) - - use ice_constants_colpkg, only: c1, c1p5, c2, p5, c0, rhoi, rhos, p25 - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nblyr ! number of bio layers - - real (kind=dbl_kind), intent(inout) :: & - phi_snow !porosity at the ice-snow interface - - real (kind=dbl_kind), dimension (nblyr+2), intent(out) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(out) :: & - cgrid , & ! CICE vertical coordinate - icgrid , & ! interface grid for CICE (shortwave variable) - swgrid ! grid for ice tracers used in dEdd scheme - - integer (kind=int_kind) :: & - k , & ! vertical index - n ! thickness category index - - real (kind=dbl_kind) :: & - zspace ! grid spacing for CICE vertical grid - - - if (phi_snow .le. c0) phi_snow = c1-rhos/rhoi - - !----------------------------------------------------------------- - ! Calculate bio gridn: 0 to 1 corresponds to ice top to bottom - !----------------------------------------------------------------- - - bgrid(:) = c0 ! zsalinity grid points - bgrid(nblyr+2) = c1 ! bottom value - igrid(:) = c0 ! bgc interface grid points - igrid(1) = c0 ! ice top - igrid(nblyr+1) = c1 ! ice bottom - - zspace = c1/max(c1,(real(nblyr,kind=dbl_kind))) - do k = 2, nblyr+1 - bgrid(k) = zspace*(real(k,kind=dbl_kind) - c1p5) - enddo - - do k = 2, nblyr - igrid(k) = p5*(bgrid(k+1)+bgrid(k)) - enddo - - !----------------------------------------------------------------- - ! Calculate CICE cgrid for interpolation ice top (0) to bottom (1) - !----------------------------------------------------------------- - - cgrid(1) = c0 ! CICE vertical grid top point - zspace = c1/(real(nilyr,kind=dbl_kind)) ! CICE grid spacing - - do k = 2, nilyr+1 - cgrid(k) = zspace * (real(k,kind=dbl_kind) - c1p5) - enddo - - !----------------------------------------------------------------- - ! Calculate CICE icgrid for ishortwave interpolation top(0) , bottom (1) - !----------------------------------------------------------------- - - icgrid(1) = c0 - zspace = c1/(real(nilyr,kind=dbl_kind)) ! CICE grid spacing - - do k = 2, nilyr+1 - icgrid(k) = zspace * (real(k,kind=dbl_kind)-c1) - enddo - - !------------------------------------------------------------------------ - ! Calculate CICE swgrid for dEdd ice: top of ice (0) , bottom of ice (1) - ! Does not include snow - ! see ice_shortwave.F90 - ! swgrid represents the layer index of the delta-eddington ice layer index - !------------------------------------------------------------------------ - zspace = c1/(real(nilyr,kind=dbl_kind)) ! CICE grid spacing - swgrid(1) = min(c1/60.0_dbl_kind, zspace*p25) - swgrid(2) = zspace/c2 !+ swgrid(1) - do k = 3, nilyr+1 - swgrid(k) = zspace * (real(k,kind=dbl_kind)-c1p5) - enddo - - end subroutine colpkg_init_hbrine - -!======================================================================= - -! Initialize ocean concentration - - subroutine colpkg_init_ocean_conc (amm, dmsp, dms, algalN, doc, dic, don, & - fed, fep, hum, nit, sil, zaeros, max_dic, max_don, max_fe, max_aero,& - CToN, CToN_DON) - - use ice_constants_colpkg, only: c1, c2, p5, c0, p1 - use ice_colpkg_shared, only: R_C2N, R_C2N_DON - - integer (kind=int_kind), intent(in) :: & - max_dic, & - max_don, & - max_fe, & - max_aero - - real (kind=dbl_kind), intent(out):: & - amm , & ! ammonium - dmsp , & ! DMSPp - dms , & ! DMS - hum , & ! humic material - nit , & ! nitrate - sil ! silicate - - real (kind=dbl_kind), dimension(:), intent(out):: & - algalN , & ! algae - doc , & ! DOC - dic , & ! DIC - don , & ! DON - fed , & ! Dissolved Iron - fep , & ! Particulate Iron - zaeros ! BC and dust - - real (kind=dbl_kind), dimension(:), intent(inout), optional :: & - CToN , & ! carbon to nitrogen ratio for algae - CToN_DON ! nitrogen to carbon ratio for proteins - - integer (kind=int_kind) :: & - k - - if (present(CToN)) then - CToN(1) = R_C2N(1) - CToN(2) = R_C2N(2) - CToN(3) = R_C2N(3) - endif - - if (present(CToN_DON)) then - CToN_DON(1) = R_C2N_DON(1) - endif - - amm = c1 ! ISPOL < 1 mmol/m^3 - dmsp = p1 - dms = p1 - algalN(1) = c1 !0.0026_dbl_kind ! ISPOL, Lannuzel 2013(pennate) - algalN(2) = 0.0057_dbl_kind ! ISPOL, Lannuzel 2013(small plankton) - algalN(3) = 0.0027_dbl_kind ! ISPOL, Lannuzel 2013(Phaeocystis) - ! 0.024_dbl_kind ! 5% of 1 mgchl/m^3 - doc(1) = 16.2_dbl_kind ! 18% saccharides - doc(2) = 9.0_dbl_kind ! lipids - doc(3) = c1 ! - do k = 1, max_dic - dic(k) = 1950.0_dbl_kind ! 1950-2260 mmol C/m3 (Tynan et al. 2015) - enddo - do k = 1, max_don - don(k) = 12.9_dbl_kind - ! 64.3_dbl_kind ! 72% Total DOC~90 mmolC/m^3 ISPOL with N:C of 0.2 - enddo - !ki = 1 - !if (trim(fe_data_type) == 'clim') ki = 2 - do k = 1, max_fe ! ki, max_fe - fed(k) = 0.4_dbl_kind ! c1 (nM) Lannuzel2007 DFe, - ! range 0.14-2.6 (nM) van der Merwe 2011 - ! Tagliabue 2012 (0.4 nM) - fep(k) = c2 ! (nM) van der Merwe 2011 - ! (0.6 to 2.9 nM ocean) - enddo - hum = c1 ! mmol C/m^3 - nit = 12.0_dbl_kind - sil = 25.0_dbl_kind - do k = 1, max_aero - zaeros(k) = c0 - enddo - - - end subroutine colpkg_init_ocean_conc - -!======================================================================= - -! Initialize zSalinity - - subroutine colpkg_init_zsalinity(nblyr,ntrcr_o, restart_zsal, Rayleigh_criteria, & - Rayleigh_real, trcrn, nt_bgc_S, ncat, sss) - - use ice_constants_colpkg, only: c1, c2, p5, c0, p1 - use ice_colpkg_shared, only: dts_b, salt_loss - - integer (kind=int_kind), intent(in) :: & - nblyr, & ! number of biolayers - ntrcr_o, & ! number of non bio tracers - ncat , & ! number of categories - nt_bgc_S ! zsalinity index - - logical (kind=log_kind), intent(in) :: & - restart_zsal - - logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria - - real (kind=dbl_kind), intent(inout):: & - Rayleigh_real - - real (kind=dbl_kind), intent(in):: & - sss - - real (kind=dbl_kind), dimension(:,:), intent(inout):: & - trcrn ! bgc subset of trcrn - - integer (kind=int_kind) :: & - k , n - - if (nblyr .LE. 7) then - dts_b = 300.0_dbl_kind - else - dts_b = 50.0_dbl_kind - endif - - if (.not. restart_zsal) then - Rayleigh_criteria = .false. ! no ice initial condition - Rayleigh_real = c0 - do n = 1,ncat - do k = 1,nblyr - trcrn(nt_bgc_S+k-1-ntrcr_o,n) = sss*salt_loss - enddo ! k - enddo ! n - endif - - end subroutine colpkg_init_zsalinity - -!======================================================================= - -! basic initialization for ocean_bio_all - - subroutine colpkg_init_OceanConcArray(max_nbtrcr, & - max_algae, max_don, max_doc, max_dic, max_aero, max_fe, & - nit, amm, sil, dmsp, dms, algalN, & - doc, don, dic, fed, fep, zaeros, ocean_bio_all, hum) - - use ice_constants_colpkg, only: c0 - use ice_colpkg_shared, only: R_C2N, R_chl2N - use ice_zbgc_shared, only: R_S2N - - integer (kind=int_kind), intent(in) :: & - max_algae , & ! maximum number of algal types - max_dic , & ! maximum number of dissolved inorganic carbon types - max_doc , & ! maximum number of dissolved organic carbon types - max_don , & ! maximum number of dissolved organic nitrogen types - max_fe , & ! maximum number of iron types - max_aero , & ! maximum number of aerosols - max_nbtrcr ! maximum number of bio tracers - - real (kind=dbl_kind), intent(in) :: & - nit , & ! ocean nitrate (mmol/m^3) - amm , & ! ammonia/um (mmol/m^3) - sil , & ! silicate (mmol/m^3) - dmsp , & ! dmsp (mmol/m^3) - dms , & ! dms (mmol/m^3) - hum ! humic material (mmol/m^3) - - real (kind=dbl_kind), dimension (max_algae), intent(in) :: & - algalN ! ocean algal nitrogen (mmol/m^3) (diatoms, phaeo, pico) - - real (kind=dbl_kind), dimension (max_doc), intent(in) :: & - doc ! ocean doc (mmol/m^3) (proteins, EPS, lipid) - - real (kind=dbl_kind), dimension (max_don), intent(in) :: & - don ! ocean don (mmol/m^3) - - real (kind=dbl_kind), dimension (max_dic), intent(in) :: & - dic ! ocean dic (mmol/m^3) - - real (kind=dbl_kind), dimension (max_fe), intent(in) :: & - fed, fep ! ocean disolved and particulate fe (nM) - - real (kind=dbl_kind), dimension (max_aero), intent(in) :: & - zaeros ! ocean aerosols (mmol/m^3) - - real (kind=dbl_kind), dimension (max_nbtrcr), intent(inout) :: & - ocean_bio_all ! fixed order, all values even for tracers false - - ! local variables - - integer (kind=int_kind) :: & - k, ks ! tracer indices - - ocean_bio_all(:) = c0 - - do k = 1, max_algae - ocean_bio_all(k) = algalN(k) ! N - ks = max_algae + max_doc + max_dic + 1 - ocean_bio_all(ks + k) = R_chl2N(k)*algalN(k)!chl - enddo - - ks = max_algae + 1 - do k = 1, max_doc - ocean_bio_all(ks + k) = doc(k) ! doc - enddo - ks = ks + max_doc - do k = 1, max_dic - ocean_bio_all(ks + k) = dic(k) ! dic - enddo - - ks = 2*max_algae + max_doc + max_dic + 7 - do k = 1, max_don - ocean_bio_all(ks + k) = don(k) ! don - enddo - - ks = max_algae + 1 - ocean_bio_all(ks) = nit ! nit - - ks = 2*max_algae + max_doc + 2 + max_dic - ocean_bio_all(ks) = amm ! Am - ks = ks + 1 - ocean_bio_all(ks) = sil ! Sil - ks = ks + 1 - ocean_bio_all(ks) = R_S2N(1)*algalN(1) & ! DMSPp - + R_S2N(2)*algalN(2) & - + R_S2N(3)*algalN(3) - ks = ks + 1 - ocean_bio_all(ks) = dmsp ! DMSPd - ks = ks + 1 - ocean_bio_all(ks) = dms ! DMS - ks = ks + 1 - ocean_bio_all(ks) = nit ! PON - ks = 2*max_algae + max_doc + 7 + max_dic + max_don - do k = 1, max_fe - ocean_bio_all(ks + k) = fed(k) ! fed - enddo - ks = ks + max_fe - do k = 1, max_fe - ocean_bio_all(ks + k) = fep(k) ! fep - enddo - ks = ks + max_fe - do k = 1, max_aero - ocean_bio_all(ks+k) = zaeros(k) ! zaero - enddo - ks = ks + max_aero + 1 - ocean_bio_all(ks) = hum ! humics - - end subroutine colpkg_init_OceanConcArray - -!======================================================================= -! Warning messages -!======================================================================= - - subroutine colpkg_clear_warnings() - - use ice_warnings, only: reset_warnings - - call reset_warnings() - - end subroutine colpkg_clear_warnings - -!======================================================================= - - subroutine colpkg_get_warnings(warningsOut) - - use ice_warnings, only: & - get_number_warnings, & - get_warning - - character(len=char_len_long), dimension(:), allocatable, intent(out) :: & - warningsOut - - integer :: & - iWarning, & - nWarnings - - nWarnings = get_number_warnings() - - if (allocated(warningsOut)) deallocate(warningsOut) - allocate(warningsOut(nWarnings)) - - do iWarning = 1, nWarnings - warningsOut(iWarning) = trim(get_warning(iWarning)) - enddo - - end subroutine colpkg_get_warnings - -!======================================================================= - - subroutine colpkg_print_warnings(nu_diag) - - use ice_warnings, only: & - get_number_warnings, & - get_warning - - integer, intent(in) :: nu_diag - - integer :: & - iWarning - - do iWarning = 1, get_number_warnings() - write(nu_diag,*) trim(get_warning(iWarning)) - enddo - - end subroutine colpkg_print_warnings - -!======================================================================= - - end module ice_colpkg - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_colpkg_shared.F90 b/components/mpas-seaice/src/column/ice_colpkg_shared.F90 deleted file mode 100644 index 33a23e39677b..000000000000 --- a/components/mpas-seaice/src/column/ice_colpkg_shared.F90 +++ /dev/null @@ -1,478 +0,0 @@ -! SVN:$Id: ice_colpkg_shared.F90 1142 2016-08-27 16:07:51Z njeffery $ -!========================================================================= -! -! flags for the column package -! -! authors: Elizabeth C. Hunke, LANL - - module ice_colpkg_shared - - use ice_kinds_mod - use ice_constants_colpkg, only: c3, c0, c1, p5, p1 - - implicit none - - private - -!----------------------------------------------------------------------- -! Parameters for thermodynamics -!----------------------------------------------------------------------- - - integer (kind=int_kind), public :: & - ktherm ! type of thermodynamics - ! 0 = 0-layer approximation - ! 1 = Bitz and Lipscomb 1999 - ! 2 = mushy layer theory - - character (char_len), public :: & - conduct, & ! 'MU71' or 'bubbly' - fbot_xfer_type ! transfer coefficient type for ice-ocean heat flux - - logical (kind=log_kind), public :: & - heat_capacity, &! if true, ice has nonzero heat capacity - ! if false, use zero-layer thermodynamics - calc_Tsfc , &! if true, calculate surface temperature - ! if false, Tsfc is computed elsewhere and - ! atmos-ice fluxes are provided to CICE - solve_zsal , &! if true, update salinity profile from solve_S_dt - modal_aero ! if true, use modal aerosal optical properties - ! only for use with tr_aero or tr_zaero - - real (kind=dbl_kind), parameter, public :: & - saltmax = 3.2_dbl_kind, & ! max salinity at ice base for BL99 (ppt) - ! phi_init and dSin0_frazil are used for mushy thermo, ktherm=2 - phi_init = 0.75_dbl_kind, & ! initial liquid fraction of frazil - min_salin = p1 , & ! threshold for brine pocket treatment - salt_loss =0.4_dbl_kind, & ! fraction of salt retained in zsalinity - min_bgc = 0.01_dbl_kind, & ! fraction of ocean bgc concentration in surface melt - dSin0_frazil = c3 ! bulk salinity reduction of newly formed frazil - - real (kind=dbl_kind), public :: & - dts_b, & ! zsalinity timestep - ustar_min ! minimum friction velocity for ice-ocean heat flux - - ! mushy thermo - real(kind=dbl_kind), public :: & - a_rapid_mode , & ! channel radius for rapid drainage mode (m) - Rac_rapid_mode , & ! critical Rayleigh number for rapid drainage mode - aspect_rapid_mode , & ! aspect ratio for rapid drainage mode (larger=wider) - dSdt_slow_mode , & ! slow mode drainage strength (m s-1 K-1) - phi_c_slow_mode , & ! liquid fraction porosity cutoff for slow mode - phi_i_mushy ! liquid fraction of congelation ice - -!----------------------------------------------------------------------- -! Parameters for radiation -!----------------------------------------------------------------------- - - character (len=char_len), public :: & - shortwave, & ! shortwave method, 'default' ('ccsm3') or 'dEdd' - albedo_type ! albedo parameterization, 'default' ('ccsm3') or 'constant' - ! shortwave='dEdd' overrides this parameter - - ! baseline albedos for ccsm3 shortwave, set in namelist - real (kind=dbl_kind), public :: & - albicev , & ! visible ice albedo for h > ahmax - albicei , & ! near-ir ice albedo for h > ahmax - albsnowv , & ! cold snow albedo, visible - albsnowi , & ! cold snow albedo, near IR - ahmax ! thickness above which ice albedo is constant (m) - - ! dEdd tuning parameters, set in namelist - real (kind=dbl_kind), public :: & - R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo - R_pnd , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo - R_snw , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt , & ! change in temp for non-melt to melt snow grain - ! radius change (C) - rsnw_mlt , & ! maximum melting snow grain radius (10^-6 m) - kalg ! algae absorption coefficient for 0.5 m thick layer - - real (kind=dbl_kind), parameter, public :: & - hi_ssl = 0.050_dbl_kind, & ! ice surface scattering layer thickness (m) - hs_ssl = 0.040_dbl_kind, & ! snow surface scattering layer thickness (m) - hs_ssl_min = 5.0e-4_dbl_kind ! minimum snow scattering layer thickness for aerosol accumulation (m) - - ! snicar 5 band system, set in namelist - logical (kind=log_kind), public :: & - use_snicar ! if true, use 5-band snicar IOPs for - ! shortwave radiative calculation of - ! snow-coverd sea ice - -!----------------------------------------------------------------------- -! Parameters for ridging and strength -!----------------------------------------------------------------------- - - integer (kind=int_kind), public :: & ! defined in namelist - kstrength , & ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - krdg_partic, & ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - krdg_redist ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - - real (kind=dbl_kind), public :: & - mu_rdg, & ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) - Cf ! ratio of ridging work to PE change in ridging (kstrength = 1) - -!----------------------------------------------------------------------- -! Parameters for atmosphere -!----------------------------------------------------------------------- - - character (len=char_len), public :: & - atmbndy ! atmo boundary method, 'default' ('ccsm3') or 'constant' - - logical (kind=log_kind), public :: & - calc_strair, & ! if true, calculate wind stress components - formdrag, & ! if true, calculate form drag - highfreq ! if true, use high frequency coupling - - integer (kind=int_kind), public :: & - natmiter ! number of iterations for boundary layer calculations - -!----------------------------------------------------------------------- -! Parameters for ocean -!----------------------------------------------------------------------- - - real (kind=dbl_kind), public :: & - dragio ! neutral ice-ocean drag coefficient - - logical (kind=log_kind), public :: & - oceanmixed_ice ! if true, use ocean mixed layer - - character(len=char_len), public :: & - tfrz_option ! form of ocean freezing temperature - ! 'minus1p8' = -1.8 C - ! 'linear_salt' = -depressT * sss - ! 'mushy' conforms with ktherm=2 - -!----------------------------------------------------------------------- -! Parameters for the ice thickness distribution -!----------------------------------------------------------------------- - - integer (kind=int_kind), public :: & - kitd , & ! type of itd conversions - ! 0 = delta function - ! 1 = linear remap - kcatbound ! 0 = old category boundary formula - ! 1 = new formula giving round numbers - ! 2 = WMO standard - ! 3 = asymptotic formula - -!----------------------------------------------------------------------- -! Parameters for melt ponds -!----------------------------------------------------------------------- - - real (kind=dbl_kind), public :: & - hs0 ! snow depth for transition to bare sea ice (m) - - ! level-ice ponds - character (len=char_len), public :: & - frzpnd ! pond refreezing parameterization - - real (kind=dbl_kind), public :: & - dpscale, & ! alter e-folding time scale for flushing - rfracmin, & ! minimum retained fraction of meltwater - rfracmax, & ! maximum retained fraction of meltwater - pndaspect, & ! ratio of pond depth to pond fraction - hs1 ! tapering parameter for snow on pond ice - - ! topo ponds - real (kind=dbl_kind), public :: & - hp1 ! critical parameter for pond ice thickness - -!----------------------------------------------------------------------- -! Parameters for snow -!----------------------------------------------------------------------- - - ! snow metamorphism parameters, set in namelist - real (kind=dbl_kind), public :: & - rsnw_fall , & ! fallen snow grain radius (10^-6 m)) 54.5 um CLM ** - ! 30 um is minimum for defined mie properties - rsnw_tmax , & ! maximum dry metamorphism snow grain radius (10^-6 m) - ! 1500 um is maximum for defined mie properties - rhosnew , & ! new snow density (kg/m^3) - rhosmax , & ! maximum snow density (kg/m^3) - windmin , & ! minimum wind speed to compact snow (m/s) - snwlvlfac , & ! snow loss factor for wind redistribution - drhosdwind, & ! wind compaction factor (kg s/m^4) - ksno ! snow thermal conductivity (W/m/deg) - - character(len=char_len), public :: & - snwredist ! type of snow redistribution - ! '30percent' = 30% rule, precip only - ! '30percentsw' = 30% rule with shortwave - ! 'ITDsd' = Lecomte PhD, 2014 - ! 'ITDrdg' = like ITDsd but use level/ridged ice - ! 'default' or 'none' = none - - logical (kind=log_kind), public :: & - use_smliq_pnd ! if true, use snow liquid tracer for ponds - - ! indices for aging lookup table [idx] - integer(kind=int_kind), parameter, public :: & - idx_T_max = 11 , & ! maxiumum temperature index - idx_T_min = 1 , & ! minimum temperature index - idx_Tgrd_max = 31 , & ! maxiumum temperature gradient index - idx_Tgrd_min = 1 , & ! minimum temperature gradient index - idx_rhos_max = 8 , & ! maxiumum snow density index - idx_rhos_min = 1 ! minimum snow density index - - ! dry snow aging parameters - real (kind=dbl_kind), dimension(8,31,11), public :: & - snowage_tau, & ! (10^-6 m) - snowage_kappa, & ! - snowage_drdt0 ! (10^-6 m/hr) - -!----------------------------------------------------------------------- -! Parameters for biogeochemistry -!----------------------------------------------------------------------- - - !----------------------------------------------------------------- - ! dimensions - !----------------------------------------------------------------- - integer (kind=int_kind), parameter, public :: & - max_algae = 3 , & ! maximum number of algal types - max_dic = 1 , & ! maximum number of dissolved inorganic carbon types - max_doc = 3 , & ! maximum number of dissolved organic carbon types - max_don = 1 , & ! maximum number of dissolved organic nitrogen types - max_fe = 2 , & ! maximum number of iron types - nmodal1 = 10 , & ! dimension for modal aerosol radiation parameters - nmodal2 = 8 , & ! dimension for modal aerosol radiation parameters - max_aero = 6 , & ! maximum number of aerosols - max_nbtrcr = max_algae*2 & ! algal nitrogen and chlorophyll - + max_dic & ! dissolved inorganic carbon - + max_doc & ! dissolved organic carbon - + max_don & ! dissolved organic nitrogen - + 5 & ! nitrate, ammonium, silicate, PON, and humics - + 3 & ! DMSPp, DMSPd, DMS - + max_fe*2 & ! dissolved Fe and particulate Fe - + max_aero ! aerosols - - !----------------------------------------------------------------- - ! namelist - !----------------------------------------------------------------- - character(char_len_long), public :: & - bgc_data_dir ! directory for biogeochemistry data - - character(char_len), public :: & - sil_data_type , & ! 'default', 'clim' - nit_data_type , & ! 'default', 'clim' - fe_data_type , & ! 'default', 'clim' - bgc_flux_type ! type of ocean-ice piston velocity - ! 'constant', 'Jin2006' - - logical (kind=log_kind), public :: & - z_tracers, & ! if .true., bgc or aerosol tracers are vertically resolved - scale_bgc, & ! if .true., initialize bgc tracers proportionally with salinity - solve_zbgc, & ! if .true., solve vertical biochemistry portion of code - dEdd_algae ! if .true., algal absorption of Shortwave is computed in the - - logical (kind=log_kind), public :: & - skl_bgc ! if true, solve skeletal biochemistry - - real (kind=dbl_kind), public :: & - grid_o , & ! for bottom flux - l_sk , & ! characteristic diffusive scale (zsalinity) (m) - grid_o_t , & ! top grid point length scale - phi_snow , & ! porosity of snow - initbio_frac, & ! fraction of ocean tracer concentration used to initialize tracer - frazil_scav ! multiple of ocean tracer concentration due to frazil scavenging - - real (kind=dbl_kind), public :: & - grid_oS , & ! for bottom flux (zsalinity) - l_skS ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) - - logical (kind=log_kind), public :: & - restore_bgc ! if true, restore nitrate - - !----------------------------------------------------------------- - ! From ice_zbgc_shared.F90 - !----------------------------------------------------------------- - - real (kind=dbl_kind), public :: & - ratio_Si2N_diatoms, & ! algal Si to N (mol/mol) - ratio_Si2N_sp , & - ratio_Si2N_phaeo , & - ratio_S2N_diatoms , & ! algal S to N (mol/mol) - ratio_S2N_sp , & - ratio_S2N_phaeo , & - ratio_Fe2C_diatoms, & ! algal Fe to C (umol/mol) - ratio_Fe2C_sp , & - ratio_Fe2C_phaeo , & - ratio_Fe2N_diatoms, & ! algal Fe to N (umol/mol) - ratio_Fe2N_sp , & - ratio_Fe2N_phaeo , & - ratio_Fe2DON , & ! Fe to N of DON (nmol/umol) - ratio_Fe2DOC_s , & ! Fe to C of DOC (nmol/umol) saccharids - ratio_Fe2DOC_l , & ! Fe to C of DOC (nmol/umol) lipids - fr_resp , & ! fraction of algal growth lost due to respiration - tau_min , & ! rapid mobile to stationary exchanges (s) = 1.5 hours - tau_max , & ! long time mobile to stationary exchanges (s) = 2 days - algal_vel , & ! 0.5 cm/d(m/s) Lavoie 2005 1.5 cm/day - R_dFe2dust , & ! g/g (3.5% content) Tagliabue 2009 - dustFe_sol ! solubility fraction - - !----------------------------------------------------------------- - ! From algal_dyn in ice_algae.F90 - !----------------------------------------------------------------- - - real (kind=dbl_kind), public :: & - chlabs_diatoms , & ! chl absorption (1/m/(mg/m^3)) - chlabs_sp , & ! - chlabs_phaeo , & ! - alpha2max_low_diatoms , & ! light limitation (1/(W/m^2)) - alpha2max_low_sp , & - alpha2max_low_phaeo , & - beta2max_diatoms , & ! light inhibition (1/(W/m^2)) - beta2max_sp , & - beta2max_phaeo , & - mu_max_diatoms , & ! maximum growth rate (1/day) - mu_max_sp , & - mu_max_phaeo , & - grow_Tdep_diatoms, & ! Temperature dependence of growth (1/C) - grow_Tdep_sp , & - grow_Tdep_phaeo , & - fr_graze_diatoms , & ! Fraction grazed - fr_graze_sp , & - fr_graze_phaeo , & - mort_pre_diatoms , & ! Mortality (1/day) - mort_pre_sp , & - mort_pre_phaeo , & - mort_Tdep_diatoms, & ! T dependence of mortality (1/C) - mort_Tdep_sp , & - mort_Tdep_phaeo , & - k_exude_diatoms , & ! algal exudation (1/d) - k_exude_sp , & - k_exude_phaeo , & - K_Nit_diatoms , & ! nitrate half saturation (mmol/m^3) - K_Nit_sp , & - K_Nit_phaeo , & - K_Am_diatoms , & ! ammonium half saturation (mmol/m^3) - K_Am_sp , & - K_Am_phaeo , & - K_Sil_diatoms , & ! silicate half saturation (mmol/m^3) - K_Sil_sp , & - K_Sil_phaeo , & - K_Fe_diatoms , & ! iron half saturation (nM) - K_Fe_sp , & - K_Fe_phaeo , & - f_don_protein , & ! fraction of spilled grazing to proteins - kn_bac_protein , & ! Bacterial degredation of DON (1/d) - f_don_Am_protein , & ! fraction of remineralized DON to ammonium - f_doc_s , & ! fraction of mortality to DOC - f_doc_l , & - f_exude_s , & ! fraction of exudation to DOC - f_exude_l , & - k_bac_s , & ! Bacterial degredation of DOC (1/d) - k_bac_l , & - T_max , & ! maximum temperature (C) - fsal , & ! Salinity limitation (ppt) - op_dep_min , & ! Light attenuates for optical depths exceeding min - fr_graze_s , & ! fraction of grazing spilled or slopped - fr_graze_e , & ! fraction of assimilation excreted - fr_mort2min , & ! fractionation of mortality to Am - fr_dFe , & ! fraction of remineralized nitrogen (in units of algal iron) - k_nitrif , & ! nitrification rate (1/day) - t_iron_conv , & ! desorption loss pFe to dFe (day) - max_loss , & ! restrict uptake to % of remaining value - max_dfe_doc1 , & ! max ratio of dFe to saccharides in the ice (nM Fe/muM C) - fr_resp_s , & ! DMSPd fraction of respiration loss as DMSPd - y_sk_DMS , & ! fraction conversion given high yield - t_sk_conv , & ! Stefels conversion time (d) - t_sk_ox ! DMS oxidation time (d) - - !----------------------------------------------------------------- - ! former parameters now in namelist - !----------------------------------------------------------------- - - real (kind=dbl_kind), public :: & - algaltype_diatoms , & ! mobility type - algaltype_sp , & ! - algaltype_phaeo , & ! - nitratetype , & ! - ammoniumtype , & ! - silicatetype , & ! - dmspptype , & ! - dmspdtype , & ! - humtype , & ! - doctype_s , & ! - doctype_l , & ! - dictype_1 , & ! - dontype_protein , & ! - fedtype_1 , & ! - feptype_1 , & ! - zaerotype_bc1 , & ! - zaerotype_bc2 , & ! - zaerotype_dust1 , & ! - zaerotype_dust2 , & ! - zaerotype_dust3 , & ! - zaerotype_dust4 , & ! - ratio_C2N_diatoms , & ! algal C to N ratio (mol/mol) - ratio_C2N_sp , & ! - ratio_C2N_phaeo , & ! - ratio_chl2N_diatoms, & ! algal chlorophyll to N ratio (mg/mmol) - ratio_chl2N_sp , & ! - ratio_chl2N_phaeo , & ! - F_abs_chl_diatoms , & ! scales absorbed radiation for dEdd - F_abs_chl_sp , & ! - F_abs_chl_phaeo , & ! - ratio_C2N_proteins ! ratio of C to N in proteins (mol/mol) - - !----------------------------------------------------------------- - ! Transport type - !----------------------------------------------------------------- - ! In delta Eddington, algal particles are assumed to cause no - ! significant scattering (Brieglib and Light), only absorption - ! in the visible spectral band (200-700 nm) - ! Algal types: Diatoms, flagellates, Phaeocycstis - ! DOC : Proteins, EPS, Lipids - !----------------------------------------------------------------- - real (kind=dbl_kind), dimension(max_dic), public :: & - dictype ! added to namelist - - real (kind=dbl_kind), dimension(max_algae), public :: & - algaltype ! tau_min for both retention and release - - real (kind=dbl_kind), dimension(max_doc), public :: & - doctype - - real (kind=dbl_kind), dimension(max_don), public :: & - dontype - - real (kind=dbl_kind), dimension(max_fe), public :: & - fedtype - - real (kind=dbl_kind), dimension(max_fe), public :: & - feptype - - !------------------------------------------------------------ - ! Aerosol order and type should be consistent with order/type - ! specified in delta Eddington: 1) hydrophobic black carbon; - ! 2) hydrophilic black carbon; 3) dust (0.05-0.5 micron); - ! 4) dust (0.5-1.25 micron); 5) dust (1.25-2.5 micron); - ! 6) dust (2.5-5 micron) - !------------------------------------------------------------- - real (kind=dbl_kind), dimension(max_aero), public :: & - zaerotype - - !----------------------------------------------------------------- - ! Forcing input, history and diagnostic output - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter, public :: & - rhosi = 940.0_dbl_kind - - real (kind=dbl_kind), dimension(max_algae), public :: & - R_C2N , & ! algal C to N (mole/mole) - R_chl2N , & ! 3 algal chlorophyll to N (mg/mmol) - F_abs_chl ! to scale absorption in Dedd - - real (kind=dbl_kind), dimension(max_don), public :: & ! increase compare to algal R_Fe2C - R_C2N_DON - -!======================================================================= - - end module ice_colpkg_shared - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_colpkg_tracers.F90 b/components/mpas-seaice/src/column/ice_colpkg_tracers.F90 deleted file mode 100644 index fc98f80362ef..000000000000 --- a/components/mpas-seaice/src/column/ice_colpkg_tracers.F90 +++ /dev/null @@ -1,260 +0,0 @@ -! SVN:$Id: ice_tracers.F90 -1 $ -!======================================================================= -! Indices and flags associated with the tracer infrastructure. -! Grid-dependent and max_trcr-dependent arrays are declared in ice_state.F90. -! -! author Elizabeth C. Hunke, LANL - - module ice_colpkg_tracers - - use ice_kinds_mod - use ice_colpkg_shared, only: max_algae, max_dic, max_doc, max_don, & - max_fe, max_aero, max_nbtrcr - - implicit none - save - - private - public :: colpkg_compute_tracers - - integer (kind=int_kind), public :: & - ntrcr , & ! number of tracers in use - ntrcr_o ! number of non-bio tracers in use - - integer (kind=int_kind), public :: & - nt_Tsfc , & ! ice/snow temperature - nt_qice , & ! volume-weighted ice enthalpy (in layers) - nt_qsno , & ! volume-weighted snow enthalpy (in layers) - nt_sice , & ! volume-weighted ice bulk salinity (CICE grid layers) - nt_fbri , & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - nt_iage , & ! volume-weighted ice age - nt_FY , & ! area-weighted first-year ice area - nt_alvl , & ! level ice area fraction - nt_vlvl , & ! level ice volume fraction - nt_apnd , & ! melt pond area fraction - nt_hpnd , & ! melt pond depth - nt_ipnd , & ! melt pond refrozen lid thickness - nt_smice , & ! mass of ice in snow - nt_smliq , & ! mass of liquid water in snow - nt_rhos , & ! effective snow density (compaction) - nt_rsnw , & ! effective snow grain radius - nt_aero , & ! starting index for aerosols in ice - nt_bgc_Nit, & ! nutrients - nt_bgc_Am, & ! - nt_bgc_Sil, & ! - nt_bgc_DMSPp, & ! trace gases (skeletal layer) - nt_bgc_DMSPd, & ! - nt_bgc_DMS, & ! - nt_bgc_PON, & ! zooplankton and detritus - nt_bgc_hum, & ! humic material - nt_zbgc_frac, & ! fraction of tracer in the mobile phase - nt_bgc_S ! Bulk salinity in fraction ice with dynamic salinity (Bio grid) - - logical (kind=log_kind), public :: & - tr_iage , & ! if .true., use age tracer - tr_FY , & ! if .true., use first-year area tracer - tr_lvl , & ! if .true., use level ice tracer - tr_pond , & ! if .true., use melt pond tracer - tr_pond_cesm, & ! if .true., use cesm pond tracer - tr_pond_lvl , & ! if .true., use level-ice pond tracer - tr_pond_topo, & ! if .true., use explicit topography-based ponds - tr_snow , & ! if .true., use snow density tracer (rhos_cmp) - tr_rsnw , & ! if .true., use dynamic snow grain radius, mass, liquid tracers - tr_aero , & ! if .true., use aerosol tracers - tr_brine ! if .true., brine height differs from ice thickness - - !----------------------------------------------------------------- - ! biogeochemistry - !----------------------------------------------------------------- - - logical (kind=log_kind), public :: & - tr_bgc_S, & ! if .true., use zsalinity - tr_zaero, & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit, & ! if .true. Nitrate tracer in ice - tr_bgc_N, & ! if .true., algal nitrogen tracers (n_algae) - tr_bgc_DON, & ! if .true., DON pools are tracers (n_don) - tr_bgc_C, & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl, & ! if .true., algal chlorophyll tracers - tr_bgc_Am, & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil, & ! if .true., silicon as nutrient tracer - tr_bgc_DMS, & ! if .true., DMS as tracer - tr_bgc_Fe, & ! if .true., Fe as tracer - tr_bgc_PON, & ! if .true., PON as tracer - tr_bgc_hum ! if .true., humic material as tracer - - integer (kind=int_kind), public :: & - nbtrcr, & ! number of bgc tracers in use - nbtrcr_sw, & ! number of bgc tracers which impact shortwave - nlt_chl_sw ! points to total chla in trcrn_sw - - integer (kind=int_kind), dimension(max_aero), public :: & - nlt_zaero_sw ! points to aerosol in trcrn_sw - - integer (kind=int_kind), dimension(max_algae), public :: & - nlt_bgc_N , & ! algae - nlt_bgc_C , & ! - nlt_bgc_chl - - integer (kind=int_kind), dimension(max_doc), public :: & - nlt_bgc_DOC ! disolved organic carbon - - integer (kind=int_kind), dimension(max_don), public :: & - nlt_bgc_DON ! - - integer (kind=int_kind), dimension(max_dic), public :: & - nlt_bgc_DIC ! disolved inorganic carbon - - integer (kind=int_kind), dimension(max_fe), public :: & - nlt_bgc_Fed , & ! - nlt_bgc_Fep ! - - integer (kind=int_kind), dimension(max_aero), public :: & - nlt_zaero ! non-reacting layer aerosols - - integer (kind=int_kind), public :: & - nlt_bgc_Nit , & ! nutrients - nlt_bgc_Am , & ! - nlt_bgc_Sil , & ! - nlt_bgc_DMSPp , & ! trace gases (skeletal layer) - nlt_bgc_DMSPd , & ! - nlt_bgc_DMS , & ! - nlt_bgc_PON , & ! zooplankton and detritus - nlt_bgc_hum ! humic material - - integer (kind=int_kind), dimension(max_algae), public :: & - nt_bgc_N , & ! diatoms, phaeocystis, pico/small - nt_bgc_C , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl ! diatoms, phaeocystis, pico/small - - integer (kind=int_kind), dimension(max_doc), public :: & - nt_bgc_DOC ! dissolved organic carbon - - integer (kind=int_kind), dimension(max_don), public :: & - nt_bgc_DON ! dissolved organic nitrogen - - integer (kind=int_kind), dimension(max_dic), public :: & - nt_bgc_DIC ! dissolved inorganic carbon - - integer (kind=int_kind), dimension(max_fe), public :: & - nt_bgc_Fed, & ! dissolved iron - nt_bgc_Fep ! particulate iron - - integer (kind=int_kind), dimension(max_aero), public :: & - nt_zaero ! black carbon and other aerosols - - integer (kind=int_kind), dimension(max_nbtrcr), public :: & - bio_index_o ! relates nlt_bgc_NO to ocean concentration index - ! see ocean_bio_all - - integer (kind=int_kind), dimension(max_nbtrcr), public :: & - bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N - -!======================================================================= - - contains - -!======================================================================= - -! Compute tracer fields. -! Given atrcrn = aicen*trcrn (or vicen*trcrn, vsnon*trcrn), compute trcrn. -! -! author: William H. Lipscomb, LANL - - subroutine colpkg_compute_tracers (ntrcr, trcr_depend, & - atrcrn, aicen, & - vicen, vsnon, & - trcr_base, n_trcr_strata, & - nt_strata, trcrn, & - Tf) - - use ice_constants_colpkg, only: c0, c1, puny - - integer (kind=int_kind), intent(in) :: & - ntrcr ! number of tracers in use - - integer (kind=int_kind), dimension (ntrcr), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (:), intent(in) :: & - atrcrn ! aicen*trcrn or vicen*trcrn or vsnon*trcrn - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon , & ! volume per unit area of snow (m) - Tf ! ocean freezing temperature (Celsius) - - real (kind=dbl_kind), dimension (ntrcr), intent(out) :: & - trcrn ! ice tracers - - ! local variables - - integer (kind=int_kind) :: & - it, & ! tracer index - itl, & ! tracer index - ntr, & ! tracer index - k ! loop index - - real (kind=dbl_kind), dimension(3) :: & - divisor ! base quantity on which tracers are carried - - real (kind=dbl_kind) :: & - work ! temporary scalar - - !----------------------------------------------------------------- - ! Compute new tracers - !----------------------------------------------------------------- - - do it = 1, ntrcr - divisor(1) = trcr_base(it,1)*aicen - divisor(2) = trcr_base(it,2)*vicen - divisor(3) = trcr_base(it,3)*vsnon - - if (trcr_depend(it) == 0) then ! ice area tracers - if (aicen > puny) then - trcrn(it) = atrcrn(it) / aicen - else - trcrn(it) = c0 - if (it == nt_Tsfc) trcrn(it) = Tf ! surface temperature - endif - - else - - work = c0 - do k = 1, 3 - if (divisor(k) > c0) then - work = atrcrn(it) / divisor(k) - endif - enddo - trcrn(it) = work ! save - if (n_trcr_strata(it) > 0) then ! additional tracer layers - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - if (trcrn(ntr) > c0) then - trcrn(it) = trcrn(it) / trcrn(ntr) - else - trcrn(it) = c0 - endif - enddo - endif - if (vicen <= c0 .and. it == nt_fbri) trcrn(it) = c1 - - endif ! trcr_depend=0 - - enddo - - end subroutine colpkg_compute_tracers - -!======================================================================= - - end module ice_colpkg_tracers - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_firstyear.F90 b/components/mpas-seaice/src/column/ice_firstyear.F90 deleted file mode 100755 index d0d259150c51..000000000000 --- a/components/mpas-seaice/src/column/ice_firstyear.F90 +++ /dev/null @@ -1,68 +0,0 @@ -! SVN:$Id: ice_firstyear.F90 1099 2015-12-12 18:12:30Z eclare $ -!======================================================================= -! -! First year concentration tracer for sea ice -! -! see -! Armour, K. C., C. M. Bitz, L. Thompson and E. C. Hunke (2011). Controls -! on Arctic sea ice from first-year and multi-year ice survivability. -! J. Climate, 24, 23782390. doi: 10.1175/2010JCLI3823.1. -! -! authors C. Bitz, University of Washington, modified from ice_age module -! -! 2012: E. Hunke adopted from CESM into CICE, changed name from ice_FY.F90 -! - module ice_firstyear - - use ice_kinds_mod - use ice_constants_colpkg, only: secday, c0 - - implicit none - - private - public :: update_FYarea - -!======================================================================= - - contains - -!======================================================================= - -! Zero ice FY tracer on fixed day of year. Zeroing FY ice tracer promotes -! ice to MY ice. Unfortunately some frazil ice may grow before the -! zeroing date and thus get promoted to MY ice too soon. -! Bummer. - - subroutine update_FYarea (dt, & - nhmask, shmask, & - yday, FYarea) - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - yday ! day of the year - - logical (kind=log_kind), & - intent(in) :: & - nhmask, shmask - - real (kind=dbl_kind), & - intent(inout) :: & - FYarea - - if ((yday >= 259._dbl_kind) .and. & - (yday < 259._dbl_kind+dt/secday)) then - if (nhmask) FYarea = c0 - endif - - if ((yday >= 75._dbl_kind) .and. & - (yday < 75._dbl_kind+dt/secday)) then - if (shmask) FYarea = c0 - endif - - end subroutine update_FYarea - -!======================================================================= - - end module ice_firstyear - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_flux_colpkg.F90 b/components/mpas-seaice/src/column/ice_flux_colpkg.F90 deleted file mode 100644 index 4806fdceccf0..000000000000 --- a/components/mpas-seaice/src/column/ice_flux_colpkg.F90 +++ /dev/null @@ -1,294 +0,0 @@ -! SVN:$Id: ice_flux_colpkg.F90 1175 2017-03-02 19:53:26Z akt $ -!======================================================================= - -! Flux manipulation routines for column package -! -! author Elizabeth C. Hunke, LANL -! -! 2014: Moved subroutines merge_fluxes, set_sfcflux from ice_flux.F90 - - module ice_flux_colpkg - - use ice_kinds_mod - use ice_constants_colpkg, only: c1, emissivity - use ice_warnings, only: add_warning - - implicit none - private - public :: merge_fluxes, set_sfcflux - -!======================================================================= - - contains - -!======================================================================= - -! Aggregate flux information from all ice thickness categories -! -! author: Elizabeth C. Hunke and William H. Lipscomb, LANL - - subroutine merge_fluxes (aicen, & - flw, coszn, & - strairxn, strairyn, & - Cdn_atm_ratio_n, & - fsurfn, fcondtopn, & - fsensn, flatn, & - fswabsn, flwoutn, & - evapn, & - Trefn, Qrefn, & - freshn, fsaltn, & - fhocnn, fswthrun, & - strairxT, strairyT, & - Cdn_atm_ratio, & - fsurf, fcondtop, & - fsens, flat, & - fswabs, flwout, & - evap, & - Tref, Qref, & - fresh, fsalt, & - fhocn, fswthru, & - melttn, meltsn, & - meltbn, congeln, & - snoicen, meltsliqn, & - meltt, melts, & - meltb, congel, & - snoice, meltsliq, & - Uref, Urefn ) - - ! single category fluxes - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice - flw , & ! downward longwave flux (W/m**2) - coszn , & ! cosine of solar zenith angle - strairxn, & ! air/ice zonal strss, (N/m**2) - strairyn, & ! air/ice merdnl strss, (N/m**2) - Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag - fsurfn , & ! net heat flux to top surface (W/m**2) - fcondtopn,& ! downward cond flux at top sfc (W/m**2) - fsensn , & ! sensible heat flx (W/m**2) - flatn , & ! latent heat flx (W/m**2) - fswabsn , & ! shortwave absorbed heat flx (W/m**2) - flwoutn , & ! upwd lw emitted heat flx (W/m**2) - evapn , & ! evaporation (kg/m2/s) - Trefn , & ! air tmp reference level (K) - Qrefn , & ! air sp hum reference level (kg/kg) - freshn , & ! fresh water flux to ocean (kg/m2/s) - fsaltn , & ! salt flux to ocean (kg/m2/s) - fhocnn , & ! actual ocn/ice heat flx (W/m**2) - fswthrun, & ! sw radiation through ice bot (W/m**2) - melttn , & ! top ice melt (m) - meltbn , & ! bottom ice melt (m) - meltsn , & ! snow melt (m) - meltsliqn,& ! snow liquid contribution to meltpond (kg/m^2) - congeln , & ! congelation ice growth (m) - snoicen ! snow-ice growth (m) - - real (kind=dbl_kind), optional, intent(in):: & - Urefn ! air speed reference level (m/s) - - ! cumulative fluxes - real (kind=dbl_kind), intent(inout) :: & - strairxT, & ! air/ice zonal strss, (N/m**2) - strairyT, & ! air/ice merdnl strss, (N/m**2) - Cdn_atm_ratio, & ! ratio of total drag over neutral drag - fsurf , & ! net heat flux to top surface (W/m**2) - fcondtop, & ! downward cond flux at top sfc (W/m**2) - fsens , & ! sensible heat flx (W/m**2) - flat , & ! latent heat flx (W/m**2) - fswabs , & ! shortwave absorbed heat flx (W/m**2) - flwout , & ! upwd lw emitted heat flx (W/m**2) - evap , & ! evaporation (kg/m2/s) - Tref , & ! air tmp reference level (K) - Qref , & ! air sp hum reference level (kg/kg) - fresh , & ! fresh water flux to ocean (kg/m2/s) - fsalt , & ! salt flux to ocean (kg/m2/s) - fhocn , & ! actual ocn/ice heat flx (W/m**2) - fswthru , & ! sw radiation through ice bot (W/m**2) - meltt , & ! top ice melt (m) - meltb , & ! bottom ice melt (m) - melts , & ! snow melt (m) - meltsliq, & ! snow liquid contribution to meltponds (kg/m^2) - congel , & ! congelation ice growth (m) - snoice ! snow-ice growth (m) - - real (kind=dbl_kind), optional, intent(inout):: & - Uref ! air speed reference level (m/s) - - !----------------------------------------------------------------- - ! Merge fluxes - ! NOTE: The albedo is aggregated only in cells where ice exists - ! and (for the delta-Eddington scheme) where the sun is above - ! the horizon. - !----------------------------------------------------------------- - - ! atmo fluxes - - strairxT = strairxT + strairxn * aicen - strairyT = strairyT + strairyn * aicen - Cdn_atm_ratio = Cdn_atm_ratio + & - Cdn_atm_ratio_n * aicen - fsurf = fsurf + fsurfn * aicen - fcondtop = fcondtop + fcondtopn * aicen - fsens = fsens + fsensn * aicen - flat = flat + flatn * aicen - fswabs = fswabs + fswabsn * aicen - flwout = flwout & - + (flwoutn - (c1-emissivity)*flw) * aicen - evap = evap + evapn * aicen - Tref = Tref + Trefn * aicen - Qref = Qref + Qrefn * aicen - - ! ocean fluxes - if (present(Urefn) .and. present(Uref)) then - Uref = Uref + Urefn * aicen - endif - - fresh = fresh + freshn * aicen - fsalt = fsalt + fsaltn * aicen - fhocn = fhocn + fhocnn * aicen - fswthru = fswthru + fswthrun * aicen - - ! ice/snow thickness - - meltt = meltt + melttn * aicen - meltb = meltb + meltbn * aicen - melts = melts + meltsn * aicen - congel = congel + congeln * aicen - snoice = snoice + snoicen * aicen - meltsliq = meltsliq + meltsliqn * aicen - - end subroutine merge_fluxes - -!======================================================================= - -! If model is not calculating surface temperature, set the surface -! flux values using values read in from forcing data or supplied via -! coupling (stored in ice_flux). -! -! If CICE is running in NEMO environment, convert fluxes from GBM values -! to per unit ice area values. If model is not running in NEMO environment, -! the forcing is supplied as per unit ice area values. -! -! authors Alison McLaren, Met Office - - subroutine set_sfcflux (aicen, & - flatn_f, & - fsensn_f, & - fsurfn_f, & - fcondtopn_f, & - flatn, & - fsensn, & - fsurfn, & - fcondtopn) - - ! ice state variables - real (kind=dbl_kind), & - intent(in) :: & - aicen , & ! concentration of ice - flatn_f , & ! latent heat flux (W/m^2) - fsensn_f , & ! sensible heat flux (W/m^2) - fsurfn_f , & ! net flux to top surface, not including fcondtopn - fcondtopn_f ! downward cond flux at top surface (W m-2) - - real (kind=dbl_kind), intent(out):: & - flatn , & ! latent heat flux (W/m^2) - fsensn , & ! sensible heat flux (W/m^2) - fsurfn , & ! net flux to top surface, not including fcondtopn - fcondtopn ! downward cond flux at top surface (W m-2) - - ! local variables - - real (kind=dbl_kind) :: & - raicen ! 1 or 1/aicen - - logical (kind=log_kind) :: & - extreme_flag ! flag for extreme forcing values - - logical (kind=log_kind), parameter :: & - extreme_test=.false. ! test and write out extreme forcing data - - character(len=char_len_long) :: & - warning ! warning message - - raicen = c1 - -#ifdef CICE_IN_NEMO -!---------------------------------------------------------------------- -! Convert fluxes from GBM values to per ice area values when -! running in NEMO environment. (When in standalone mode, fluxes -! are input as per ice area.) -!---------------------------------------------------------------------- - raicen = c1 / aicen -#endif - fsurfn = fsurfn_f*raicen - fcondtopn= fcondtopn_f*raicen - flatn = flatn_f*raicen - fsensn = fsensn_f*raicen - -!---------------------------------------------------------------- -! Flag up any extreme fluxes -!--------------------------------------------------------------- - - if (extreme_test) then - extreme_flag = .false. - - if (fcondtopn < -100.0_dbl_kind & - .or. fcondtopn > 20.0_dbl_kind) then - extreme_flag = .true. - endif - - if (fsurfn < -100.0_dbl_kind & - .or. fsurfn > 80.0_dbl_kind) then - extreme_flag = .true. - endif - - if (flatn < -20.0_dbl_kind & - .or. flatn > 20.0_dbl_kind) then - extreme_flag = .true. - endif - - if (extreme_flag) then - - if (fcondtopn < -100.0_dbl_kind & - .or. fcondtopn > 20.0_dbl_kind) then - write(warning,*) & - 'Extreme forcing: -100 > fcondtopn > 20' - call add_warning(warning) - write(warning,*) & - 'aicen,fcondtopn = ', & - aicen,fcondtopn - call add_warning(warning) - endif - - if (fsurfn < -100.0_dbl_kind & - .or. fsurfn > 80.0_dbl_kind) then - write(warning,*) & - 'Extreme forcing: -100 > fsurfn > 40' - call add_warning(warning) - write(warning,*) & - 'aicen,fsurfn = ', & - aicen,fsurfn - call add_warning(warning) - endif - - if (flatn < -20.0_dbl_kind & - .or. flatn > 20.0_dbl_kind) then - write(warning,*) & - 'Extreme forcing: -20 > flatn > 20' - call add_warning(warning) - write(warning,*) & - 'aicen,flatn = ', & - aicen,flatn - call add_warning(warning) - endif - - endif ! extreme_flag - endif ! extreme_test - - end subroutine set_sfcflux - -!======================================================================= - - end module ice_flux_colpkg - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_itd.F90 b/components/mpas-seaice/src/column/ice_itd.F90 deleted file mode 100644 index 19de0628182c..000000000000 --- a/components/mpas-seaice/src/column/ice_itd.F90 +++ /dev/null @@ -1,1746 +0,0 @@ -! SVN:$Id: ice_itd.F90 1196 2017-04-18 13:32:23Z eclare $ -!======================================================================= - -! Routines to initialize the ice thickness distribution and -! utilities to redistribute ice among categories. These routines -! are not specific to a particular numerical implementation. -! -! See Bitz, C.M., and W.H. Lipscomb, 1999: -! An energy-conserving thermodynamic model of sea ice, -! J. Geophys. Res., 104, 15,669--15,677. -! -! See Bitz, C.M., M.M. Holland, A.J. Weaver, M. Eby, 2001: -! Simulating the ice-thickness distribution in a climate model, -! J. Geophys. Res., 106, 2441--2464. -! -! authors: C. M. Bitz, UW -! William H. Lipscomb and Elizabeth C. Hunke, LANL -! -! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb -! -! 2004 WHL: Added multiple snow layers, block structure, cleanup_itd -! 2006 ECH: Added WMO standard ice thickness categories as kcatbound=2 -! Streamlined for efficiency -! Converted to free source form (F90) -! 2014 ECH: Converted to column package - - module ice_itd - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, p001, puny, p5, & - Lfresh, rhos, ice_ref_salinity, hs_min, cp_ice, rhoi - use ice_warnings, only: & - add_warning - - implicit none - save - - private - public :: aggregate_area, shift_ice, column_sum, & - column_conservation_check, cleanup_itd, reduce_area - -!======================================================================= - - contains - -!======================================================================= - -! Aggregate ice area (but not other state variables) over thickness -! categories. -! -! authors: William H. Lipscomb, LANL - - subroutine aggregate_area (ncat, aicen, aice, aice0) - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen ! concentration of ice - - real (kind=dbl_kind), intent(inout) :: & - aice, & ! concentration of ice - aice0 ! concentration of open water - - ! local variables - - integer (kind=int_kind) :: n - - !----------------------------------------------------------------- - ! Aggregate - !----------------------------------------------------------------- - - aice = c0 - do n = 1, ncat - aice = aice + aicen(n) - enddo ! n - - ! open water fraction - aice0 = max (c1 - aice, c0) - - end subroutine aggregate_area - -!======================================================================= - -! Rebins thicknesses into defined categories -! -! authors: William H. Lipscomb and Elizabeth C. Hunke, LANL - - subroutine rebin (ntrcr, trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen, trcrn, & - vicen, vsnon, & - ncat, hin_max, & - l_stop, stop_label) - - integer (kind=int_kind), intent(in) :: & - ntrcr , & ! number of tracers in use - ncat ! number of thickness categories - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), intent(in) :: & - Tf ! ocean freezing temperature (C) - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (ncat), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & - hin_max ! category limits (m) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - character (char_len), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - n ! category index - - logical (kind=log_kind) :: & - shiftflag ! = .true. if ice must be shifted - - integer (kind=int_kind), dimension (ncat) :: & - donor ! donor category index - - real (kind=dbl_kind), dimension (ncat) :: & - daice , & ! ice area transferred - dvice , & ! ice volume transferred - hicen ! ice thickness for each cat (m) - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - do n = 1, ncat - donor(n) = 0 - daice(n) = c0 - dvice(n) = c0 - - !----------------------------------------------------------------- - ! Compute ice thickness. - !----------------------------------------------------------------- - if (aicen(n) > puny) then - hicen(n) = vicen(n) / aicen(n) - else - hicen(n) = c0 - endif - enddo ! n - - !----------------------------------------------------------------- - ! make sure thickness of cat 1 is at least hin_max(0) - !----------------------------------------------------------------- - - if (aicen(1) > puny) then - if (hicen(1) <= hin_max(0) .and. hin_max(0) > c0 ) then - aicen(1) = vicen(1) / hin_max(0) - hicen(1) = hin_max(0) - endif - endif - - !----------------------------------------------------------------- - ! If a category thickness is not in bounds, shift the - ! entire area, volume, and energy to the neighboring category - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! Move thin categories up - !----------------------------------------------------------------- - - do n = 1, ncat-1 ! loop over category boundaries - - !----------------------------------------------------------------- - ! identify thicknesses that are too big - !----------------------------------------------------------------- - shiftflag = .false. - if (aicen(n) > puny .and. & - hicen(n) > hin_max(n)) then - shiftflag = .true. - donor(n) = n - daice(n) = aicen(n) - dvice(n) = vicen(n) - endif - - if (shiftflag) then - - !----------------------------------------------------------------- - ! shift ice between categories - !----------------------------------------------------------------- - - call shift_ice (ntrcr, ncat, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen, trcrn, & - vicen, vsnon, & - hicen, donor, & - daice, dvice, & - l_stop, stop_label) - - !----------------------------------------------------------------- - ! reset shift parameters - !----------------------------------------------------------------- - - donor(n) = 0 - daice(n) = c0 - dvice(n) = c0 - - endif ! shiftflag - - enddo ! n - - !----------------------------------------------------------------- - ! Move thick categories down - !----------------------------------------------------------------- - - do n = ncat-1, 1, -1 ! loop over category boundaries - - !----------------------------------------------------------------- - ! identify thicknesses that are too small - !----------------------------------------------------------------- - - shiftflag = .false. - if (aicen(n+1) > puny .and. & - hicen(n+1) <= hin_max(n)) then - shiftflag = .true. - donor(n) = n+1 - daice(n) = aicen(n+1) - dvice(n) = vicen(n+1) - endif - - if (shiftflag) then - - !----------------------------------------------------------------- - ! shift ice between categories - !----------------------------------------------------------------- - - call shift_ice (ntrcr, ncat, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen, trcrn, & - vicen, vsnon, & - hicen, donor, & - daice, dvice, & - l_stop, stop_label) - - !----------------------------------------------------------------- - ! reset shift parameters - !----------------------------------------------------------------- - - donor(n) = 0 - daice(n) = c0 - dvice(n) = c0 - - endif ! shiftflag - - enddo ! n - - end subroutine rebin - -!======================================================================= - -! Reduce area when ice melts for special case of ncat=1 -! -! Use CSM 1.0-like method of reducing ice area -! when melting occurs: assume only half the ice volume -! change goes to thickness decrease, the other half -! to reduction in ice fraction -! -! authors: C. M. Bitz, UW -! modified by: Elizabeth C. Hunke, LANL - - subroutine reduce_area (hin_max, & - aicen, vicen, & - aicen_init,vicen_init) - - real (kind=dbl_kind), intent(in) :: & - hin_max ! lowest category boundary - - real (kind=dbl_kind), intent(inout) :: & - aicen , & ! concentration of ice - vicen ! volume per unit area of ice (m) - - real (kind=dbl_kind), intent(in) :: & - aicen_init, & ! old ice area for category 1 (m) - vicen_init ! old ice volume for category 1 (m) - - ! local variables - - real (kind=dbl_kind) :: & - hi0 , & ! initial hi - hi1 , & ! current hi - dhi ! hi1 - hi0 - - hi0 = c0 - if (aicen_init > c0) & - hi0 = vicen_init / aicen_init - - hi1 = c0 - if (aicen > c0) & - hi1 = vicen / aicen - - ! make sure thickness of cat 1 is at least hin_max(0) - if (hi1 <= hin_max .and. hin_max > c0 ) then - aicen = vicen / hin_max - hi1 = hin_max - endif - - if (aicen > c0) then - dhi = hi1 - hi0 - if (dhi < c0) then - hi1 = vicen / aicen - aicen = c2 * vicen / (hi1 + hi0) - endif - endif - - end subroutine reduce_area - -!======================================================================= - -! Shift ice across category boundaries, conserving area, volume, and -! energy. -! -! authors: William H. Lipscomb and Elizabeth C. Hunke, LANL - - subroutine shift_ice (ntrcr, ncat, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen, trcrn, & - vicen, vsnon, & - hicen, donor, & - daice, dvice, & - l_stop, stop_label) - - use ice_colpkg_tracers, only: colpkg_compute_tracers - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - ntrcr ! number of tracers in use - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), intent(in) :: & - Tf ! ocean freezing temperature (C) - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - ! NOTE: Third index of donor, daice, dvice should be ncat-1, - ! except that compilers would have trouble when ncat = 1 - integer (kind=int_kind), dimension(:), intent(in) :: & - donor ! donor category index - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - daice , & ! ice area transferred across boundary - dvice , & ! ice volume transferred across boundary - hicen ! ice thickness for each cat (m) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - character (char_len), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - n , & ! thickness category index - nr , & ! receiver category - nd , & ! donor category - it , & ! tracer index - ntr , & ! tracer index - itl ! loop index - - real (kind=dbl_kind), dimension(ntrcr,ncat) :: & - atrcrn ! aicen*trcrn - - real (kind=dbl_kind) :: & - dvsnow , & ! snow volume transferred - datrcr ! aicen*train transferred - - logical (kind=log_kind) :: & - daice_negative , & ! true if daice < -puny - dvice_negative , & ! true if dvice < -puny - daice_greater_aicen, & ! true if daice > aicen - dvice_greater_vicen ! true if dvice > vicen - - real (kind=dbl_kind) :: & - worka, workb - - character(len=char_len_long) :: & - warning ! warning message - - real (kind=dbl_kind), dimension(ncat) :: aicen_init !echmod - as in icepack - real (kind=dbl_kind), dimension(ncat) :: vsnon_init !echmod - as in icepack - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - aicen_init(:) = aicen(:) !echmod - as in icepack - vsnon_init(:) = vsnon(:) !echmod - as in icepack - - !----------------------------------------------------------------- - ! Define variables equal to aicen*trcrn, vicen*trcrn, vsnon*trcrn - !----------------------------------------------------------------- - - do n = 1, ncat - do it = 1, ntrcr - atrcrn(it,n) = trcrn(it,n)*(trcr_base(it,1) * aicen(n) & - + trcr_base(it,2) * vicen(n) & - + trcr_base(it,3) * vsnon(n)) - if (n_trcr_strata(it) > 0) then - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - atrcrn(it,n) = atrcrn(it,n) * trcrn(ntr,n) - enddo - endif - enddo ! it - enddo ! n - - !----------------------------------------------------------------- - ! Check for daice or dvice out of range, allowing for roundoff error - !----------------------------------------------------------------- - - do n = 1, ncat-1 - - daice_negative = .false. - dvice_negative = .false. - daice_greater_aicen = .false. - dvice_greater_vicen = .false. - - if (donor(n) > 0) then - nd = donor(n) - - if (daice(n) < c0) then - if (daice(n) > -puny*aicen(nd)) then - daice(n) = c0 ! shift no ice - dvice(n) = c0 - else - daice_negative = .true. - endif - endif - - if (dvice(n) < c0) then - if (dvice(n) > -puny*vicen(nd)) then - daice(n) = c0 ! shift no ice - dvice(n) = c0 - else - dvice_negative = .true. - endif - endif - - if (daice(n) > aicen(nd)*(c1-puny)) then - if (daice(n) < aicen(nd)*(c1+puny)) then - daice(n) = aicen(nd) - dvice(n) = vicen(nd) - else - daice_greater_aicen = .true. - endif - endif - - if (dvice(n) > vicen(nd)*(c1-puny)) then - if (dvice(n) < vicen(nd)*(c1+puny)) then - daice(n) = aicen(nd) - dvice(n) = vicen(nd) - else - dvice_greater_vicen = .true. - endif - endif - - endif ! donor > 0 - - !----------------------------------------------------------------- - ! error messages - !----------------------------------------------------------------- - - if (daice_negative) then - if (donor(n) > 0 .and. & - daice(n) <= -puny*aicen(nd)) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'shift_ice: negative daice' - call add_warning(warning) - write(warning,*) 'boundary, donor cat:', n, nd - call add_warning(warning) - write(warning,*) 'daice =', daice(n) - call add_warning(warning) - write(warning,*) 'dvice =', dvice(n) - call add_warning(warning) - l_stop = .true. - stop_label = 'shift_ice: negative daice' - endif - endif - if (l_stop) return - - if (dvice_negative) then - if (donor(n) > 0 .and. & - dvice(n) <= -puny*vicen(nd)) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'shift_ice: negative dvice' - call add_warning(warning) - write(warning,*) 'boundary, donor cat:', n, nd - call add_warning(warning) - write(warning,*) 'daice =', daice(n) - call add_warning(warning) - write(warning,*) 'dvice =', dvice(n) - call add_warning(warning) - l_stop = .true. - stop_label = 'shift_ice: negative dvice' - endif - endif - if (l_stop) return - - if (daice_greater_aicen) then - if (donor(n) > 0) then - nd = donor(n) - if (daice(n) >= aicen(nd)*(c1+puny)) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'shift_ice: daice > aicen' - call add_warning(warning) - write(warning,*) 'boundary, donor cat:', n, nd - call add_warning(warning) - write(warning,*) 'daice =', daice(n) - call add_warning(warning) - write(warning,*) 'aicen =', aicen(nd) - call add_warning(warning) - l_stop = .true. - stop_label = 'shift_ice: daice > aicen' - endif - endif - endif - if (l_stop) return - - if (dvice_greater_vicen) then - if (donor(n) > 0) then - nd = donor(n) - if (dvice(n) >= vicen(nd)*(c1+puny)) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'shift_ice: dvice > vicen' - call add_warning(warning) - write(warning,*) 'boundary, donor cat:', n, nd - call add_warning(warning) - write(warning,*) 'dvice =', dvice(n) - call add_warning(warning) - write(warning,*) 'vicen =', vicen(nd) - call add_warning(warning) - l_stop = .true. - stop_label = 'shift_ice: dvice > vicen' - endif - endif - endif - if (l_stop) return - enddo ! boundaries, 1 to ncat-1 !echmod - as in icepack - - !----------------------------------------------------------------- - ! transfer volume and energy between categories - !----------------------------------------------------------------- - - do n = 1, ncat-1 !echmod - as in icepack - - if (daice(n) > c0) then ! daice(n) can be < puny - - nd = donor(n) -! worka = daice(n) / aicen(nd) !echmod - column - if (nd == n) then - nr = nd+1 - else ! nd = n+1 - nr = n - endif - - aicen(nd) = aicen(nd) - daice(n) - aicen(nr) = aicen(nr) + daice(n) - - vicen(nd) = vicen(nd) - dvice(n) - vicen(nr) = vicen(nr) + dvice(n) - -! dvsnow = vsnon(nd) * worka !echmod - column - worka = daice(n) / aicen_init(nd) !echmod - as in icepack - dvsnow = vsnon_init(nd) * worka !echmod - as in icepack - vsnon(nd) = vsnon(nd) - dvsnow - vsnon(nr) = vsnon(nr) + dvsnow - workb = dvsnow - - do it = 1, ntrcr - nd = donor(n) - if (nd == n) then - nr = nd+1 - else ! nd = n+1 - nr = n - endif - - datrcr = trcrn(it,nd)*(trcr_base(it,1) * daice(n) & - + trcr_base(it,2) * dvice(n) & - + trcr_base(it,3) * workb) - if (n_trcr_strata(it) > 0) then - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - datrcr = datrcr * trcrn(ntr,nd) - enddo - endif - - atrcrn(it,nd) = atrcrn(it,nd) - datrcr - atrcrn(it,nr) = atrcrn(it,nr) + datrcr - - enddo ! ntrcr - endif ! daice - enddo ! boundaries, 1 to ncat-1 - - !----------------------------------------------------------------- - ! Update ice thickness and tracers - !----------------------------------------------------------------- - - do n = 1, ncat - - if (aicen(n) > puny) then - hicen(n) = vicen (n) / aicen(n) - else - hicen(n) = c0 - endif - - !----------------------------------------------------------------- - ! Compute new tracers - !----------------------------------------------------------------- - - call colpkg_compute_tracers (ntrcr, trcr_depend, & - atrcrn(:,n), aicen(n), & - vicen(n), vsnon(n), & - trcr_base, n_trcr_strata, & - nt_strata, trcrn(:,n), & - Tf) - - enddo ! ncat - - end subroutine shift_ice - -!======================================================================= - -! For each grid cell, sum field over all ice categories. -! -! author: William H. Lipscomb, LANL - - subroutine column_sum (nsum, xin, xout) - - integer (kind=int_kind), intent(in) :: & - nsum ! number of categories/layers - - real (kind=dbl_kind), dimension (nsum), & - intent(in) :: & - xin ! input field - - real (kind=dbl_kind), intent(out) :: & - xout ! output field - - ! local variables - - integer (kind=int_kind) :: & - n ! category/layer index - - xout = c0 - do n = 1, nsum - xout = xout + xin(n) - enddo ! n - - end subroutine column_sum - -!======================================================================= - -! For each physical grid cell, check that initial and final values -! of a conserved field are equal to within a small value. -! -! author: William H. Lipscomb, LANL - - subroutine column_conservation_check (fieldid, & - x1, x2, & - max_err, & - l_stop) - - real (kind=dbl_kind), intent(in) :: & - x1 , & ! initial field - x2 ! final field - - real (kind=dbl_kind), intent(in) :: & - max_err ! max allowed error - - character (len=char_len), intent(in) :: & - fieldid ! field identifier - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort on return - - character(len=char_len_long) :: & - warning ! warning message - - ! local variables - - if (abs (x2-x1) > max_err) then - l_stop = .true. - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Conservation error: ', trim(fieldid) - call add_warning(warning) - write(warning,*) 'Initial value =', x1 - call add_warning(warning) - write(warning,*) 'Final value =', x2 - call add_warning(warning) - write(warning,*) 'Difference =', x2 - x1 - call add_warning(warning) - endif - - end subroutine column_conservation_check - -!======================================================================= - -! Cleanup subroutine that rebins thickness categories if necessary, -! eliminates very small ice areas while conserving mass and energy, -! aggregates state variables, and does a boundary call. -! It is a good idea to call this subroutine after the thermodynamics -! (thermo_vertical/thermo_itd) and again after the dynamics -! (evp/transport/ridging). -! -! author: William H. Lipscomb, LANL - - subroutine cleanup_itd (dt, Tf, & - ntrcr, & - nilyr, nslyr, & - ncat, hin_max, & - aicen, trcrn, & - vicen, vsnon, & - aice0, aice, & - n_aero, & - nbtrcr, nblyr, & - l_stop, stop_label, & - tr_aero, & - tr_pond_topo, & - heat_capacity, & - first_ice, & - trcr_depend, trcr_base, & - n_trcr_strata,nt_strata, & - fpond, fresh, & - fsalt, fhocn, & - faero_ocn, fzsal, & - flux_bio, limit_aice_in) - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nblyr , & ! number of bio layers - nslyr , & ! number of snow layers - ntrcr , & ! number of tracers in use - nbtrcr, & ! number of bio tracers in use - n_aero ! number of aerosol tracers - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - Tf ! ocean freezing temperature (Celsius) - - real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & - hin_max ! category boundaries (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(inout) :: & - aice , & ! total ice concentration - aice0 ! concentration of open water - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - logical (kind=log_kind), intent(in) :: & - tr_aero, & ! aerosol flag - tr_pond_topo, & ! topo pond flag - heat_capacity ! if false, ice and snow have zero heat capacity - - logical (kind=log_kind), dimension(ncat),intent(inout) :: & - first_ice ! For bgc and S tracers. set to true if zapping ice. - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - character (char_len), intent(out) :: stop_label - - ! ice-ocean fluxes (required for strict conservation) - - real (kind=dbl_kind), intent(inout), optional :: & - fpond , & ! fresh water flux to ponds (kg/m^2/s) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fsalt , & ! salt flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fzsal ! net salt flux to ocean from zsalinity (kg/m^2/s) - - real (kind=dbl_kind), dimension (:), intent(inout), optional :: & - flux_bio ! net tracer flux to ocean from biology (mmol/m^2/s) - - real (kind=dbl_kind), dimension (:), & - intent(inout), optional :: & - faero_ocn ! aerosol flux to ocean (kg/m^2/s) - - logical (kind=log_kind), intent(in), optional :: & - limit_aice_in ! if false, allow aice to be out of bounds - ! may want to allow this for unit tests - - ! local variables - - integer (kind=int_kind) :: & - n , & ! category index - it ! tracer index - - real (kind=dbl_kind) & - dfpond , & ! zapped pond water flux (kg/m^2/s) - dfresh , & ! zapped fresh water flux (kg/m^2/s) - dfsalt , & ! zapped salt flux (kg/m^2/s) - dfhocn , & ! zapped energy flux ( W/m^2) - dfzsal ! zapped salt flux for zsalinity (kg/m^2/s) - - real (kind=dbl_kind), dimension (n_aero) :: & - dfaero_ocn ! zapped aerosol flux (kg/m^2/s) - - real (kind=dbl_kind), dimension (ntrcr) :: & - dflux_bio ! zapped biology flux (mmol/m^2/s) - - logical (kind=log_kind) :: & - limit_aice ! if true, check for aice out of bounds - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - if (present(limit_aice_in)) then - limit_aice = limit_aice_in - else - limit_aice = .true. - endif - - l_stop = .false. - - dfpond = c0 - dfresh = c0 - dfsalt = c0 - dfhocn = c0 - dfaero_ocn(:) = c0 - dflux_bio(:) = c0 - dfzsal = c0 - - !----------------------------------------------------------------- - ! Compute total ice area. - !----------------------------------------------------------------- - - call aggregate_area (ncat, aicen, aice, aice0) - - if (limit_aice) then ! check for aice out of bounds - if (aice > c1+puny .or. aice < -puny) then - l_stop = .true. - stop_label = 'aggregate ice area out of bounds' - write(warning,*) 'aice:', aice - call add_warning(warning) - do n = 1, ncat - write(warning,*) 'n, aicen:', n, aicen(n) - call add_warning(warning) - enddo - return - endif - endif ! limit_aice - - !----------------------------------------------------------------- - ! Identify grid cells with ice. - !----------------------------------------------------------------- - - if (aice > puny) then - - !----------------------------------------------------------------- - ! Make sure ice in each category is within its thickness bounds. - ! NOTE: The rebin subroutine is needed only in the rare cases - ! when the linear_itd subroutine cannot transfer ice - ! correctly (e.g., very fast ice growth). - !----------------------------------------------------------------- - - call rebin (ntrcr, trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen, trcrn, & - vicen, vsnon, & - ncat, hin_max, & - l_stop, stop_label) - - endif ! aice > puny - - !----------------------------------------------------------------- - ! Zero out ice categories with very small areas. - !----------------------------------------------------------------- - - if (limit_aice) then - call zap_small_areas (dt, Tf, & - ntrcr, & - ncat, n_aero, & - nblyr, & - nilyr, nslyr, & - aice, aice0, & - aicen, trcrn, & - vicen, vsnon, & - dfpond, & - dfresh, dfsalt, & - dfhocn, dfaero_ocn, & - tr_aero, tr_pond_topo, & - first_ice, nbtrcr, & - dfzsal, dflux_bio, & - l_stop, stop_label) - - if (l_stop) then - write(warning,*) 'aice:', aice - call add_warning(warning) - do n = 1, ncat - write(warning,*) 'n, aicen:', n, aicen(n) - call add_warning(warning) - enddo - return - endif - - endif ! l_limit_aice - - !------------------------------------------------------------------- - ! Zap snow that has out of bounds temperatures - !------------------------------------------------------------------- - - call zap_snow_temperature(dt, ncat, & - heat_capacity, nblyr, & - nslyr, aicen, & - trcrn, vsnon, & - dfresh, dfhocn, & - dfaero_ocn, tr_aero, & - dflux_bio, nbtrcr, & - n_aero, ntrcr) - - !------------------------------------------------------------------- - ! Update ice-ocean fluxes for strict conservation - !------------------------------------------------------------------- - - if (present(fpond)) & - fpond = fpond + dfpond - if (present(fresh)) & - fresh = fresh + dfresh - if (present(fsalt)) & - fsalt = fsalt + dfsalt - if (present(fhocn)) & - fhocn = fhocn + dfhocn - if (present(faero_ocn)) then - do it = 1, n_aero - faero_ocn(it) = faero_ocn(it) + dfaero_ocn(it) - enddo - endif - if (present(flux_bio)) then - do it = 1, nbtrcr - flux_bio (it) = flux_bio(it) + dflux_bio(it) - enddo - endif - if (present(fzsal)) & - fzsal = fzsal + dfzsal - - !---------------------------------------------------------------- - ! If using zero-layer model (no heat capacity), check that the - ! energy of snow and ice is correct. - !---------------------------------------------------------------- - - if ((.not. heat_capacity) .and. aice > puny) then - call zerolayer_check (ncat, nilyr, & - nslyr, aicen, & - vicen, vsnon, & - trcrn, l_stop, & - stop_label) - endif - - end subroutine cleanup_itd - -!======================================================================= - -! For each ice category in each grid cell, remove ice if the fractional -! area is less than puny. -! -! author: William H. Lipscomb, LANL - - subroutine zap_small_areas (dt, Tf, & - ntrcr, & - ncat, n_aero, & - nblyr, & - nilyr, nslyr, & - aice, aice0, & - aicen, trcrn, & - vicen, vsnon, & - dfpond, & - dfresh, dfsalt, & - dfhocn, dfaero_ocn, & - tr_aero, tr_pond_topo, & - first_ice, nbtrcr, & - dfzsal, dflux_bio, & - l_stop, stop_label) - - use ice_colpkg_tracers, only: nt_Tsfc, nt_qice, nt_qsno, nt_aero, & - nt_apnd, nt_hpnd, nt_fbri, tr_brine, nt_bgc_S, & - bio_index, nt_rhos, nt_rsnw, nt_smice, tr_rsnw, tr_snow - use ice_colpkg_shared, only: solve_zsal, skl_bgc, z_tracers, min_salin, & - rhosi, rhosnew, rsnw_fall - use ice_constants_colpkg, only: sk_l - use ice_zbgc_shared, only: zap_small_bgc - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nblyr , & ! number of bio layers - nslyr , & ! number of snow layers - ntrcr , & ! number of tracers in use - n_aero , & ! number of aerosol tracers - nbtrcr ! number of biology tracers - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - Tf ! ocean freezing temperature (Celsius) - - real (kind=dbl_kind), intent(inout) :: & - aice , & ! total ice concentration - aice0 ! concentration of open water - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(out) :: & - dfpond , & ! zapped pond water flux (kg/m^2/s) - dfresh , & ! zapped fresh water flux (kg/m^2/s) - dfsalt , & ! zapped salt flux (kg/m^2/s) - dfhocn , & ! zapped energy flux ( W/m^2) - dfzsal ! zapped salt flux from zsalinity(kg/m^2/s) - - real (kind=dbl_kind), dimension (:), intent(out) :: & - dfaero_ocn ! zapped aerosol flux (kg/m^2/s) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - dflux_bio ! zapped bio tracer flux from biology (mmol/m^2/s) - - logical (kind=log_kind), intent(in) :: & - tr_aero, & ! aerosol flag - tr_pond_topo ! pond flag - - logical (kind=log_kind), dimension (:),intent(inout) :: & - first_ice ! For bgc tracers. Set to true if zapping ice - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - character (char_len), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - n, k, it, & !counting indices - blevels - - real (kind=dbl_kind) :: xtmp ! temporary variables - real (kind=dbl_kind) , dimension (1):: trcr_skl - real (kind=dbl_kind) , dimension (nblyr+1):: bvol - - l_stop = .false. - - !----------------------------------------------------------------- - ! I. Zap categories with very small areas. - !----------------------------------------------------------------- - dfzsal = c0 - - do n = 1, ncat - - !----------------------------------------------------------------- - ! Count categories to be zapped. - !----------------------------------------------------------------- - - if (aicen(n) < -puny) then - l_stop = .true. - stop_label = 'Zap ice: negative ice area' - return - elseif (abs(aicen(n)) /= c0 .and. & - abs(aicen(n)) <= puny) then - - !----------------------------------------------------------------- - ! Account for tracers important for conservation - !----------------------------------------------------------------- - - if (tr_pond_topo) then - xtmp = aicen(n) & - * trcrn(nt_apnd,n) * trcrn(nt_hpnd,n) - dfpond = dfpond - xtmp - endif - - if (tr_aero) then - do it = 1, n_aero - xtmp = (vicen(n)*(trcrn(nt_aero+2+4*(it-1),n) & - + trcrn(nt_aero+3+4*(it-1),n)))/dt - dfaero_ocn(it) = dfaero_ocn(it) + xtmp - enddo - endif - - if (solve_zsal) then - do it = 1, nblyr - xtmp = rhosi*trcrn(nt_fbri,n)*vicen(n)*p001& - *trcrn(nt_bgc_S+it-1,n)/ & - real(nblyr,kind=dbl_kind)/dt - dfzsal = dfzsal + xtmp - enddo ! n - endif - - if (skl_bgc .and. nbtrcr > 0) then - blevels = 1 - bvol(1) = aicen(n)*sk_l - it = 1 - do it = 1, nbtrcr - trcr_skl(1) = trcrn(bio_index(it),n) - call zap_small_bgc(blevels, dflux_bio(it), & - dt, bvol(1:blevels), trcr_skl(blevels)) - enddo - elseif (z_tracers .and. nbtrcr > 0) then - blevels = nblyr + 1 - bvol(:) = vicen(n)/real(nblyr,kind=dbl_kind)*trcrn(nt_fbri,n) - bvol(1) = p5*bvol(1) - bvol(blevels) = p5*bvol(blevels) - do it = 1, nbtrcr - call zap_small_bgc(blevels, dflux_bio(it), & - dt, bvol(1:blevels),trcrn(bio_index(it):bio_index(it)+blevels-1,n)) - enddo - endif - - !----------------------------------------------------------------- - ! Zap ice energy and use ocean heat to melt ice - !----------------------------------------------------------------- - - do k = 1, nilyr - xtmp = trcrn(nt_qice+k-1,n) / dt & - * vicen(n)/real(nilyr,kind=dbl_kind) ! < 0 - dfhocn = dfhocn + xtmp - trcrn(nt_qice+k-1,n) = c0 - enddo ! k - - !----------------------------------------------------------------- - ! Zap ice and snow volume, add water and salt to ocean - !----------------------------------------------------------------- - - xtmp = (rhoi*vicen(n)) / dt - dfresh = dfresh + xtmp - - xtmp = rhoi*vicen(n)*ice_ref_salinity*p001 / dt - dfsalt = dfsalt + xtmp - - aice0 = aice0 + aicen(n) - aicen(n) = c0 - vicen(n) = c0 - trcrn(nt_Tsfc,n) = Tf - - !----------------------------------------------------------------- - ! Zap snow - !----------------------------------------------------------------- - call zap_snow(dt, nslyr, & - trcrn(:,n), vsnon(n), & - dfresh, dfhocn, & - dfaero_ocn, tr_aero, & - dflux_bio, nbtrcr, & - n_aero, ntrcr, & - aicen(n), nblyr) - - !----------------------------------------------------------------- - ! Zap tracers - !----------------------------------------------------------------- - - if (ntrcr >= 2) then - do it = 2, ntrcr - if (tr_brine .and. it == nt_fbri) then - trcrn(it,n) = c1 - else - trcrn(it,n) = c0 - endif - enddo - endif - if (tr_snow) then - do k = 1, nslyr - trcrn(nt_rhos +k-1,n) = rhosnew - enddo - endif - if (tr_rsnw) then - do k = 1, nslyr - trcrn(nt_smice+k-1,n) = rhos - trcrn(nt_rsnw +k-1,n) = rsnw_fall - enddo - endif - first_ice(n) = .true. - - endif ! aicen - enddo ! n - - !----------------------------------------------------------------- - ! II. Count cells with excess ice (aice > c1) due to roundoff errors. - ! Zap a little ice in each category so that aice = c1. - !----------------------------------------------------------------- - - if (aice > (c1+puny)) then - l_stop = .true. - stop_label = 'Zap ice: excess ice area' - return - elseif (aice > c1 .and. aice < (c1+puny)) then - - do n = 1, ncat - - !----------------------------------------------------------------- - ! Account for tracers important for conservation - !----------------------------------------------------------------- - - if (tr_pond_topo) then - xtmp = aicen(n) & - * trcrn(nt_apnd,n) * trcrn(nt_hpnd,n) & - * (aice-c1)/aice - dfpond = dfpond - xtmp - endif - - if (tr_aero) then - do it = 1, n_aero - xtmp = (vsnon(n)*(trcrn(nt_aero +4*(it-1),n) & - + trcrn(nt_aero+1+4*(it-1),n)) & - + vicen(n)*(trcrn(nt_aero+2+4*(it-1),n) & - + trcrn(nt_aero+3+4*(it-1),n))) & - * (aice-c1)/aice / dt - dfaero_ocn(it) = dfaero_ocn(it) + xtmp - enddo ! it - endif - - !----------------------------------------------------------------- - ! Zap ice energy and use ocean heat to melt ice - !----------------------------------------------------------------- - - do k = 1, nilyr - xtmp = trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) & - * (aice-c1)/aice / dt ! < 0 - dfhocn = dfhocn + xtmp - enddo ! k - - !----------------------------------------------------------------- - ! Zap snow energy and use ocean heat to melt snow - !----------------------------------------------------------------- - - do k = 1, nslyr - xtmp = trcrn(nt_qsno+k-1,n) & - * vsnon(n)/real(nslyr,kind=dbl_kind) & - * (aice-c1)/aice / dt ! < 0 - dfhocn = dfhocn + xtmp - enddo ! k - - !----------------------------------------------------------------- - ! Zap ice and snow volume, add water and salt to ocean - !----------------------------------------------------------------- - - xtmp = (rhoi*vicen(n) + rhos*vsnon(n)) & - * (aice-c1)/aice / dt - dfresh = dfresh + xtmp - - xtmp = rhoi*vicen(n)*ice_ref_salinity*p001 & - * (aice-c1)/aice / dt - dfsalt = dfsalt + xtmp - - if (solve_zsal) then - do k = 1,nblyr - xtmp = rhosi*trcrn(nt_fbri,n)*vicen(n)*p001& - /real(nblyr,kind=dbl_kind)*trcrn(nt_bgc_S+k-1,n) & - * (aice-c1)/aice /dt - dfzsal = dfzsal + xtmp - enddo - - if (vicen(n) > vicen(n)*trcrn(nt_fbri,n)) then - xtmp = (vicen(n)-vicen(n)*trcrn(nt_fbri,n))*(aice-c1)/& - aice*p001*rhosi*min_salin/dt - dfzsal = dfzsal + xtmp - endif - endif ! solve_zsal - - aicen(n) = aicen(n) * (c1/aice) - vicen(n) = vicen(n) * (c1/aice) - vsnon(n) = vsnon(n) * (c1/aice) - - ! Note: Tracers are unchanged. - - enddo ! n - - !----------------------------------------------------------------- - ! Correct aice - !----------------------------------------------------------------- - - aice = c1 - aice0 = c0 - - endif ! aice - - end subroutine zap_small_areas - -!======================================================================= - - subroutine zap_snow(dt, nslyr, & - trcrn, vsnon, & - dfresh, dfhocn, & - dfaero_ocn, tr_aero, & - dflux_bio, nbtrcr, & - n_aero, ntrcr, & - aicen, nblyr) - - use ice_colpkg_tracers, only: nt_qsno, nt_aero, bio_index - use ice_colpkg_shared, only: hs_ssl, z_tracers - - integer (kind=int_kind), intent(in) :: & - nslyr , & ! number of snow layers - n_aero , & ! number of aerosol tracers - ntrcr , & ! number of tracers in use - nblyr , & ! number of bio layers - nbtrcr - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(in) :: & - aicen ! ice area fraction - - real (kind=dbl_kind), intent(inout) :: & - vsnon , & ! volume per unit area of snow (m) - dfresh , & ! zapped fresh water flux (kg/m^2/s) - dfhocn ! zapped energy flux ( W/m^2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - dfaero_ocn ! zapped aerosol flux (kg/m^2/s) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - dflux_bio ! zapped bio tracer flux from biology (mmol/m^2/s) - - logical (kind=log_kind), intent(in) :: & - tr_aero ! aerosol flag - - ! local variables - - integer (kind=int_kind) :: & - k, it ! counting indices - - real (kind=dbl_kind) :: xtmp, dvssl, dvint - - ! aerosols - if (tr_aero) then - do it = 1, n_aero - xtmp = (vsnon*(trcrn(nt_aero +4*(it-1)) & - + trcrn(nt_aero+1+4*(it-1))))/dt - dfaero_ocn(it) = dfaero_ocn(it) + xtmp - enddo ! it - endif ! tr_aero - - if (z_tracers) then - dvssl = min(p5*vsnon/real(nslyr,kind=dbl_kind), hs_ssl*aicen) !snow surface layer - dvint = vsnon- dvssl !snow interior - - do it = 1, nbtrcr - xtmp = (trcrn(bio_index(it)+nblyr+1)*dvssl + & - trcrn(bio_index(it)+nblyr+2)*dvint)/dt - dflux_bio(it) = dflux_bio(it) + xtmp - enddo ! it - - endif ! z_tracers - - ! snow enthalpy tracer - do k = 1, nslyr - xtmp = trcrn(nt_qsno+k-1) / dt & - * vsnon/real(nslyr,kind=dbl_kind) ! < 0 - dfhocn = dfhocn + xtmp - trcrn(nt_qsno+k-1) = c0 - enddo ! k - - ! snow volume - xtmp = (rhos*vsnon) / dt - dfresh = dfresh + xtmp - vsnon = c0 - - end subroutine zap_snow - -!======================================================================= - - subroutine zap_snow_temperature(dt, ncat, & - heat_capacity, & - nblyr, & - nslyr, aicen, & - trcrn, vsnon, & - dfresh, dfhocn, & - dfaero_ocn, tr_aero, & - dflux_bio, nbtrcr, & - n_aero, ntrcr) - - use ice_colpkg_tracers, only: nt_qsno - use ice_therm_shared, only: Tmin - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nslyr , & ! number of snow layers - n_aero, & ! number of aerosol tracers - nbtrcr, & ! number of z-tracers in use - nblyr , & ! number of bio layers in ice - ntrcr ! number of tracers in use - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - logical (kind=log_kind), intent(in) :: & - heat_capacity ! if false, ice and snow have zero heat capacity - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen ! concentration of ice - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(inout) :: & - dfresh , & ! zapped fresh water flux (kg/m^2/s) - dfhocn ! zapped energy flux ( W/m^2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - dfaero_ocn ! zapped aerosol flux (kg/m^2/s) - - real (kind=dbl_kind), dimension (:),intent(inout) :: & - dflux_bio ! zapped biology flux (mmol/m^2/s) - - logical (kind=log_kind), intent(in) :: & - tr_aero ! aerosol flag - - ! local variables - - integer (kind=int_kind) :: & - n, k, it ! counting indices - - real (kind=dbl_kind) :: & - rnslyr , & ! real(nslyr) - hsn , & ! snow thickness (m) - zqsn , & ! snow layer enthalpy (J m-2) - zTsn , & ! snow layer temperature (C) - Tmax ! maximum allowed snow temperature - - logical :: & - l_zap ! logical whether zap snow - - character(len=char_len_long) :: & - warning ! warning message - - rnslyr = real(nslyr,kind=dbl_kind) - - do n = 1, ncat - - !----------------------------------------------------------------- - ! Determine cells to zap - !----------------------------------------------------------------- - - l_zap = .false. - - if (aicen(n) > puny) then - - ! snow thickness - hsn = vsnon(n) / aicen(n) - - ! check each snow layer - zap all if one is bad - do k = 1, nslyr - - ! snow enthalpy and max temperature - if (hsn > hs_min .and. heat_capacity) then - ! zqsn < 0 - zqsn = trcrn(nt_qsno+k-1,n) - Tmax = -zqsn*puny*rnslyr / (rhos*cp_ice*vsnon(n)) - else - zqsn = -rhos * Lfresh - Tmax = puny - endif - - ! snow temperature - zTsn = (Lfresh + zqsn/rhos)/cp_ice - - ! check for zapping - if (zTsn < Tmin .or. zTsn > Tmax) then - l_zap = .true. - write(warning,*) "zap_snow_temperature: temperature out of bounds!" - call add_warning(warning) - write(warning,*) "k:" , k - call add_warning(warning) - write(warning,*) "zTsn:", zTsn - call add_warning(warning) - write(warning,*) "Tmin:", Tmin - call add_warning(warning) - write(warning,*) "Tmax:", Tmax - call add_warning(warning) - write(warning,*) "zqsn:", zqsn - call add_warning(warning) - endif - - enddo ! k - - endif ! aicen > puny - - !----------------------------------------------------------------- - ! Zap the cells - !----------------------------------------------------------------- - if (l_zap) & - call zap_snow(dt, nslyr, & - trcrn(:,n), vsnon(n), & - dfresh, dfhocn, & - dfaero_ocn, tr_aero, & - dflux_bio, nbtrcr, & - n_aero, ntrcr, & - aicen(n), nblyr) - - enddo ! n - - end subroutine zap_snow_temperature - -!======================================================================= -! Checks that the snow and ice energy in the zero layer thermodynamics -! model still agrees with the snow and ice volume. -! If there is an error, the model will abort. -! This subroutine is only called if heat_capacity = .false. -! -! author: Alison McLaren, Met Office -! May 2010: ECH replaced eicen, esnon with trcrn but did not test -! the changes. The loop below runs over n=1,ncat and I added loops -! over k, making the test more stringent. - - subroutine zerolayer_check (ncat, nilyr, & - nslyr, aicen, & - vicen, vsnon, & - trcrn, l_stop, & - stop_label) - - use ice_colpkg_tracers, only: nt_qice, nt_qsno - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - character (char_len), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k , & ! vertical index - n ! category index - - real (kind=dbl_kind), parameter :: & - max_error = puny*Lfresh*rhos ! max error in zero layer energy check - ! (so max volume error = puny) - - real (kind=dbl_kind), dimension (ncat) :: & - eicen ! energy of melting for each ice layer (J/m^2) - - real (kind=dbl_kind), dimension (ncat) :: & - esnon ! energy of melting for each snow layer (J/m^2) - - logical (kind=log_kind) :: & - ice_energy_correct , & ! zero layer ice energy check - snow_energy_correct ! zero layer snow energy check - - real (kind=dbl_kind) :: & - worka, workb - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - !---------------------------------------------------------------- - ! Calculate difference between ice and snow energies and the - ! energy values derived from the ice and snow volumes - !---------------------------------------------------------------- - - ice_energy_correct = .true. - snow_energy_correct = .true. - - worka = c0 - workb = c0 - - do n = 1, ncat - - eicen(n) = c0 - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n) / real(nilyr,kind=dbl_kind) - enddo - worka = eicen(n) + rhoi * Lfresh * vicen(n) - esnon(n) = c0 - do k = 1, nslyr - esnon(n) = esnon(n) + trcrn(nt_qsno+k-1,n) & - * vsnon(n) / real(nslyr,kind=dbl_kind) - enddo - workb = esnon(n) + rhos * Lfresh * vsnon(n) - - if(abs(worka) > max_error) ice_energy_correct = .false. - if(abs(workb) > max_error) snow_energy_correct = .false. - - !---------------------------------------------------------------- - ! If there is a problem, abort with error message - !---------------------------------------------------------------- - - if (.not. ice_energy_correct) then - - if (abs(worka) > max_error) then - l_stop = .true. - stop_label = 'zerolayer check - wrong ice energy' - write(warning,*) stop_label - call add_warning(warning) - write(warning,*) 'n:', n - call add_warning(warning) - write(warning,*) 'eicen =', eicen(n) - call add_warning(warning) - write(warning,*) 'error=', worka - call add_warning(warning) - write(warning,*) 'vicen =', vicen(n) - call add_warning(warning) - write(warning,*) 'aicen =', aicen(n) - call add_warning(warning) - endif - - endif - if (l_stop) return - - if (.not. snow_energy_correct) then - - if (abs(workb) > max_error) then - l_stop = .true. - stop_label = 'zerolayer check - wrong snow energy' - write(warning,*) stop_label - call add_warning(warning) - write(warning,*) 'n:', n - call add_warning(warning) - write(warning,*) 'esnon =', esnon(n) - call add_warning(warning) - write(warning,*) 'error=', workb - call add_warning(warning) - write(warning,*) 'vsnon =', vsnon(n) - call add_warning(warning) - write(warning,*) 'aicen =', aicen(n) - call add_warning(warning) - return - endif - - endif - - enddo ! ncat - - end subroutine zerolayer_check - -!======================================================================= - - end module ice_itd - -!======================================================================= - - - - - - - - - diff --git a/components/mpas-seaice/src/column/ice_kinds_mod.F90 b/components/mpas-seaice/src/column/ice_kinds_mod.F90 deleted file mode 100644 index 4b12177c7848..000000000000 --- a/components/mpas-seaice/src/column/ice_kinds_mod.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! SVN:$Id: ice_kinds_mod.F90 1012 2015-06-26 12:34:09Z eclare $ -!======================================================================= - -! Defines variable precision for all common data types -! Code originally based on kinds_mod.F in POP -! -! author: Elizabeth C. Hunke and William H. Lipscomb, LANL -! 2006: ECH converted to free source form (F90) - - module ice_kinds_mod - -!======================================================================= - - implicit none - public - save - - integer, parameter :: char_len = 80, & - char_len_long = 256, & - log_kind = kind(.true.), & - int_kind = selected_int_kind(6), & - real_kind = selected_real_kind(6), & - dbl_kind = selected_real_kind(13), & - r16_kind = selected_real_kind(26) - -!======================================================================= - - end module ice_kinds_mod - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_mechred.F90 b/components/mpas-seaice/src/column/ice_mechred.F90 deleted file mode 100644 index 2754cd1c2ab5..000000000000 --- a/components/mpas-seaice/src/column/ice_mechred.F90 +++ /dev/null @@ -1,1547 +0,0 @@ -! SVN:$Id: ice_mechred.F90 1182 2017-03-16 19:29:26Z njeffery $ -!======================================================================= - -! Driver for ice mechanical redistribution (ridging) -! -! See these references: -! -! Flato, G. M., and W. D. Hibler III, 1995: Ridging and strength -! in modeling the thickness distribution of Arctic sea ice, -! J. Geophys. Res., 100, 18,611-18,626. -! -! Hibler, W. D. III, 1980: Modeling a variable thickness sea ice -! cover, Mon. Wea. Rev., 108, 1943-1973, 1980. -! -! Lipscomb, W. H., E. C. Hunke, W. Maslowski, and J. Jakacki, 2007: -! Improving ridging schemes for high-resolution sea ice models. -! J. Geophys. Res. 112, C03S91, doi:10.1029/2005JC003355. -! -! Rothrock, D. A., 1975: The energetics of the plastic deformation of -! pack ice by ridging, J. Geophys. Res., 80, 4514-4519. -! -! Thorndike, A. S., D. A. Rothrock, G. A. Maykut, and R. Colony, -! 1975: The thickness distribution of sea ice, J. Geophys. Res., -! 80, 4501-4513. -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL -! -! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb -! 2004: Block structure added by William Lipscomb -! 2006: New options for participation and redistribution (WHL) -! 2006: Streamlined for efficiency by Elizabeth Hunke -! Converted to free source form (F90) - - module ice_mechred - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, c10, c20, c25, & - p05, p15, p25, p333, p5, & - puny, Lfresh, rhoi, rhos, rhow, gravit - use ice_itd, only: column_sum, & - column_conservation_check - use ice_warnings, only: add_warning - - implicit none - save - - private - public :: ridge_ice, asum_ridging, ridge_itd - - real (kind=dbl_kind), parameter :: & - Cs = p25 , & ! fraction of shear energy contrbtng to ridging - fsnowrdg = p5 , & ! snow fraction that survives in ridging - Gstar = p15 , & ! max value of G(h) that participates - ! (krdg_partic = 0) - astar = p05 , & ! e-folding scale for G(h) participation -!echmod astar = p1 , & ! e-folding scale for G(h) participation - ! (krdg_partic = 1) - maxraft= c1 , & ! max value of hrmin - hi = max thickness - ! of ice that rafts (m) - Hstar = c25 ! determines mean thickness of ridged ice (m) - ! (krdg_redist = 0) - ! Flato & Hibler (1995) have Hstar = 100 - - logical (kind=log_kind), parameter :: & - l_conservation_check = .false. ! if true, check conservation - ! (useful for debugging) - -!======================================================================= - - contains - -!======================================================================= - -! Compute changes in the ice thickness distribution due to divergence -! and shear. -! -! author: William H. Lipscomb, LANL - - subroutine ridge_ice (dt, ndtd, & - ncat, n_aero, & - nilyr, nslyr, & - ntrcr, hin_max, & - rdg_conv, rdg_shear, & - aicen, trcrn, & - vicen, vsnon, & - aice0, & - trcr_depend, trcr_base, & - n_trcr_strata, & - nt_strata, l_stop, & - stop_label, & - krdg_partic, krdg_redist,& - mu_rdg, & - dardg1dt, dardg2dt, & - dvirdgdt, opening, & - fpond, & - fresh, fhocn, & - tr_brine, faero_ocn, & - aparticn, krdgn, & - aredistn, vredistn, & - dardg1ndt, dardg2ndt, & - dvirdgndt, & - araftn, vraftn, & - Tf) - - use ice_colpkg_tracers, only: nt_qice, nt_qsno, nt_fbri, nt_sice - - integer (kind=int_kind), intent(in) :: & - ndtd , & ! number of dynamics subcycles - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero, & ! number of aerosol tracers - ntrcr ! number of tracers in use - - real (kind=dbl_kind), intent(in) :: & - mu_rdg , & ! gives e-folding scale of ridged ice (m^.5) - dt , & ! time step - Tf ! ocean freezing temperature (C) - - real (kind=dbl_kind), dimension(0:ncat), intent(inout) :: & - hin_max ! category limits (m) - - real (kind=dbl_kind), intent(in) :: & - rdg_conv , & ! normalized energy dissipation due to convergence (1/s) - rdg_shear ! normalized energy dissipation due to shear (1/s) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(inout) :: & - aice0 ! concentration of open water - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - character (len=*), intent(out) :: & - stop_label ! diagnostic information for abort - - integer (kind=int_kind), intent(in) :: & - krdg_partic , & ! selects participation function - krdg_redist ! selects redistribution function - - logical (kind=log_kind), intent(in) :: & - tr_brine ! if .true., brine height differs from ice thickness - - ! optional history fields - real (kind=dbl_kind), intent(inout), optional :: & - dardg1dt , & ! rate of fractional area loss by ridging ice (1/s) - dardg2dt , & ! rate of fractional area gain by new ridges (1/s) - dvirdgdt , & ! rate of ice volume ridged (m/s) - opening , & ! rate of opening due to divergence/shear (1/s) - fpond , & ! fresh water flux to ponds (kg/m^2/s) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fhocn ! net heat flux to ocean (W/m^2) - - real (kind=dbl_kind), dimension(:), intent(inout), optional :: & - dardg1ndt , & ! rate of fractional area loss by ridging ice (1/s) - dardg2ndt , & ! rate of fractional area gain by new ridges (1/s) - dvirdgndt , & ! rate of ice volume ridged (m/s) - aparticn , & ! participation function - krdgn , & ! mean ridge thickness/thickness of ridging ice - araftn , & ! rafting ice area - vraftn , & ! rafting ice volume - aredistn , & ! redistribution function: fraction of new ridge area - vredistn ! redistribution function: fraction of new ridge volume - - real (kind=dbl_kind), dimension(:), intent(inout), optional :: & - faero_ocn ! aerosol flux to ocean (kg/m^2/s) - - ! local variables - - real (kind=dbl_kind), dimension (ncat) :: & - eicen ! energy of melting for each ice layer (J/m^2) - - real (kind=dbl_kind), dimension (ncat) :: & - esnon, & ! energy of melting for each snow layer (J/m^2) - vbrin, & ! ice volume with defined by brine height (m) - sicen ! Bulk salt in h ice (ppt*m) - - real (kind=dbl_kind) :: & - asum , & ! sum of ice and open water area - aksum , & ! ratio of area removed to area ridged - msnow_mlt , & ! mass of snow added to ocean (kg m-2) - esnow_mlt , & ! energy needed to melt snow in ocean (J m-2) - mpond , & ! mass of pond added to ocean (kg m-2) - closing_net, & ! net rate at which area is removed (1/s) - ! (ridging ice area - area of new ridges) / dt - divu_adv , & ! divu as implied by transport scheme (1/s) - opning , & ! rate of opening due to divergence/shear - ! opning is a local variable; - ! opening is the history diagnostic variable - ardg1 , & ! fractional area loss by ridging ice - ardg2 , & ! fractional area gain by new ridges - virdg , & ! ice volume ridged - aopen ! area opening due to divergence/shear - - real (kind=dbl_kind), dimension (n_aero) :: & - maero ! aerosol mass added to ocean (kg m-2) - - real (kind=dbl_kind), dimension (0:ncat) :: & - apartic ! participation function; fraction of ridging - ! and closing associated w/ category n - - real (kind=dbl_kind), dimension (ncat) :: & - hrmin , & ! minimum ridge thickness - hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) - krdg , & ! mean ridge thickness/thickness of ridging ice - ardg1n , & ! area of ice ridged - ardg2n , & ! area of new ridges - virdgn , & ! ridging ice volume - mraftn ! rafting ice mask - - real (kind=dbl_kind) :: & - vice_init, vice_final, & ! ice volume summed over categories - vsno_init, vsno_final, & ! snow volume summed over categories - eice_init, eice_final, & ! ice energy summed over layers - vbri_init, vbri_final, & ! ice volume in fbri*vicen summed over categories - sice_init ,sice_final, & ! ice bulk salinity summed over categories - esno_init, esno_final ! snow energy summed over layers - - integer (kind=int_kind), parameter :: & - nitermax = 20 ! max number of ridging iterations - - integer (kind=int_kind) :: & - n , & ! thickness category index - niter , & ! iteration counter - k , & ! vertical index - it ! tracer index - - real (kind=dbl_kind) :: & - dti ! 1 / dt - - logical (kind=log_kind) :: & - iterate_ridging ! if true, repeat the ridging - - character (len=char_len) :: & - fieldid ! field identifier - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - msnow_mlt = c0 - esnow_mlt = c0 - maero (:) = c0 - mpond = c0 - ardg1 = c0 - ardg2 = c0 - virdg = c0 - ardg1n(:) = c0 - ardg2n(:) = c0 - virdgn(:) = c0 - mraftn(:) = c0 - aopen = c0 - - !----------------------------------------------------------------- - ! Compute area of ice plus open water before ridging. - !----------------------------------------------------------------- - - call asum_ridging (ncat, aicen, aice0, asum) - - !----------------------------------------------------------------- - ! Compute the area opening and closing. - !----------------------------------------------------------------- - - call ridge_prep (dt, & - ncat, hin_max, & - rdg_conv, rdg_shear, & - asum, closing_net, & - divu_adv, opning) - - !----------------------------------------------------------------- - ! Compute initial values of conserved quantities. - !----------------------------------------------------------------- - - if (l_conservation_check) then - - do n = 1, ncat - eicen(n) = c0 - esnon(n) = c0 - sicen(n) = c0 - vbrin(n) = c0 - - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - sicen(n) = sicen(n) + trcrn(nt_sice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - do k = 1, nslyr - esnon(n) = esnon(n) + trcrn(nt_qsno+k-1,n) & - * vsnon(n)/real(nslyr,kind=dbl_kind) - enddo - vbrin(n) = vicen(n) - if (tr_brine) vbrin(n) = trcrn(nt_fbri,n) * vicen(n) - enddo ! n - - call column_sum (ncat, & - vicen, vice_init) - call column_sum (ncat, & - vsnon, vsno_init) - call column_sum (ncat, & - eicen, eice_init) - call column_sum (ncat, & - esnon, esno_init) - call column_sum (ncat, & - sicen, sice_init) - call column_sum (ncat, & - vbrin, vbri_init) - - endif - - rdg_iteration: do niter = 1, nitermax - - !----------------------------------------------------------------- - ! Compute the thickness distribution of ridging ice - ! and various quantities associated with the new ridged ice. - !----------------------------------------------------------------- - - call ridge_itd (ncat, aice0, & - aicen, vicen, & - krdg_partic, krdg_redist, & - mu_rdg, & - aksum, apartic, & - hrmin, hrmax, & - hrexp, krdg, & - aparticn, krdgn, & - mraftn) - - !----------------------------------------------------------------- - ! Redistribute area, volume, and energy. - !----------------------------------------------------------------- - - call ridge_shift (ntrcr, dt, & - ncat, hin_max, & - aicen, trcrn, & - vicen, vsnon, & - aice0, trcr_depend, & - trcr_base, n_trcr_strata,& - nt_strata, krdg_redist, & - aksum, apartic, & - hrmin, hrmax, & - hrexp, krdg, & - closing_net, opning, & - ardg1, ardg2, & - virdg, aopen, & - ardg1n, ardg2n, & - virdgn, & - nslyr, n_aero, & - msnow_mlt, esnow_mlt, & - maero, mpond, & - l_stop, stop_label, & - aredistn, vredistn, & - Tf) - - if (l_stop) return - - !----------------------------------------------------------------- - ! Make sure the new area = 1. If not (because the closing - ! and opening rates were reduced above), prepare to ridge again - ! with new rates. - !----------------------------------------------------------------- - - call asum_ridging (ncat, aicen, aice0, asum) - - if (abs(asum - c1) < puny) then - iterate_ridging = .false. - closing_net = c0 - opning = c0 - else - iterate_ridging = .true. - divu_adv = (c1 - asum) / dt - closing_net = max(c0, -divu_adv) - opning = max(c0, divu_adv) - endif - - !----------------------------------------------------------------- - ! If done, exit. If not, prepare to ridge again. - !----------------------------------------------------------------- - - if (iterate_ridging) then - write(warning,*) 'Repeat ridging, niter =', niter - call add_warning(warning) - else - exit rdg_iteration - endif - - if (niter == nitermax) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Exceeded max number of ridging iterations' - call add_warning(warning) - write(warning,*) 'max =',nitermax - call add_warning(warning) - l_stop = .true. - stop_label = "ridge_ice: Exceeded max number of ridging iterations" - return - endif - - enddo rdg_iteration ! niter - - !----------------------------------------------------------------- - ! Compute final values of conserved quantities. - ! Check for conservation (allowing for snow thrown into ocean). - !----------------------------------------------------------------- - - if (l_conservation_check) then - - do n = 1, ncat - eicen(n) = c0 - esnon(n) = c0 - sicen(n) = c0 - vbrin(n) = c0 - - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - sicen(n) = sicen(n) + trcrn(nt_sice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - do k = 1, nslyr - esnon(n) = esnon(n) + trcrn(nt_qsno+k-1,n) & - * vsnon(n)/real(nslyr,kind=dbl_kind) - enddo - vbrin(n) = vicen(n) - if (tr_brine) vbrin(n) = trcrn(nt_fbri,n) * vbrin(n) - enddo ! n - - call column_sum (ncat, & - vicen, vice_final) - call column_sum (ncat, & - vsnon, vsno_final) - call column_sum (ncat, & - eicen, eice_final) - call column_sum (ncat, & - esnon, esno_final) - call column_sum (ncat, & - sicen, sice_final) - call column_sum (ncat, & - vbrin, vbri_final) - - vsno_final = vsno_final + msnow_mlt/rhos - esno_final = esno_final + esnow_mlt - - fieldid = 'vice, ridging' - call column_conservation_check (fieldid, & - vice_init, vice_final, & - puny, & - l_stop) - fieldid = 'vsno, ridging' - call column_conservation_check (fieldid, & - vsno_init, vsno_final, & - puny, & - l_stop) - fieldid = 'eice, ridging' - call column_conservation_check (fieldid, & - eice_init, eice_final, & - puny*Lfresh*rhoi, & - l_stop) - fieldid = 'esno, ridging' - call column_conservation_check (fieldid, & - esno_init, esno_final, & - puny*Lfresh*rhos, & - l_stop) - fieldid = 'sice, ridging' - call column_conservation_check (fieldid, & - sice_init, sice_final, & - puny, & - l_stop) - fieldid = 'vbrin, ridging' - call column_conservation_check (fieldid, & - vbri_init, vbri_final, & - puny*c10, & - l_stop) - if (l_stop) then - stop_label = 'ridge_ice: Column conservation error' - return - endif - - endif ! l_conservation_check - - !----------------------------------------------------------------- - ! Compute ridging diagnostics. - !----------------------------------------------------------------- - - dti = c1/dt - - if (present(dardg1dt)) then - dardg1dt = ardg1*dti - endif - if (present(dardg2dt)) then - dardg2dt = ardg2*dti - endif - if (present(dvirdgdt)) then - dvirdgdt = virdg*dti - endif - if (present(opening)) then - opening = aopen*dti - endif - if (present(dardg1ndt)) then - do n = 1, ncat - dardg1ndt(n) = ardg1n(n)*dti - enddo - endif - if (present(dardg2ndt)) then - do n = 1, ncat - dardg2ndt(n) = ardg2n(n)*dti - enddo - endif - if (present(dvirdgndt)) then - do n = 1, ncat - dvirdgndt(n) = virdgn(n)*dti - enddo - endif - if (present(araftn)) then - do n = 1, ncat - araftn(n) = mraftn(n)*ardg2n(n) -! araftn(n) = mraftn(n)*ardg1n(n)*p5 - enddo - endif - if (present(vraftn)) then - do n = 1, ncat - vraftn(n) = mraftn(n)*virdgn(n) - enddo - endif - - !----------------------------------------------------------------- - ! Update fresh water and heat fluxes due to snow melt. - !----------------------------------------------------------------- - - ! use thermodynamic time step (ndtd*dt here) to average properly - dti = c1/(ndtd*dt) - - if (present(fresh)) then - fresh = fresh + msnow_mlt*dti - endif - if (present(fhocn)) then - fhocn = fhocn + esnow_mlt*dti - endif - if (present(faero_ocn)) then - do it = 1, n_aero - faero_ocn(it) = faero_ocn(it) + maero(it)*dti - enddo - endif - if (present(fpond)) then - fpond = fpond - mpond ! units change later - endif - - !----------------------------------------------------------------- - ! Check for fractional ice area > 1. - !----------------------------------------------------------------- - - if (abs(asum - c1) > puny) then - l_stop = .true. - stop_label = "ridge_ice: total area > 1" - - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Ridging error: total area > 1' - call add_warning(warning) - write(warning,*) 'area:', asum - call add_warning(warning) - write(warning,*) 'n, aicen:' - call add_warning(warning) - write(warning,*) 0, aice0 - call add_warning(warning) - do n = 1, ncat - write(warning,*) n, aicen(n) - call add_warning(warning) - enddo - return - endif - - end subroutine ridge_ice - -!======================================================================= - -! Find the total area of ice plus open water in each grid cell. -! -! This is similar to the aggregate_area subroutine except that the -! total area can be greater than 1, so the open water area is -! included in the sum instead of being computed as a residual. -! -! author: William H. Lipscomb, LANL - - subroutine asum_ridging (ncat, aicen, aice0, asum) - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen ! concentration of ice in each category - - real (kind=dbl_kind), intent(in) :: & - aice0 ! concentration of open water - - real (kind=dbl_kind), intent(out):: & - asum ! sum of ice and open water area - - ! local variables - - integer (kind=int_kind) :: n - - asum = aice0 - do n = 1, ncat - asum = asum + aicen(n) - enddo - - end subroutine asum_ridging - -!======================================================================= - -! Initialize arrays, compute area of closing and opening -! -! author: William H. Lipscomb, LANL - - subroutine ridge_prep (dt, & - ncat, hin_max, & - rdg_conv, rdg_shear, & - asum, closing_net, & - divu_adv, opning) - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), dimension(0:ncat), intent(inout) :: & - hin_max ! category limits (m) - - real (kind=dbl_kind), intent(in) :: & - rdg_conv , & ! normalized energy dissipation due to convergence (1/s) - rdg_shear ! normalized energy dissipation due to shear (1/s) - - real (kind=dbl_kind), intent(inout):: & - asum ! sum of ice and open water area - - real (kind=dbl_kind), & - intent(out):: & - closing_net, & ! net rate at which area is removed (1/s) - divu_adv , & ! divu as implied by transport scheme (1/s) - opning ! rate of opening due to divergence/shear - - ! local variables - - real (kind=dbl_kind), parameter :: & - big = 1.0e+8_dbl_kind - - ! Set hin_max(ncat) to a big value to ensure that all ridged ice - ! is thinner than hin_max(ncat). - hin_max(ncat) = big - - !----------------------------------------------------------------- - ! Compute the net rate of closing due to convergence - ! and shear, based on Flato and Hibler (1995). - ! - ! For the elliptical yield curve: - ! rdg_conv = -min (divu, 0) - ! rdg_shear = (1/2) * (Delta - abs(divu)) - ! Note that the shear term also accounts for divergence. - ! - ! The energy dissipation rate is equal to the net closing rate - ! times the ice strength. - ! - ! NOTE: The NET closing rate is equal to the rate that open water - ! area is removed, plus the rate at which ice area is removed by - ! ridging, minus the rate at which area is added in new ridges. - ! The GROSS closing rate is equal to the first two terms (open - ! water closing and thin ice ridging) without the third term - ! (thick, newly ridged ice). - ! - ! rdg_conv is calculated differently in EAP (update_ice_rdg) and - ! represents closing_net directly. In that case, rdg_shear=0. - !----------------------------------------------------------------- - - closing_net = Cs*rdg_shear + rdg_conv - - !----------------------------------------------------------------- - ! Compute divu_adv, the divergence rate given by the transport/ - ! advection scheme, which may not be equal to divu as computed - ! from the velocity field. - ! - ! If divu_adv < 0, make sure the closing rate is large enough - ! to give asum = 1.0 after ridging. - !----------------------------------------------------------------- - - divu_adv = (c1-asum) / dt - - if (divu_adv < c0) closing_net = max(closing_net, -divu_adv) - - !----------------------------------------------------------------- - ! Compute the (non-negative) opening rate that will give - ! asum = 1.0 after ridging. - !----------------------------------------------------------------- - - opning = closing_net + divu_adv - - end subroutine ridge_prep - -!======================================================================= - -! Compute the thickness distribution of the ice and open water -! participating in ridging and of the resulting ridges. -! -! This version includes new options for ridging participation and -! redistribution. -! The new participation scheme (krdg_partic = 1) improves stability -! by increasing the time scale for large changes in ice strength. -! The new exponential redistribution function (krdg_redist = 1) improves -! agreement between ITDs of modeled and observed ridges. -! -! author: William H. Lipscomb, LANL -! -! 2006: Changed subroutine name to ridge_itd -! Added new options for ridging participation and redistribution. - - subroutine ridge_itd (ncat, aice0, & - aicen, vicen, & - krdg_partic, krdg_redist, & - mu_rdg, & - aksum, apartic, & - hrmin, hrmax, & - hrexp, krdg, & - aparticn, krdgn, & - mraft) - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), intent(in) :: & - mu_rdg , & ! gives e-folding scale of ridged ice (m^.5) - aice0 ! concentration of open water - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen , & ! concentration of ice - vicen ! volume per unit area of ice (m) - - integer (kind=int_kind), intent(in) :: & - krdg_partic , & ! selects participation function - krdg_redist ! selects redistribution function - - real (kind=dbl_kind), intent(out):: & - aksum ! ratio of area removed to area ridged - - real (kind=dbl_kind), dimension (0:ncat), intent(out) :: & - apartic ! participation function; fraction of ridging - ! and closing associated w/ category n - - real (kind=dbl_kind), dimension (:), intent(out) :: & - hrmin , & ! minimum ridge thickness - hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) - krdg ! mean ridge thickness/thickness of ridging ice - - ! diagnostic, category values - real (kind=dbl_kind), dimension(:), intent(out), optional :: & - aparticn, & ! participation function - krdgn ! mean ridge thickness/thickness of ridging ice - - real (kind=dbl_kind), dimension (:), intent(out), optional :: & - mraft ! rafting ice mask - - ! local variables - - integer (kind=int_kind) :: & - n ! thickness category index - - real (kind=dbl_kind), parameter :: & - Gstari = c1/Gstar, & - astari = c1/astar - - real (kind=dbl_kind), dimension(-1:ncat) :: & - Gsum ! Gsum(n) = sum of areas in categories 0 to n - - real (kind=dbl_kind) :: & - work ! temporary work array - - real (kind=dbl_kind) :: & - hi , & ! ice thickness for each cat (m) - hrmean , & ! mean ridge thickness (m) - xtmp ! temporary variable - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - Gsum (-1) = c0 ! by definition -! Gsum (0) = c1 ! to avoid divzero below - - if (aice0 > puny) then - Gsum(0) = aice0 - else - Gsum(0) = Gsum(-1) - endif - apartic(0) = c0 - - do n = 1, ncat - Gsum (n) = c1 ! to avoid divzero below - apartic(n) = c0 - hrmin (n) = c0 - hrmax (n) = c0 - hrexp (n) = c0 - krdg (n) = c1 - - !----------------------------------------------------------------- - ! Compute the thickness distribution of ice participating in ridging. - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! First compute the cumulative thickness distribution function Gsum, - ! where Gsum(n) is the fractional area in categories 0 to n. - ! Ignore categories with very small areas. - !----------------------------------------------------------------- - - if (aicen(n) > puny) then - Gsum(n) = Gsum(n-1) + aicen(n) - else - Gsum(n) = Gsum(n-1) - endif - enddo - - ! normalize - - work = c1 / Gsum(ncat) - do n = 0, ncat - Gsum(n) = Gsum(n) * work - enddo - - !----------------------------------------------------------------- - ! Compute the participation function apartic; this is analogous to - ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). - ! - ! area lost from category n due to ridging/closing - ! apartic(n) = -------------------------------------------------- - ! total area lost due to ridging/closing - ! - !----------------------------------------------------------------- - - if (krdg_partic == 0) then ! Thornike et al. 1975 formulation - - !----------------------------------------------------------------- - ! Assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). - ! The expressions for apartic are found by integrating b(h)g(h) between - ! the category boundaries. - !----------------------------------------------------------------- - - do n = 0, ncat - if (Gsum(n) < Gstar) then - apartic(n) = Gstari*(Gsum(n ) - Gsum(n-1)) * & - (c2 - Gstari*(Gsum(n-1) + Gsum(n ))) - elseif (Gsum(n-1) < Gstar) then - apartic(n) = Gstari*(Gstar - Gsum(n-1)) * & - (c2 - Gstari*(Gstar + Gsum(n-1))) - endif - enddo ! n - - elseif (krdg_partic==1) then ! exponential dependence on G(h) - - !----------------------------------------------------------------- - ! b(h) = exp(-G(h)/astar) - ! apartic(n) = [exp(-G(n-1)/astar - exp(-G(n)/astar] / [1-exp(-1/astar)]. - ! The expression for apartic is found by integrating b(h)g(h) - ! between the category boundaries. - !----------------------------------------------------------------- - - ! precompute exponential terms using Gsum as work array - xtmp = c1 / (c1 - exp(-astari)) - Gsum(-1) = exp(-Gsum(-1)*astari) * xtmp - do n = 0, ncat - Gsum(n) = exp(-Gsum(n)*astari) * xtmp - apartic(n) = Gsum(n-1) - Gsum(n) - enddo ! n - - endif ! krdg_partic - - !----------------------------------------------------------------- - ! Compute variables related to ITD of ridged ice: - ! - ! krdg = mean ridge thickness / thickness of ridging ice - ! hrmin = min ridge thickness - ! hrmax = max ridge thickness (krdg_redist = 0) - ! hrexp = ridge e-folding scale (krdg_redist = 1) - !---------------------------------------------------------------- - - if (krdg_redist == 0) then ! Hibler 1980 formulation - - !----------------------------------------------------------------- - ! Assume ridged ice is uniformly distributed between hrmin and hrmax. - ! - ! This parameterization is a modified version of Hibler (1980). - ! In the original paper the min ridging thickness is hrmin = 2*hi, - ! and the max thickness is hrmax = 2*sqrt(hi*Hstar). - ! - ! Here the min thickness is hrmin = min(2*hi, hi+maxraft), - ! so thick ridging ice is not required to raft. - ! - !----------------------------------------------------------------- - - do n = 1, ncat - if (aicen(n) > puny) then - hi = vicen(n) / aicen(n) - hrmin(n) = min(c2*hi, hi + maxraft) - hrmax(n) = c2*sqrt(Hstar*hi) - hrmax(n) = max(hrmax(n), hrmin(n)+puny) - hrmean = p5 * (hrmin(n) + hrmax(n)) - krdg(n) = hrmean / hi - - ! diagnostic rafting mask not implemented - endif - enddo ! n - - else ! krdg_redist = 1; exponential redistribution - - !----------------------------------------------------------------- - ! The ridge ITD is a negative exponential: - ! - ! g(h) ~ exp[-(h-hrmin)/hrexp], h >= hrmin - ! - ! where hrmin is the minimum thickness of ridging ice and - ! hrexp is the e-folding thickness. - ! - ! Here, assume as above that hrmin = min(2*hi, hi+maxraft). - ! That is, the minimum ridge thickness results from rafting, - ! unless the ice is thicker than maxraft. - ! - ! Also, assume that hrexp = mu_rdg*sqrt(hi). - ! The parameter mu_rdg is tuned to give e-folding scales mostly - ! in the range 2-4 m as observed by upward-looking sonar. - ! - ! Values of mu_rdg in the right column give ice strengths - ! roughly equal to values of Hstar in the left column - ! (within ~10 kN/m for typical ITDs): - ! - ! Hstar mu_rdg - ! - ! 25 3.0 - ! 50 4.0 - ! 75 5.0 - ! 100 6.0 - !----------------------------------------------------------------- - - do n = 1, ncat - if (aicen(n) > puny) then - hi = vicen(n) / aicen(n) - hi = max(hi,puny) - hrmin(n) = min(c2*hi, hi + maxraft) - hrexp(n) = mu_rdg * sqrt(hi) - krdg(n) = (hrmin(n) + hrexp(n)) / hi - - !echmod: check computational efficiency - ! diagnostic rafting mask - if (present(mraft)) then - mraft(n) = max(c0, sign(c1, hi+maxraft-hrmin(n))) - xtmp = mraft(n)*((c2*hi+hrexp(n))/hi - krdg(n)) - mraft(n) = max(c0, sign(c1, puny-abs(xtmp))) - endif - endif - enddo - - endif ! krdg_redist - - !---------------------------------------------------------------- - ! Compute aksum = net ice area removed / total area participating. - ! For instance, if a unit area of ice with h = 1 participates in - ! ridging to form a ridge with a = 1/3 and h = 3, then - ! aksum = 1 - 1/3 = 2/3. - !---------------------------------------------------------------- - - aksum = apartic(0) ! area participating = area removed - - do n = 1, ncat - ! area participating > area removed - aksum = aksum + apartic(n) * (c1 - c1/krdg(n)) - enddo - - ! diagnostics - if (present(aparticn)) then - do n = 1, ncat - aparticn(n) = apartic(n) - enddo - endif - if (present(krdgn)) then - do n = 1, ncat - krdgn(n) = krdg(n) - enddo - endif - - end subroutine ridge_itd - -!======================================================================= - -! Remove area, volume, and energy from each ridging category -! and add to thicker ice categories. -! -! Tracers: Ridging conserves ice volume and therefore conserves volume -! tracers. It does not conserve ice area, and therefore a portion of area -! tracers are lost (corresponding to the net closing). Area tracers on -! ice that participates in ridging are carried onto the resulting ridged -! ice (except the portion that are lost due to closing). Therefore, -! tracers must be decremented if they are lost to the ocean during ridging -! (e.g. snow, ponds) or if they are being carried only on the level ice -! area. -! -! author: William H. Lipscomb, LANL - - subroutine ridge_shift (ntrcr, dt, & - ncat, hin_max, & - aicen, trcrn, & - vicen, vsnon, & - aice0, trcr_depend, & - trcr_base, n_trcr_strata, & - nt_strata, krdg_redist, & - aksum, apartic, & - hrmin, hrmax, & - hrexp, krdg, & - closing_net, opning, & - ardg1, ardg2, & - virdg, aopen, & - ardg1nn, ardg2nn, & - virdgnn, & - nslyr, n_aero, & - msnow_mlt, esnow_mlt, & - maero, mpond, & - l_stop, stop_label, & - aredistn, vredistn, & - Tf) - - use ice_colpkg_tracers, only: nt_qsno, nt_fbri, & - nt_alvl, nt_vlvl, nt_aero, tr_aero, & - nt_apnd, nt_hpnd, tr_pond_topo, & - colpkg_compute_tracers - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nslyr , & ! number of snow layers - ntrcr , & ! number of tracers in use - n_aero, & ! number of aerosol tracers - krdg_redist ! selects redistribution function - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step (s) - Tf ! ocean freezing temperature (C) - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & - hin_max ! category limits (m) - - real (kind=dbl_kind), intent(inout) :: & - aice0 ! concentration of open water - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(in) :: & - aksum ! ratio of area removed to area ridged - - real (kind=dbl_kind), dimension (0:ncat), intent(in) :: & - apartic ! participation function; fraction of ridging - ! and closing associated w/ category n - - real (kind=dbl_kind), dimension (:), intent(in) :: & - hrmin , & ! minimum ridge thickness - hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) - krdg ! mean ridge thickness/thickness of ridging ice - - real (kind=dbl_kind), intent(inout) :: & - closing_net, & ! net rate at which area is removed (1/s) - opning , & ! rate of opening due to divergence/shear (1/s) - ardg1 , & ! fractional area loss by ridging ice - ardg2 , & ! fractional area gain by new ridges - virdg , & ! ice volume ridged (m) - aopen ! area opened due to divergence/shear - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - ardg1nn , & ! area of ice ridged - ardg2nn , & ! area of new ridges - virdgnn ! ridging ice volume - - real (kind=dbl_kind), intent(inout) :: & - msnow_mlt , & ! mass of snow added to ocean (kg m-2) - esnow_mlt , & ! energy needed to melt snow in ocean (J m-2) - mpond ! mass of pond added to ocean (kg m-2) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - maero ! aerosol mass added to ocean (kg m-2) - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort on return - - character (len=*), intent(out) :: & - stop_label ! diagnostic information for abort - - real (kind=dbl_kind), dimension (:), intent(inout), optional :: & - aredistn , & ! redistribution function: fraction of new ridge area - vredistn ! redistribution function: fraction of new ridge volume - - ! local variables - - integer (kind=int_kind) :: & - n, nr , & ! thickness category indices - k , & ! ice layer index - it , & ! tracer index - ntr , & ! tracer index - itl ! loop index - - real (kind=dbl_kind), dimension (ncat) :: & - aicen_init , & ! ice area before ridging - vicen_init , & ! ice volume before ridging - vsnon_init ! snow volume before ridging - - real (kind=dbl_kind), dimension(ntrcr,ncat) :: & - atrcrn ! aicen*trcrn - - real (kind=dbl_kind), dimension(3) :: & - trfactor ! base quantity on which tracers are carried - - real (kind=dbl_kind) :: & - work , & ! temporary variable - closing_gross ! rate at which area removed, not counting - ! area of new ridges - -! ECH note: the following arrays only need be defined on iridge cells - real (kind=dbl_kind) :: & - afrac , & ! fraction of category area ridged - ardg1n , & ! area of ice ridged - ardg2n , & ! area of new ridges - virdgn , & ! ridging ice volume - vsrdgn , & ! ridging snow volume - dhr , & ! hrmax - hrmin - dhr2 , & ! hrmax^2 - hrmin^2 - farea , & ! fraction of new ridge area going to nr - fvol ! fraction of new ridge volume going to nr - - real (kind=dbl_kind) :: & - esrdgn ! ridging snow energy - - real (kind=dbl_kind) :: & - hi1 , & ! thickness of ridging ice - hexp , & ! ridge e-folding thickness - hL, hR , & ! left and right limits of integration - expL, expR , & ! exponentials involving hL, hR - tmpfac , & ! factor by which opening/closing rates are cut - wk1 ! work variable - - character(len=char_len_long) :: & - warning ! warning message - - do n = 1, ncat - - !----------------------------------------------------------------- - ! Save initial state variables - !----------------------------------------------------------------- - - aicen_init(n) = aicen(n) - vicen_init(n) = vicen(n) - vsnon_init(n) = vsnon(n) - - !----------------------------------------------------------------- - ! Define variables equal to aicen*trcrn, vicen*trcrn, vsnon*trcrn - !----------------------------------------------------------------- - - do it = 1, ntrcr - atrcrn(it,n) = trcrn(it,n)*(trcr_base(it,1) * aicen(n) & - + trcr_base(it,2) * vicen(n) & - + trcr_base(it,3) * vsnon(n)) - if (n_trcr_strata(it) > 0) then ! additional tracer layers - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - atrcrn(it,n) = atrcrn(it,n) * trcrn(ntr,n) - enddo - endif - enddo - - enddo ! ncat - - !----------------------------------------------------------------- - ! Based on the ITD of ridging and ridged ice, convert the net - ! closing rate to a gross closing rate. - ! NOTE: 0 < aksum <= 1 - !----------------------------------------------------------------- - - closing_gross = closing_net / aksum - - !----------------------------------------------------------------- - ! Reduce the closing rate if more than 100% of the open water - ! would be removed. Reduce the opening rate proportionately. - !----------------------------------------------------------------- - - if (apartic(0) > c0) then - wk1 = apartic(0) * closing_gross * dt - if (wk1 > aice0) then - tmpfac = aice0 / wk1 - closing_gross = closing_gross * tmpfac - opning = opning * tmpfac - endif - endif - - !----------------------------------------------------------------- - ! Reduce the closing rate if more than 100% of any ice category - ! would be removed. Reduce the opening rate proportionately. - !----------------------------------------------------------------- - do n = 1, ncat - if (aicen(n) > puny .and. apartic(n) > c0) then - wk1 = apartic(n) * closing_gross * dt - if (wk1 > aicen(n)) then - tmpfac = aicen(n) / wk1 - closing_gross = closing_gross * tmpfac - opning = opning * tmpfac - endif - endif - enddo ! n - - !----------------------------------------------------------------- - ! Compute change in open water area due to closing and opening. - !----------------------------------------------------------------- - - aice0 = aice0 - apartic(0)*closing_gross*dt + opning*dt - - if (aice0 < -puny) then - l_stop = .true. - stop_label = 'Ridging error: aice0 < 0' - write(warning,*) stop_label - call add_warning(warning) - write(warning,*) 'aice0:', aice0 - call add_warning(warning) - return - - elseif (aice0 < c0) then ! roundoff error - aice0 = c0 - endif - - aopen = opning*dt ! optional diagnostic - - !----------------------------------------------------------------- - ! Compute the area, volume, and energy of ice ridging in each - ! category, along with the area of the resulting ridge. - !----------------------------------------------------------------- - - do n = 1, ncat - - !----------------------------------------------------------------- - ! Identify grid cells with nonzero ridging - !----------------------------------------------------------------- - - if (aicen_init(n) > puny .and. apartic(n) > c0 & - .and. closing_gross > c0) then - - !----------------------------------------------------------------- - ! Compute area of ridging ice (ardg1n) and of new ridge (ardg2n). - ! Make sure ridging fraction <=1. (Roundoff errors can give - ! ardg1 slightly greater than aicen.) - !----------------------------------------------------------------- - - ardg1n = apartic(n)*closing_gross*dt - - if (ardg1n > aicen_init(n) + puny) then - l_stop = .true. - stop_label = 'Ridging error: ardg > aicen' - write(warning,*) stop_label - call add_warning(warning) - write(warning,*) 'n, ardg, aicen:', & - n, ardg1n, aicen_init(n) - call add_warning(warning) - return - else - ardg1n = min(aicen_init(n), ardg1n) - endif - - ardg2n = ardg1n / krdg(n) - afrac = ardg1n / aicen_init(n) - - !----------------------------------------------------------------- - ! Subtract area, volume, and energy from ridging category n. - ! Note: Tracer values are unchanged. - !----------------------------------------------------------------- - - virdgn = vicen_init(n) * afrac - vsrdgn = vsnon_init(n) * afrac - - aicen(n) = aicen(n) - ardg1n - vicen(n) = vicen(n) - virdgn - vsnon(n) = vsnon(n) - vsrdgn - - !----------------------------------------------------------------- - ! Increment ridging diagnostics - !----------------------------------------------------------------- - - ardg1 = ardg1 + ardg1n - ardg2 = ardg2 + ardg2n - virdg = virdg + virdgn - - ardg1nn(n) = ardg1n - ardg2nn(n) = ardg2n - virdgnn(n) = virdgn - - !----------------------------------------------------------------- - ! Place part of the snow and tracer lost by ridging into the ocean. - !----------------------------------------------------------------- - - msnow_mlt = msnow_mlt + rhos*vsrdgn*(c1-fsnowrdg) - - if (tr_aero) then - do it = 1, n_aero - maero(it) = maero(it) & - + vsrdgn*(c1-fsnowrdg) & - *(trcrn(nt_aero +4*(it-1),n) & - + trcrn(nt_aero+1+4*(it-1),n)) - enddo - endif - - if (tr_pond_topo) then - mpond = mpond + ardg1n * trcrn(nt_apnd,n) & - * trcrn(nt_hpnd,n) - endif - - !----------------------------------------------------------------- - ! Compute quantities used to apportion ice among categories - ! in the nr loop below - !----------------------------------------------------------------- - - dhr = hrmax(n) - hrmin(n) - dhr2 = hrmax(n) * hrmax(n) - hrmin(n) * hrmin(n) - - !----------------------------------------------------------------- - ! Increment energy needed to melt snow in ocean. - ! Note that esnow_mlt < 0; the ocean must cool to melt snow. - !----------------------------------------------------------------- - - do k = 1, nslyr - esrdgn = vsrdgn * trcrn(nt_qsno+k-1,n) & - / real(nslyr,kind=dbl_kind) - esnow_mlt = esnow_mlt + esrdgn*(c1-fsnowrdg) - enddo - - !----------------------------------------------------------------- - ! Subtract area- and volume-weighted tracers from category n. - !----------------------------------------------------------------- - - do it = 1, ntrcr - - trfactor(1) = trcr_base(it,1)*ardg1n - trfactor(2) = trcr_base(it,2)*virdgn - trfactor(3) = trcr_base(it,3)*vsrdgn - - work = c0 - do k = 1, 3 - work = work + trfactor(k)*trcrn(it,n) - enddo - if (n_trcr_strata(it) > 0) then ! additional tracer layers - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - work = work * trcrn(ntr,n) - enddo - endif - atrcrn(it,n) = atrcrn(it,n) - work - - enddo ! ntrcr - - !----------------------------------------------------------------- - ! Add area, volume, and energy of new ridge to each category nr. - !----------------------------------------------------------------- - - do nr = 1, ncat - - if (krdg_redist == 0) then ! Hibler 1980 formulation - - !----------------------------------------------------------------- - ! Compute the fraction of ridged ice area and volume going to - ! thickness category nr. - !----------------------------------------------------------------- - - if (hrmin(n) >= hin_max(nr) .or. & - hrmax(n) <= hin_max(nr-1)) then - hL = c0 - hR = c0 - else - hL = max (hrmin(n), hin_max(nr-1)) - hR = min (hrmax(n), hin_max(nr)) - endif - - farea = (hR-hL) / dhr - fvol = (hR*hR - hL*hL) / dhr2 - - else ! krdg_redist = 1; 2005 exponential formulation - - !----------------------------------------------------------------- - ! Compute the fraction of ridged ice area and volume going to - ! thickness category nr. - !----------------------------------------------------------------- - - if (nr < ncat) then - - hi1 = hrmin(n) - hexp = hrexp(n) - - if (hi1 >= hin_max(nr)) then - farea = c0 - fvol = c0 - else - hL = max (hi1, hin_max(nr-1)) - hR = hin_max(nr) - expL = exp(-(hL-hi1)/hexp) - expR = exp(-(hR-hi1)/hexp) - farea = expL - expR - fvol = ((hL + hexp)*expL & - - (hR + hexp)*expR) / (hi1 + hexp) - endif - - else ! nr = ncat - - hi1 = hrmin(n) - hexp = hrexp(n) - - hL = max (hi1, hin_max(nr-1)) - expL = exp(-(hL-hi1)/hexp) - farea = expL - fvol = (hL + hexp)*expL / (hi1 + hexp) - - endif ! nr < ncat - - ! diagnostics - if (n ==1) then ! only for thinnest ridging ice - if (present(aredistn)) then - aredistn(nr) = farea*ardg2n - endif - if (present(vredistn)) then - vredistn(nr) = fvol*virdgn - endif - endif - - endif ! krdg_redist - - !----------------------------------------------------------------- - ! Transfer ice area, ice volume, and snow volume to category nr. - !----------------------------------------------------------------- - - aicen(nr) = aicen(nr) + farea*ardg2n - vicen(nr) = vicen(nr) + fvol *virdgn - vsnon(nr) = vsnon(nr) + fvol *vsrdgn*fsnowrdg - - !----------------------------------------------------------------- - ! Transfer area-weighted and volume-weighted tracers to category nr. - ! Note: The global sum aicen*trcrn of ice area tracers - ! (trcr_depend = 0) is not conserved by ridging. - ! However, ridging conserves the global sum of volume - ! tracers (trcr_depend = 1 or 2). - ! Tracers associated with level ice, or that are otherwise lost - ! from ridging ice, are not transferred. - ! We assume that all pond water is lost from ridging ice. - !----------------------------------------------------------------- - - do it = 1, ntrcr - - if (it /= nt_alvl .and. it /= nt_vlvl) then - trfactor(1) = trcr_base(it,1)*ardg2n*farea - trfactor(2) = trcr_base(it,2)*virdgn*fvol - trfactor(3) = trcr_base(it,3)*vsrdgn*fvol*fsnowrdg - else - trfactor(1) = c0 - trfactor(2) = c0 - trfactor(3) = c0 - endif - - work = c0 - do k = 1, 3 - work = work + trfactor(k)*trcrn(it,n) - enddo - if (n_trcr_strata(it) > 0) then ! additional tracer layers - do itl = 1, n_trcr_strata(it) - ntr = nt_strata(it,itl) - if (ntr == nt_fbri) then ! brine fraction only - work = work * trcrn(ntr,n) - else - work = c0 - endif - enddo - endif - atrcrn(it,nr) = atrcrn(it,nr) + work - - enddo ! ntrcr - - enddo ! nr (new ridges) - - endif ! nonzero ridging - - enddo ! n (ridging categories) - - !----------------------------------------------------------------- - ! Compute new tracers - !----------------------------------------------------------------- - - do n = 1, ncat - call colpkg_compute_tracers (ntrcr, trcr_depend, & - atrcrn(:,n), aicen(n), & - vicen(n), vsnon(n), & - trcr_base, n_trcr_strata, & - nt_strata, trcrn(:,n), & - Tf) - enddo - - end subroutine ridge_shift - -!======================================================================= - - end module ice_mechred - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_meltpond_cesm.F90 b/components/mpas-seaice/src/column/ice_meltpond_cesm.F90 deleted file mode 100644 index 47d926d11310..000000000000 --- a/components/mpas-seaice/src/column/ice_meltpond_cesm.F90 +++ /dev/null @@ -1,160 +0,0 @@ -! SVN:$Id: ice_meltpond_cesm.F90 1012 2015-06-26 12:34:09Z eclare $ -!======================================================================= - -! CESM meltpond parameterization -! -! This meltpond parameterization was developed for use with the delta- -! Eddington radiation scheme, and only affects the radiation budget in -! the model. That is, although the pond volume is tracked, that liquid -! water is not used elsewhere in the model for mass budgets or other -! physical processes. -! -! authors David A. Bailey (NCAR) -! Marika M. Holland (NCAR) -! Elizabeth C. Hunke (LANL) - - module ice_meltpond_cesm - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, p01, puny, & - rhofresh, rhoi, rhos, Timelt - - implicit none - - private - public :: compute_ponds_cesm - -!======================================================================= - - contains - -!======================================================================= - - subroutine compute_ponds_cesm(dt, hi_min, & - pndaspect, & - rfrac, meltt, & - melts, frain, & - aicen, vicen, vsnon, & - Tsfcn, apnd, hpnd, & - meltsliqn, use_smliq_pnd) - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step (s) - hi_min, & ! minimum ice thickness allowed for thermo (m) - pndaspect ! ratio of pond depth to pond fraction - - real (kind=dbl_kind), intent(in) :: & - meltsliqn, & ! liquid input from snow liquid tracer - rfrac, & ! water fraction retained for melt ponds - meltt, & - melts, & - frain, & - aicen, & - vicen, & - vsnon - - real (kind=dbl_kind), intent(in) :: & - Tsfcn - - real (kind=dbl_kind), intent(inout) :: & - apnd, & - hpnd - - logical (kind=log_kind), intent(in) :: & - use_smliq_pnd ! use snow liquid and ice tracers - -! local temporary variables - - real (kind=dbl_kind) :: & - volpn - - real (kind=dbl_kind) :: & - hi , & ! ice thickness (m) - hs , & ! snow depth (m) - dTs , & ! surface temperature diff for freeze-up (C) - Tp , & ! pond freezing temperature (C) - apondn, & - hpondn - - real (kind=dbl_kind), parameter :: & - Td = c2 , & ! temperature difference for freeze-up (C) - rexp = p01 , & ! pond contraction scaling - dpthhi = 0.9_dbl_kind ! ratio of pond depth to ice thickness - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - volpn = hpnd * apnd * aicen - - !----------------------------------------------------------------- - ! Identify grid cells where ice can melt - !----------------------------------------------------------------- - - if (aicen > puny) then - - hi = vicen/aicen - hs = vsnon/aicen - - if (hi < hi_min) then - - !-------------------------------------------------------------- - ! Remove ponds on thin ice - !-------------------------------------------------------------- - apondn = c0 - hpondn = c0 - volpn = c0 - - else - - !----------------------------------------------------------- - ! Update pond volume - !----------------------------------------------------------- - if (use_smliq_pnd) then - volpn = volpn & - + rfrac/rhofresh*(meltt*rhoi & - + meltsliqn) & - * aicen - else - volpn = volpn & - + rfrac/rhofresh*(meltt*rhoi & - + melts*rhos & - + frain* dt)& - * aicen - endif - - !----------------------------------------------------------- - ! Shrink pond volume under freezing conditions - !----------------------------------------------------------- - Tp = Timelt - Td - dTs = max(Tp - Tsfcn,c0) - volpn = volpn * exp(rexp*dTs/Tp) - volpn = max(volpn, c0) - - ! fraction of ice covered by ponds - apondn = min (sqrt(volpn/(pndaspect*aicen)), c1) - hpondn = pndaspect * apondn - ! fraction of grid cell covered by ponds - apondn = apondn * aicen - - !----------------------------------------------------------- - ! Limit pond depth - !----------------------------------------------------------- - hpondn = min(hpondn, dpthhi*hi) - - endif - - !----------------------------------------------------------- - ! Reload tracer array - !----------------------------------------------------------- - apnd = apondn / aicen - hpnd = hpondn - - endif - - end subroutine compute_ponds_cesm - -!======================================================================= - - end module ice_meltpond_cesm - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_meltpond_lvl.F90 b/components/mpas-seaice/src/column/ice_meltpond_lvl.F90 deleted file mode 100644 index ada156d6be8a..000000000000 --- a/components/mpas-seaice/src/column/ice_meltpond_lvl.F90 +++ /dev/null @@ -1,346 +0,0 @@ -! SVN:$Id: ice_meltpond_lvl.F90 1112 2016-03-24 22:49:56Z eclare $ -!======================================================================= - -! Level-ice meltpond parameterization -! -! This meltpond parameterization was developed for use with the delta- -! Eddington radiation scheme, and only affects the radiation budget in -! the model. That is, although the pond volume is tracked, that liquid -! water is not used elsewhere in the model for mass budgets or other -! physical processes. -! -! authors Elizabeth Hunke (LANL) -! David Hebert (NRL Stennis) -! Olivier Lecomte (Univ. Louvain) - - module ice_meltpond_lvl - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, c10, p01, p5, puny, & - viscosity_dyn, rhoi, rhos, rhow, Timelt, Tffresh, Lfresh, & - gravit, depressT, rhofresh, kice - - implicit none - - private - public :: compute_ponds_lvl - -!======================================================================= - - contains - -!======================================================================= - - subroutine compute_ponds_lvl(dt, nilyr, & - ktherm, & - hi_min, dpscale, & - frzpnd, pndaspect, & - rfrac, meltt, melts, & - frain, Tair, fsurfn,& - dhs, ffrac, & - aicen, vicen, vsnon, & - qicen, sicen, & - Tsfcn, alvl, & - apnd, hpnd, ipnd, & - meltsliqn, use_smliq_pnd) - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - ktherm ! type of thermodynamics (0 0-layer, 1 BL99, 2 mushy) - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step (s) - hi_min, & ! minimum ice thickness allowed for thermo (m) - dpscale, & ! alter e-folding time scale for flushing - pndaspect ! ratio of pond depth to pond fraction - - character (len=char_len), intent(in) :: & - frzpnd ! pond refreezing parameterization - - real (kind=dbl_kind), & - intent(in) :: & - Tsfcn, & ! surface temperature (C) - alvl, & ! fraction of level ice - rfrac, & ! water fraction retained for melt ponds - meltt, & ! top melt rate (m/s) - melts, & ! snow melt rate (m/s) - frain, & ! rainfall rate (kg/m2/s) - Tair, & ! air temperature (K) - fsurfn,& ! atm-ice surface heat flux (W/m2) - aicen, & ! ice area fraction - vicen, & ! ice volume (m) - vsnon, & ! snow volume (m) - meltsliqn ! liquid contribution to meltponds in dt (kg/m^2) - - real (kind=dbl_kind), & - intent(inout) :: & - apnd, hpnd, ipnd - - real (kind=dbl_kind), dimension (:), intent(in) :: & - qicen, & ! ice layer enthalpy (J m-3) - sicen ! salinity (ppt) - - real (kind=dbl_kind), & - intent(in) :: & - dhs ! depth difference for snow on sea ice and pond ice - - real (kind=dbl_kind), & - intent(out) :: & - ffrac ! fraction of fsurfn over pond used to melt ipond - - logical (kind=log_kind), intent(in) :: & - use_smliq_pnd ! use snow liquid and ice tracers - - ! local temporary variables - - real (kind=dbl_kind) :: & - volpn ! pond volume per unit area (m) - - real (kind=dbl_kind), dimension (nilyr) :: & - Tmlt ! melting temperature (C) - - real (kind=dbl_kind) :: & - hi , & ! ice thickness (m) - hs , & ! snow depth (m) - dTs , & ! surface temperature diff for freeze-up (C) - Tp , & ! pond freezing temperature (C) - Ts , & ! surface air temperature (C) - apondn , & ! local pond area - hpondn , & ! local pond depth (m) - dvn , & ! change in pond volume (m) - hlid, alid , & ! refrozen lid thickness, area - dhlid , & ! change in refrozen lid thickness - bdt , & ! 2 kice dT dt / (rhoi Lfresh) - alvl_tmp , & ! level ice fraction of ice area - draft, deltah, pressure_head, perm, drain ! for permeability - - real (kind=dbl_kind), parameter :: & - Td = c2 , & ! temperature difference for freeze-up (C) - rexp = p01 ! pond contraction scaling - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - volpn = hpnd * aicen * alvl * apnd - ffrac = c0 - - !----------------------------------------------------------------- - ! Identify grid cells where ponds can be - !----------------------------------------------------------------- - - if (aicen*alvl > puny**2) then - - hi = vicen/aicen - hs = vsnon/aicen - alvl_tmp = alvl - - if (hi < hi_min) then - - !-------------------------------------------------------------- - ! Remove ponds on thin ice - !-------------------------------------------------------------- - apondn = c0 - hpondn = c0 - volpn = c0 - hlid = c0 - - else - - !----------------------------------------------------------- - ! initialize pond area as fraction of ice - !----------------------------------------------------------- - apondn = apnd*alvl_tmp - - !----------------------------------------------------------- - ! update pond volume - !----------------------------------------------------------- - ! add melt water - if (use_smliq_pnd) then - dvn = rfrac/rhofresh*(meltt*rhoi & - + meltsliqn)*aicen - else - dvn = rfrac/rhofresh*(meltt*rhoi & - + melts*rhos & - + frain* dt)*aicen - endif - - ! shrink pond volume under freezing conditions - if (trim(frzpnd) == 'cesm') then - Tp = Timelt - Td - dTs = max(Tp - Tsfcn,c0) - dvn = dvn - volpn * (c1 - exp(rexp*dTs/Tp)) - - else - ! trim(frzpnd) == 'hlid' Stefan approximation - ! assumes pond is fresh (freezing temperature = 0 C) - ! and ice grows from existing pond ice - hlid = ipnd - if (dvn == c0) then ! freeze pond - Ts = Tair - Tffresh - if (Ts < c0) then - ! if (Ts < -c2) then ! as in meltpond_cesm - bdt = -c2*Ts*kice*dt/(rhoi*Lfresh) - dhlid = p5*sqrt(bdt) ! open water freezing - if (hlid > dhlid) dhlid = p5*bdt/hlid ! existing ice - dhlid = min(dhlid, hpnd*rhofresh/rhoi) - hlid = hlid + dhlid - else - dhlid = c0 ! to account for surface inversions - endif - else ! convert refrozen pond ice back to water - dhlid = max(fsurfn*dt / (rhoi*Lfresh), c0) ! > 0 - dhlid = -min(dhlid, hlid) ! < 0 - hlid = max(hlid + dhlid, c0) - if (hs - dhs < puny) then ! pond ice is snow-free - ffrac = c1 ! fraction of fsurfn over pond used to melt ipond - if (fsurfn > puny) & - ffrac = min(-dhlid*rhoi*Lfresh/(dt*fsurfn), c1) - endif - endif - alid = apondn * aicen - dvn = dvn - dhlid*alid*rhoi/rhofresh - endif - - volpn = volpn + dvn - - !----------------------------------------------------------- - ! update pond area and depth - !----------------------------------------------------------- - if (volpn <= c0) then - volpn = c0 - apondn = c0 - endif - - if (apondn*aicen > puny) then ! existing ponds - apondn = max(c0, min(alvl_tmp, & - apondn + 0.5*dvn/(pndaspect*apondn*aicen))) - hpondn = c0 - if (apondn > puny) & - hpondn = volpn/(apondn*aicen) - - elseif (alvl_tmp*aicen > c10*puny) then ! new ponds - apondn = min (sqrt(volpn/(pndaspect*aicen)), alvl_tmp) - hpondn = pndaspect * apondn - - else ! melt water runs off deformed ice - apondn = c0 - hpondn = c0 - endif - apondn = max(apondn, c0) - - ! limit pond depth to maintain nonnegative freeboard - hpondn = min(hpondn, ((rhow-rhoi)*hi - rhos*hs)/rhofresh) - - ! fraction of grid cell covered by ponds - apondn = apondn * aicen - - volpn = hpondn*apondn - if (volpn <= c0) then - volpn = c0 - apondn = c0 - hpondn = c0 - hlid = c0 - endif - - !----------------------------------------------------------- - ! drainage due to permeability (flushing) - ! setting dpscale = 0 turns this off - ! NOTE this uses the initial salinity and melting T profiles - !----------------------------------------------------------- - - if (ktherm /= 2 .and. hpondn > c0 .and. dpscale > puny) then - draft = (rhos*hs + rhoi*hi)/rhow + hpondn - deltah = hpondn + hi - draft - pressure_head = gravit * rhow * max(deltah, c0) - Tmlt(:) = -sicen(:) * depressT - call brine_permeability(nilyr, qicen, & - vicen, sicen, Tmlt, perm) - drain = perm*pressure_head*dt / (viscosity_dyn*hi) * dpscale - deltah = min(drain, hpondn) - dvn = -deltah*apondn - volpn = volpn + dvn - apondn = max(c0, min(apondn & - + 0.5*dvn/(pndaspect*apondn), alvl_tmp*aicen)) - hpondn = c0 - if (apondn > puny) hpondn = volpn/apondn - endif - - endif - - !----------------------------------------------------------- - ! Reload tracer array - !----------------------------------------------------------- - - hpnd = hpondn - apnd = apondn / (aicen*alvl_tmp) - if (trim(frzpnd) == 'hlid') ipnd = hlid - - endif - - end subroutine compute_ponds_lvl - -!======================================================================= - -! determine the liquid fraction of brine in the ice and the permeability - - subroutine brine_permeability(nilyr, qicen, vicen, salin, Tmlt, perm) - - use ice_therm_shared, only: calculate_Tin_from_qin - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real (kind=dbl_kind), dimension(:), intent(in) :: & - qicen, & ! enthalpy for each ice layer (J m-3) - salin, & ! salinity (ppt) - Tmlt ! melting temperature (C) - - real (kind=dbl_kind), intent(in) :: & - vicen ! ice volume (m) - - real (kind=dbl_kind), intent(out) :: & - perm ! permeability (m^2) - - ! local variables - - real (kind=dbl_kind) :: & - Sbr ! brine salinity - - real (kind=dbl_kind), dimension(nilyr) :: & - Tin, & ! ice temperature (C) - phi ! liquid fraction - - integer (kind=int_kind) :: k - - !----------------------------------------------------------------- - ! Compute ice temperatures from enthalpies using quadratic formula - !----------------------------------------------------------------- - - do k = 1,nilyr - Tin(k) = calculate_Tin_from_qin(qicen(k),Tmlt(k)) - enddo - - !----------------------------------------------------------------- - ! brine salinity and liquid fraction - !----------------------------------------------------------------- - - do k = 1,nilyr - Sbr = c1/(1.e-3_dbl_kind - depressT/Tin(k)) ! Notz thesis eq 3.6 - phi(k) = salin(k)/Sbr ! liquid fraction - if (phi(k) < 0.05) phi(k) = c0 ! impermeable - enddo - - !----------------------------------------------------------------- - ! permeability - !----------------------------------------------------------------- - - perm = 3.0e-8_dbl_kind * (minval(phi))**3 - - end subroutine brine_permeability - -!======================================================================= - - end module ice_meltpond_lvl - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_meltpond_topo.F90 b/components/mpas-seaice/src/column/ice_meltpond_topo.F90 deleted file mode 100644 index 4aaf957e644a..000000000000 --- a/components/mpas-seaice/src/column/ice_meltpond_topo.F90 +++ /dev/null @@ -1,866 +0,0 @@ -! SVN:$Id: ice_meltpond_topo.F90 1112 2016-03-24 22:49:56Z eclare $ -!======================================================================= - -! Melt pond evolution based on the ice topography as inferred from -! the ice thickness distribution. This code is based on (but differs -! from) that described in -! -! Flocco, D. and D. L. Feltham, 2007. A continuum model of melt pond -! evolution on Arctic sea ice. J. Geophys. Res. 112, C08016, doi: -! 10.1029/2006JC003836. -! -! Flocco, D., D. L. Feltham and A. K. Turner, 2010. Incorporation of a -! physically based melt pond scheme into the sea ice component of a -! climate model. J. Geophys. Res. 115, C08012, doi: 10.1029/2009JC005568. -! -! authors Daniela Flocco (UCL) -! Adrian Turner (UCL) -! 2010 ECH added module based on original code from Daniela Flocco, UCL -! 2012 DSCHR modifications - - module ice_meltpond_topo - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, p01, p1, p15, p4, p6, & - puny, viscosity_dyn, rhoi, rhos, rhow, Timelt, Lfresh, & - gravit, depressT, kice, ice_ref_salinity - - implicit none - - private - public :: compute_ponds_topo - -!======================================================================= - - contains - -!======================================================================= - - subroutine compute_ponds_topo(dt, ncat, nilyr, & - ktherm, heat_capacity, & - aice, aicen, & - vice, vicen, & - vsno, vsnon, & - potT, meltt, & - fsurf, fpond, & - Tsfcn, Tf, & - qicen, sicen, & - apnd, hpnd, ipnd, & - l_stop,stop_label) - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr, & ! number of ice layers - ktherm ! type of thermodynamics (0 0-layer, 1 BL99, 2 mushy) - - logical (kind=log_kind), intent(in) :: & - heat_capacity ! if true, ice has nonzero heat capacity - ! if false, use zero-layer thermodynamics - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), intent(in) :: & - aice, & ! total ice area fraction - vsno, & ! total snow volume (m) - Tf ! ocean freezing temperature [= ice bottom temperature] (degC) - - real (kind=dbl_kind), intent(inout) :: & - vice, & ! total ice volume (m) - fpond ! fresh water flux to ponds (m) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen, & ! ice area fraction, per category - vsnon ! snow volume, per category (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - vicen ! ice volume, per category (m) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - Tsfcn - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - qicen, & - sicen - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - apnd, & - hpnd, & - ipnd - - real (kind=dbl_kind), intent(in) :: & - potT, & ! air potential temperature - meltt, & ! total surface meltwater flux - fsurf ! thermodynamic heat flux at ice/snow surface (W/m^2) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort model - - character (len=char_len), intent(out) :: & - stop_label - - ! local variables - - real (kind=dbl_kind), dimension (ncat) :: & - volpn, & ! pond volume per unit area, per category (m) - vuin ! water-equivalent volume of ice lid on melt pond ('upper ice', m) - - real (kind=dbl_kind), dimension (ncat) :: & - apondn,& ! pond area fraction, per category - hpondn ! pond depth, per category (m) - - real (kind=dbl_kind) :: & - volp ! total volume of pond, per unit area of pond (m) - - real (kind=dbl_kind) :: & - hi, & ! ice thickness (m) - dHui, & ! change in thickness of ice lid (m) - omega, & ! conduction - dTice, & ! temperature difference across ice lid (C) - dvice, & ! change in ice volume (m) - Tavg, & ! mean surface temperature across categories (C) - Tp, & ! pond freezing temperature (C) - dvn ! change in melt pond volume for fresh water budget - - integer (kind=int_kind) :: n ! loop indices - - real (kind=dbl_kind), parameter :: & - hicemin = p1 , & ! minimum ice thickness with ponds (m) - Td = p15 , & ! temperature difference for freeze-up (C) - rhoi_L = Lfresh * rhoi, & ! (J/m^3) - min_volp = 1.e-4_dbl_kind ! minimum pond volume (m) - - !--------------------------------------------------------------- - ! initialize - !--------------------------------------------------------------- - - volp = c0 - - do n = 1, ncat - ! load tracers - volp = volp + hpnd(n) & - * apnd(n) * aicen(n) - vuin (n) = ipnd(n) & - * apnd(n) * aicen(n) - - hpondn(n) = c0 ! pond depth, per category - apondn(n) = c0 ! pond area, per category - enddo - - ! The freezing temperature for meltponds is assumed slightly below 0C, - ! as if meltponds had a little salt in them. The salt budget is not - ! altered for meltponds, but if it were then an actual pond freezing - ! temperature could be computed. - - Tp = Timelt - Td - - !----------------------------------------------------------------- - ! Identify grid cells with ponds - !----------------------------------------------------------------- - - hi = c0 - if (aice > puny) hi = vice/aice - if ( aice > p01 .and. hi > hicemin .and. & - volp > min_volp*aice) then - - !-------------------------------------------------------------- - ! calculate pond area and depth - !-------------------------------------------------------------- - call pond_area(dt, ncat, nilyr, & - ktherm, heat_capacity, & - aice, vice, vsno, & - aicen, vicen, vsnon, & - qicen, sicen, & - volpn, volp, & - Tsfcn, Tf, & - apondn, hpondn, dvn, & - l_stop, stop_label) - - fpond = fpond - dvn - - ! mean surface temperature - Tavg = c0 - do n = 1, ncat - Tavg = Tavg + Tsfcn(n)*aicen(n) - enddo - Tavg = Tavg / aice - - do n = 1, ncat-1 - - if (vuin(n) > puny) then - - !---------------------------------------------------------------- - ! melting: floating upper ice layer melts in whole or part - !---------------------------------------------------------------- - ! Use Tsfc for each category - if (Tsfcn(n) > Tp) then - - dvice = min(meltt*apondn(n), vuin(n)) - if (dvice > puny) then - vuin (n) = vuin (n) - dvice - volpn(n) = volpn(n) + dvice - volp = volp + dvice - fpond = fpond + dvice - - if (vuin(n) < puny .and. volpn(n) > puny) then - ! ice lid melted and category is pond covered - volpn(n) = volpn(n) + vuin(n) - fpond = fpond + vuin(n) - vuin(n) = c0 - endif - hpondn(n) = volpn(n) / apondn(n) - endif - - !---------------------------------------------------------------- - ! freezing: existing upper ice layer grows - !---------------------------------------------------------------- - - else if (volpn(n) > puny) then ! Tsfcn(i,j,n) <= Tp - - ! differential growth of base of surface floating ice layer - dTice = max(-Tsfcn(n)-Td, c0) ! > 0 - omega = kice*DTice/rhoi_L - dHui = sqrt(c2*omega*dt + (vuin(n)/aicen(n))**2) & - - vuin(n)/aicen(n) - - dvice = min(dHui*apondn(n), volpn(n)) - if (dvice > puny) then - vuin (n) = vuin (n) + dvice - volpn(n) = volpn(n) - dvice - volp = volp - dvice - fpond = fpond - dvice - hpondn(n) = volpn(n) / apondn(n) - endif - - endif ! Tsfcn(i,j,n) - - !---------------------------------------------------------------- - ! freezing: upper ice layer begins to form - ! note: albedo does not change - !---------------------------------------------------------------- - else ! vuin < puny - - ! thickness of newly formed ice - ! the surface temperature of a meltpond is the same as that - ! of the ice underneath (0C), and the thermodynamic surface - ! flux is the same - dHui = max(-fsurf*dt/rhoi_L, c0) - dvice = min(dHui*apondn(n), volpn(n)) - if (dvice > puny) then - vuin (n) = dvice - volpn(n) = volpn(n) - dvice - volp = volp - dvice - fpond = fpond - dvice - hpondn(n)= volpn(n) / apondn(n) - endif - - endif ! vuin - - enddo ! ncat - - else ! remove ponds on thin ice - fpond = fpond - volp - volpn(:) = c0 - vuin (:) = c0 - volp = c0 - endif - - !--------------------------------------------------------------- - ! remove ice lid if there is no liquid pond - ! vuin may be nonzero on category ncat due to dynamics - !--------------------------------------------------------------- - - do n = 1, ncat - if (aicen(n) > puny .and. volpn(n) < puny & - .and. vuin (n) > puny) then - vuin(n) = c0 - endif - - ! reload tracers - if (apondn(n) > puny) then - ipnd(n) = vuin(n) / apondn(n) - else - vuin(n) = c0 - ipnd(n) = c0 - endif - if (aicen(n) > puny) then - apnd(n) = apondn(n) / aicen(n) - hpnd(n) = hpondn(n) - else - apnd(n) = c0 - hpnd(n) = c0 - ipnd(n) = c0 - endif - enddo ! n - - end subroutine compute_ponds_topo - -!======================================================================= - -! Computes melt pond area, pond depth and melting rates - - subroutine pond_area(dt, ncat, nilyr,& - ktherm, heat_capacity, & - aice, vice, vsno, & - aicen, vicen, vsnon,& - qicen, sicen, & - volpn, volp, & - Tsfcn, Tf, & - apondn,hpondn,dvolp,& - l_stop,stop_label) - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr, & ! number of ice layers - ktherm ! type of thermodynamics (0 0-layer, 1 BL99, 2 mushy) - - logical (kind=log_kind), intent(in) :: & - heat_capacity ! if true, ice has nonzero heat capacity - ! if false, use zero-layer thermodynamics - - real (kind=dbl_kind), intent(in) :: & - dt, aice, vice, vsno, Tf - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen, vicen, vsnon, Tsfcn - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - qicen, & - sicen - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - volpn - - real (kind=dbl_kind), intent(inout) :: & - volp, dvolp - - real (kind=dbl_kind), dimension(:), intent(out) :: & - apondn, hpondn - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort model - - character (len=char_len), intent(out) :: & - stop_label - - ! local variables - - integer (kind=int_kind) :: & - n, ns, & - m_index, & - permflag - - real (kind=dbl_kind), dimension(ncat) :: & - hicen, & - hsnon, & - asnon, & - alfan, & - betan, & - cum_max_vol, & - reduced_aicen - - real (kind=dbl_kind), dimension(0:ncat) :: & - cum_max_vol_tmp - - real (kind=dbl_kind) :: & - hpond, & - drain, & - floe_weight, & - pressure_head, & - hsl_rel, & - deltah, & - perm, & - apond - - !-----------| - ! | - ! |-----------| - !___________|___________|______________________________________sea-level - ! | | - ! | |---^--------| - ! | | | | - ! | | | |-----------| |------- - ! | | |alfan(n)| | | - ! | | | | |--------------| - ! | | | | | | - !---------------------------v------------------------------------------- - ! | | ^ | | | - ! | | | | |--------------| - ! | | |betan(n)| | | - ! | | | |-----------| |------- - ! | | | | - ! | |---v------- | - ! | | - ! |-----------| - ! | - !-----------| - - !------------------------------------------------------------------- - ! initialize - !------------------------------------------------------------------- - - do n = 1, ncat - - apondn(n) = c0 - hpondn(n) = c0 - - if (aicen(n) < puny) then - hicen(n) = c0 - hsnon(n) = c0 - reduced_aicen(n) = c0 - asnon(n) = c0 - else - hicen(n) = vicen(n) / aicen(n) - hsnon(n) = vsnon(n) / aicen(n) - reduced_aicen(n) = c1 ! n=ncat - if (n < ncat) reduced_aicen(n) = aicen(n) & - * max(0.2_dbl_kind,(-0.024_dbl_kind*hicen(n) + 0.832_dbl_kind)) - asnon(n) = reduced_aicen(n) - endif - -! This choice for alfa and beta ignores hydrostatic equilibium of categories. -! Hydrostatic equilibium of the entire ITD is accounted for below, assuming -! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all -! categories. alfa and beta partition the ITD - they are areas not thicknesses! -! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area. -! Here, alfa = 60% of the ice area (and since hice is constant in a category, -! alfan = 60% of the ice volume) in each category lies above the reference line, -! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required. - - alfan(n) = p6 * hicen(n) - betan(n) = p4 * hicen(n) - - cum_max_vol(n) = c0 - cum_max_vol_tmp(n) = c0 - - enddo ! ncat - - cum_max_vol_tmp(0) = c0 - drain = c0 - dvolp = c0 - - !-------------------------------------------------------------------------- - ! the maximum amount of water that can be contained up to each ice category - !-------------------------------------------------------------------------- - - do n = 1, ncat-1 ! last category can not hold any volume - - if (alfan(n+1) >= alfan(n) .and. alfan(n+1) > c0) then - - ! total volume in level including snow - cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) + & - (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n)) - - - ! subtract snow solid volumes from lower categories in current level - do ns = 1, n - cum_max_vol_tmp(n) = cum_max_vol_tmp(n) & - - rhos/rhow * & ! fraction of snow that is occupied by solid - asnon(ns) * & ! area of snow from that category - max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)-alfan(n)), c0) - ! thickness of snow from ns layer in n layer - enddo - - else ! assume higher categories unoccupied - cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) - endif - if (cum_max_vol_tmp(n) < c0) then - l_stop = .true. - stop_label = 'topo ponds: negative melt pond volume' - return - endif - enddo - cum_max_vol_tmp(ncat) = cum_max_vol_tmp(ncat-1) ! last category holds no volume - cum_max_vol (1:ncat) = cum_max_vol_tmp(1:ncat) - - !---------------------------------------------------------------- - ! is there more meltwater than can be held in the floe? - !---------------------------------------------------------------- - if (volp >= cum_max_vol(ncat)) then - drain = volp - cum_max_vol(ncat) + puny - volp = volp - drain - dvolp = drain - if (volp < puny) then - dvolp = dvolp + volp - volp = c0 - endif - endif - - ! height and area corresponding to the remaining volume - - call calc_hpond(ncat, reduced_aicen, asnon, hsnon, & - alfan, volp, cum_max_vol, hpond, m_index) - - do n=1, m_index - hpondn(n) = max((hpond - alfan(n) + alfan(1)), c0) - apondn(n) = reduced_aicen(n) - enddo - apond = sum(apondn(1:m_index)) - - !------------------------------------------------------------------------ - ! drainage due to ice permeability - Darcy's law - !------------------------------------------------------------------------ - - ! sea water level - floe_weight = (vsno*rhos + rhoi*vice + rhow*volp) / aice - hsl_rel = floe_weight / rhow & - - ((sum(betan(:)*aicen(:))/aice) + alfan(1)) - - deltah = hpond - hsl_rel - pressure_head = gravit * rhow * max(deltah, c0) - - ! drain if ice is permeable - permflag = 0 - if (ktherm /= 2 .and. pressure_head > c0) then - do n = 1, ncat-1 - if (hicen(n) > c0) then - call permeability_phi(heat_capacity, nilyr, & - qicen(:,n), sicen(:,n), Tsfcn(n), Tf, & - vicen(n), perm, l_stop, stop_label) - if (l_stop) return - if (perm > c0) permflag = 1 - drain = perm*apondn(n)*pressure_head*dt / (viscosity_dyn*hicen(n)) - dvolp = dvolp + min(drain, volp) - volp = max(volp - drain, c0) - if (volp < puny) then - dvolp = dvolp + volp - volp = c0 - endif - endif - enddo - - ! adjust melt pond dimensions - if (permflag > 0) then - ! recompute pond depth - call calc_hpond(ncat, reduced_aicen, asnon, hsnon, & - alfan, volp, cum_max_vol, hpond, m_index) - do n=1, m_index - hpondn(n) = hpond - alfan(n) + alfan(1) - apondn(n) = reduced_aicen(n) - enddo - apond = sum(apondn(1:m_index)) - endif - endif ! pressure_head - - !------------------------------------------------------------------------ - ! total melt pond volume in category does not include snow volume - ! snow in melt ponds is not melted - !------------------------------------------------------------------------ - - ! Calculate pond volume for lower categories - do n=1,m_index-1 - volpn(n) = apondn(n) * hpondn(n) & - - (rhos/rhow) * asnon(n) * min(hsnon(n), hpondn(n)) - enddo - - ! Calculate pond volume for highest category = remaining pond volume - if (m_index == 1) volpn(m_index) = volp - if (m_index > 1) then - if (volp > sum(volpn(1:m_index-1))) then - volpn(m_index) = volp - sum(volpn(1:m_index-1)) - else - volpn(m_index) = c0 - hpondn(m_index) = c0 - apondn(m_index) = c0 - ! If remaining pond volume is negative reduce pond volume of - ! lower category - if (volp+puny < sum(volpn(1:m_index-1))) & - volpn(m_index-1) = volpn(m_index-1) - sum(volpn(1:m_index-1)) + & - volp - endif - endif - - do n=1,m_index - if (apondn(n) > puny) then - hpondn(n) = volpn(n) / apondn(n) - else - dvolp = dvolp + volpn(n) - hpondn(n) = c0 - volpn(n) = c0 - apondn(n) = c0 - end if - enddo - do n = m_index+1, ncat - hpondn(n) = c0 - apondn(n) = c0 - volpn (n) = c0 - enddo - - end subroutine pond_area - -!======================================================================= - - subroutine calc_hpond(ncat, aicen, asnon, hsnon, & - alfan, volp, cum_max_vol, hpond, m_index) - - integer (kind=int_kind), intent(in) :: & - ncat ! number of thickness categories - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen, & - asnon, & - hsnon, & - alfan, & - cum_max_vol - - real (kind=dbl_kind), intent(in) :: & - volp - - real (kind=dbl_kind), intent(out) :: & - hpond - - integer (kind=int_kind), intent(out) :: & - m_index - - integer :: n, ns - - real (kind=dbl_kind), dimension(0:ncat+1) :: & - hitl, & - aicetl - - real (kind=dbl_kind) :: & - rem_vol, & - area, & - vol, & - tmp - - !---------------------------------------------------------------- - ! hpond is zero if volp is zero - have we fully drained? - !---------------------------------------------------------------- - - if (volp < puny) then - hpond = c0 - m_index = 0 - else - - !---------------------------------------------------------------- - ! Calculate the category where water fills up to - !---------------------------------------------------------------- - - !----------| - ! | - ! | - ! |----------| -- -- - !__________|__________|_________________________________________ ^ - ! | | rem_vol ^ | Semi-filled - ! | |----------|-- -- -- - ---|-- ---- -- -- --v layer - ! | | | | - ! | | | |hpond - ! | | |----------| | |------- - ! | | | | | | - ! | | | |---v-----| - ! | | m_index | | | - !------------------------------------------------------------- - - m_index = 0 ! 1:m_index categories have water in them - do n = 1, ncat - if (volp <= cum_max_vol(n)) then - m_index = n - if (n == 1) then - rem_vol = volp - else - rem_vol = volp - cum_max_vol(n-1) - endif - exit ! to break out of the loop - endif - enddo - m_index = min(ncat-1, m_index) - - !---------------------------------------------------------------- - ! semi-filled layer may have m_index different snows in it - !---------------------------------------------------------------- - - !----------------------------------------------------------- ^ - ! | alfan(m_index+1) - ! | - !hitl(3)--> |----------| | - !hitl(2)--> |------------| * * * * *| | - !hitl(1)--> |----------|* * * * * * |* * * * * | | - !hitl(0)-->------------------------------------------------- | ^ - ! various snows from lower categories | |alfa(m_index) - - ! hitl - heights of the snow layers from thinner and current categories - ! aicetl - area of each snow depth in this layer - - hitl(:) = c0 - aicetl(:) = c0 - do n = 1, m_index - hitl(n) = max(min(hsnon(n) + alfan(n) - alfan(m_index), & - alfan(m_index+1) - alfan(m_index)), c0) - aicetl(n) = asnon(n) - - aicetl(0) = aicetl(0) + (aicen(n) - asnon(n)) - enddo - hitl(m_index+1) = alfan(m_index+1) - alfan(m_index) - aicetl(m_index+1) = c0 - - !---------------------------------------------------------------- - ! reorder array according to hitl - ! snow heights not necessarily in height order - !---------------------------------------------------------------- - - do ns = 1, m_index+1 - do n = 0, m_index - ns + 1 - if (hitl(n) > hitl(n+1)) then ! swap order - tmp = hitl(n) - hitl(n) = hitl(n+1) - hitl(n+1) = tmp - tmp = aicetl(n) - aicetl(n) = aicetl(n+1) - aicetl(n+1) = tmp - endif - enddo - enddo - - !---------------------------------------------------------------- - ! divide semi-filled layer into set of sublayers each vertically homogenous - !---------------------------------------------------------------- - - !hitl(3)---------------------------------------------------------------- - ! | * * * * * * * * - ! |* * * * * * * * * - !hitl(2)---------------------------------------------------------------- - ! | * * * * * * * * | * * * * * * * * - ! |* * * * * * * * * |* * * * * * * * * - !hitl(1)---------------------------------------------------------------- - ! | * * * * * * * * | * * * * * * * * | * * * * * * * * - ! |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * - !hitl(0)---------------------------------------------------------------- - ! aicetl(0) aicetl(1) aicetl(2) aicetl(3) - - ! move up over layers incrementing volume - do n = 1, m_index+1 - - area = sum(aicetl(:)) - & ! total area of sub-layer - (rhos/rhow) * sum(aicetl(n:ncat+1)) ! area of sub-layer occupied by snow - - vol = (hitl(n) - hitl(n-1)) * area ! thickness of sub-layer times area - - if (vol >= rem_vol) then ! have reached the sub-layer with the depth within - hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1) - exit - else ! still in sub-layer below the sub-layer with the depth - rem_vol = rem_vol - vol - endif - - enddo - - endif - - end subroutine calc_hpond - -!======================================================================= - -! determine the liquid fraction of brine in the ice and the permeability - - subroutine permeability_phi(heat_capacity, nilyr, & - qicen, sicen, Tsfcn, Tf, & - vicen, perm, l_stop, stop_label) - - use ice_therm_shared, only: calculate_Tin_from_qin - - logical (kind=log_kind), intent(in) :: & - heat_capacity ! if true, ice has nonzero heat capacity - ! if false, use zero-layer thermodynamics - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real (kind=dbl_kind), dimension(:), intent(in) :: & - qicen, & ! energy of melting for each ice layer (J/m2) - sicen ! salinity (ppt) - - real (kind=dbl_kind), intent(in) :: & - vicen, & ! ice volume - Tsfcn, & ! sea ice surface skin temperature (degC) - Tf ! ocean freezing temperature [= ice bottom temperature] (degC) - - real (kind=dbl_kind), intent(out) :: & - perm ! permeability - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort model - - character (len=char_len), intent(out) :: & - stop_label - - ! local variables - - real (kind=dbl_kind) :: & - Tmlt, & ! melting temperature - Sbr ! brine salinity - - real (kind=dbl_kind), dimension(nilyr) :: & - Tin, & ! ice temperature - phi ! liquid fraction - - integer (kind=int_kind) :: k - - !----------------------------------------------------------------- - ! Compute ice temperatures from enthalpies using quadratic formula - ! NOTE this assumes Tmlt = Si * depressT - !----------------------------------------------------------------- - - if (heat_capacity) then - do k = 1,nilyr - Tmlt = -sicen(k) * depressT - Tin(k) = calculate_Tin_from_qin(qicen(k),Tmlt) - enddo - else - Tin(1) = (Tsfcn + Tf) / c2 - endif - - !----------------------------------------------------------------- - ! brine salinity and liquid fraction - !----------------------------------------------------------------- - - if (maxval(Tin) <= -c2) then - - ! Assur 1958 - do k = 1,nilyr - Sbr = - 1.2_dbl_kind & - -21.8_dbl_kind * Tin(k) & - - 0.919_dbl_kind * Tin(k)**2 & - - 0.01878_dbl_kind * Tin(k)**3 - if (heat_capacity) then - phi(k) = sicen(k)/Sbr ! liquid fraction - else - phi(k) = ice_ref_salinity / Sbr ! liquid fraction - endif - enddo ! k - - else - - ! Notz 2005 thesis eq. 3.2 - do k = 1,nilyr - Sbr = -17.6_dbl_kind * Tin(k) & - - 0.389_dbl_kind * Tin(k)**2 & - - 0.00362_dbl_kind* Tin(k)**3 - if (Sbr == c0) then - l_stop = .true. - stop_label = 'topo ponds: zero brine salinity in permeability' - return - endif - if (heat_capacity) then - phi(k) = sicen(k) / Sbr ! liquid fraction - else - phi(k) = ice_ref_salinity / Sbr ! liquid fraction - endif - - enddo - - endif - - !----------------------------------------------------------------- - ! permeability - !----------------------------------------------------------------- - - perm = 3.0e-08_dbl_kind * (minval(phi))**3 - - end subroutine permeability_phi - -!======================================================================= - - end module ice_meltpond_topo - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_mushy_physics.F90 b/components/mpas-seaice/src/column/ice_mushy_physics.F90 deleted file mode 100644 index 15a17813fc15..000000000000 --- a/components/mpas-seaice/src/column/ice_mushy_physics.F90 +++ /dev/null @@ -1,490 +0,0 @@ -module ice_mushy_physics - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, c4, c8, c10, c1000, & - p001, p01, p05, p1, p2, p5, pi, bignum, puny, ice_ref_salinity, & - viscosity_dyn, rhow, rhoi, rhos, cp_ocn, cp_ice, Lfresh, gravit - use ice_colpkg_shared, only: ksno - - - implicit none - - private - public :: & - conductivity_mush_array, & - conductivity_snow_array, & - enthalpy_snow, & - enthalpy_brine, & - enthalpy_mush, & - enthalpy_mush_liquid_fraction, & - enthalpy_of_melting, & - temperature_snow, & - temperature_mush, & - temperature_brine, & - temperature_mush_liquid_fraction, & - liquidus_brine_salinity_mush, & - liquidus_temperature_mush, & - liquid_fraction, & - density_brine - - !----------------------------------------------------------------- - ! Constants for Liquidus relation from Assur (1958) - !----------------------------------------------------------------- - - ! liquidus relation - higher temperature region - real(kind=dbl_kind), parameter :: & - az1_liq = -18.48_dbl_kind, & - bz1_liq = 0.0_dbl_kind - - ! liquidus relation - lower temperature region - real(kind=dbl_kind), parameter :: & - az2_liq = -10.3085_dbl_kind, & - bz2_liq = 62.4_dbl_kind - - ! liquidus break - real(kind=dbl_kind), parameter :: & - Tb_liq = -7.6362968855167352_dbl_kind, & ! temperature of liquidus break - Sb_liq = 123.66702800276086_dbl_kind ! salinity of liquidus break - - ! basic liquidus relation constants - real(kind=dbl_kind), parameter :: & - az1p_liq = az1_liq / c1000, & - bz1p_liq = bz1_liq / c1000, & - az2p_liq = az2_liq / c1000, & - bz2p_liq = bz2_liq / c1000 - - ! quadratic constants - higher temperature region - real(kind=dbl_kind), parameter :: & - AS1_liq = az1p_liq * (rhow * cp_ocn - rhoi * cp_ice) , & - AC1_liq = rhoi * cp_ice * az1_liq , & - BS1_liq = (c1 + bz1p_liq) * (rhow * cp_ocn - rhoi * cp_ice) & - + rhoi * Lfresh * az1p_liq , & - BQ1_liq = -az1_liq , & - BC1_liq = rhoi * cp_ice * bz1_liq - rhoi * Lfresh * az1_liq, & - CS1_liq = rhoi * Lfresh * (c1 + bz1p_liq) , & - CQ1_liq = -bz1_liq , & - CC1_liq = -rhoi * Lfresh * bz1_liq - - ! quadratic constants - lower temperature region - real(kind=dbl_kind), parameter :: & - AS2_liq = az2p_liq * (rhow * cp_ocn - rhoi * cp_ice) , & - AC2_liq = rhoi * cp_ice * az2_liq , & - BS2_liq = (c1 + bz2p_liq) * (rhow * cp_ocn - rhoi * cp_ice) & - + rhoi * Lfresh * az2p_liq , & - BQ2_liq = -az2_liq , & - BC2_liq = rhoi * cp_ice * bz2_liq - rhoi * Lfresh * az2_liq, & - CS2_liq = rhoi * Lfresh * (c1 + bz2p_liq) , & - CQ2_liq = -bz2_liq , & - CC2_liq = -rhoi * Lfresh * bz2_liq - - ! break enthalpy constants - real(kind=dbl_kind), parameter :: & - D_liq = ((c1 + az1p_liq*Tb_liq + bz1p_liq) & - / ( az1_liq*Tb_liq + bz1_liq)) & - * ((cp_ocn*rhow - cp_ice*rhoi)*Tb_liq + Lfresh*rhoi), & - E_liq = cp_ice*rhoi*Tb_liq - Lfresh*rhoi - - ! just fully melted enthapy constants - real(kind=dbl_kind), parameter :: & - F1_liq = ( -c1000 * cp_ocn * rhow) / az1_liq , & - G1_liq = -c1000 , & - H1_liq = (-bz1_liq * cp_ocn * rhow) / az1_liq , & - F2_liq = ( -c1000 * cp_ocn * rhow) / az2_liq , & - G2_liq = -c1000 , & - H2_liq = (-bz2_liq * cp_ocn * rhow) / az2_liq - - ! warmer than fully melted constants - real(kind=dbl_kind), parameter :: & - I_liq = c1 / (cp_ocn * rhow) - - ! temperature to brine salinity - real(kind=dbl_kind), parameter :: & - J1_liq = bz1_liq / az1_liq , & - K1_liq = c1 / c1000 , & - L1_liq = (c1 + bz1p_liq) / az1_liq , & - J2_liq = bz2_liq / az2_liq , & - K2_liq = c1 / c1000 , & - L2_liq = (c1 + bz2p_liq) / az2_liq - - ! brine salinity to temperature - real(kind=dbl_kind), parameter :: & - M1_liq = az1_liq , & - N1_liq = -az1p_liq , & - O1_liq = -bz1_liq / az1_liq , & - M2_liq = az2_liq , & - N2_liq = -az2p_liq , & - O2_liq = -bz2_liq / az2_liq - - !----------------------------------------------------------------- - ! Other parameters - !----------------------------------------------------------------- - - real(kind=dbl_kind), parameter :: & - ki = 2.3_dbl_kind , & ! fresh ice conductivity (W m-1 K-1) - kb = 0.5375_dbl_kind ! brine conductivity (W m-1 K-1) - -!======================================================================= - -contains - -!======================================================================= -! Physical Quantities -!======================================================================= - - subroutine conductivity_mush_array(nilyr, zqin, zSin, km) - - ! detemine the conductivity of the mush from enthalpy and salinity - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin, & ! ice layer enthalpy (J m-3) - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - km ! ice layer conductivity (W m-1 K-1) - - integer(kind=int_kind) :: & - k ! ice layer index - - real(kind=dbl_kind) :: Tmush - - do k = 1, nilyr - - Tmush = temperature_mush(zqin(k), zSin(k)) - - km(k) = heat_conductivity(Tmush, zSin(k)) - - enddo ! k - - end subroutine conductivity_mush_array - -!======================================================================= - - function density_brine(Sbr) result(rho) - - ! density of brine from brine salinity - - real(kind=dbl_kind), intent(in) :: & - Sbr ! brine salinity (ppt) - - real(kind=dbl_kind) :: & - rho ! brine density (kg m-3) - - real(kind=dbl_kind), parameter :: & - a = 1000.3_dbl_kind , & ! zeroth empirical coefficient - b = 0.78237_dbl_kind , & ! linear empirical coefficient - c = 2.8008e-4_dbl_kind ! quadratic empirical coefficient - - rho = a + b * Sbr + c * Sbr**2 - - end function density_brine - -!======================================================================= -! Snow -!======================================================================= - - subroutine conductivity_snow_array(ks) - - ! heat conductivity of the snow - - real(kind=dbl_kind), dimension(:), intent(out) :: & - ks ! snow layer conductivity (W m-1 K-1) - - ks = ksno - - end subroutine conductivity_snow_array - -!======================================================================= - - function enthalpy_snow(zTsn) result(zqsn) - - ! enthalpy of snow from snow temperature - - real(kind=dbl_kind), intent(in) :: & - zTsn ! snow layer temperature (C) - - real(kind=dbl_kind) :: & - zqsn ! snow layer enthalpy (J m-3) - - zqsn = -rhos * (-cp_ice * zTsn + Lfresh) - - end function enthalpy_snow - -!======================================================================= - - function temperature_snow(zqsn) result(zTsn) - - ! temperature of snow from the snow enthalpy - - real(kind=dbl_kind), intent(in) :: & - zqsn ! snow layer enthalpy (J m-3) - - real(kind=dbl_kind) :: & - zTsn ! snow layer temperature (C) - - real(kind=dbl_kind), parameter :: & - A = c1 / (rhos * cp_ice) , & - B = Lfresh / cp_ice - - zTsn = A * zqsn + B - - end function temperature_snow - -!======================================================================= -! Mushy Layer Formulation - Assur (1958) liquidus -!======================================================================= - - function liquidus_brine_salinity_mush(zTin) result(Sbr) - - ! liquidus relation: equilibrium brine salinity as function of temperature - ! based on empirical data from Assur (1958) - - real(kind=dbl_kind), intent(in) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind) :: & - Sbr ! ice brine salinity (ppt) - - real(kind=dbl_kind) :: & - t_high , & ! mask for high temperature liquidus region - lsubzero ! mask for sub-zero temperatures - - t_high = merge(c1, c0, (zTin > Tb_liq)) - lsubzero = merge(c1, c0, (zTin <= c0)) - - Sbr = ((zTin + J1_liq) / (K1_liq * zTin + L1_liq)) * t_high + & - ((zTin + J2_liq) / (K2_liq * zTin + L2_liq)) * (c1 - t_high) - - Sbr = Sbr * lsubzero - - end function liquidus_brine_salinity_mush - -!======================================================================= - - function liquidus_temperature_mush(Sbr) result(zTin) - - ! liquidus relation: equilibrium temperature as function of brine salinity - ! based on empirical data from Assur (1958) - - real(kind=dbl_kind), intent(in) :: & - Sbr ! ice brine salinity (ppt) - - real(kind=dbl_kind) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind) :: & - t_high ! mask for high temperature liquidus region - - t_high = merge(c1, c0, (Sbr <= Sb_liq)) - - zTin = ((Sbr / (M1_liq + N1_liq * Sbr)) + O1_liq) * t_high + & - ((Sbr / (M2_liq + N2_liq * Sbr)) + O2_liq) * (c1 - t_high) - - end function liquidus_temperature_mush - -!======================================================================= - - function enthalpy_mush(zTin, zSin) result(zqin) - - ! enthalpy of mush from mush temperature and bulk salinity - - real(kind=dbl_kind), intent(in) :: & - zTin, & ! ice layer temperature (C) - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind) :: & - zqin ! ice layer enthalpy (J m-3) - - real(kind=dbl_kind) :: & - phi ! ice liquid fraction - - phi = liquid_fraction(zTin, zSin) - - zqin = phi * (cp_ocn * rhow - cp_ice * rhoi) * zTin + & - rhoi * cp_ice * zTin - (c1 - phi) * rhoi * Lfresh - - end function enthalpy_mush - -!======================================================================= - - function enthalpy_mush_liquid_fraction(zTin, phi) result(zqin) - - ! enthalpy of mush from mush temperature and bulk salinity - - real(kind=dbl_kind), intent(in) :: & - zTin, & ! ice layer temperature (C) - phi ! liquid fraction - - real(kind=dbl_kind) :: & - zqin ! ice layer enthalpy (J m-3) - - zqin = phi * (cp_ocn * rhow - cp_ice * rhoi) * zTin + & - rhoi * cp_ice * zTin - (c1 - phi) * rhoi * Lfresh - - end function enthalpy_mush_liquid_fraction - -!======================================================================= - - function enthalpy_of_melting(zSin) result(qm) - - ! enthalpy of melting of mush - ! energy needed to fully melt mush (T < 0) - - real(kind=dbl_kind), intent(in) :: & - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind) :: & - qm ! melting ice enthalpy (J m-3) - - qm = cp_ocn * rhow * liquidus_temperature_mush(zSin) - - end function enthalpy_of_melting - -!======================================================================= - - function enthalpy_brine(zTin) result(qbr) - - ! enthalpy of brine (fully liquid) - - real(kind=dbl_kind), intent(in) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind) :: & - qbr ! brine enthalpy (J m-3) - - qbr = cp_ocn * rhow * zTin - - end function enthalpy_brine - -!======================================================================= - - function temperature_mush(zqin, zSin) result(zTin) - - ! temperature of mush from mush enthalpy - - real(kind=dbl_kind), intent(in) :: & - zqin , & ! ice enthalpy (J m-3) - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind) :: & - qb , & ! liquidus break enthalpy - q0 , & ! fully melted enthalpy - A , & ! quadratic equation A parameter - B , & ! quadratic equation B parameter - C , & ! quadratic equation C parameter - S_low , & ! mask for salinity less than the liquidus break salinity - t_high , & ! mask for high temperature liquidus region - t_low , & ! mask for low temperature liquidus region - q_melt ! mask for all mush melted - - ! just melted enthalpy - S_low = merge(c1, c0, (zSin < Sb_liq)) - q0 = ((F1_liq * zSin) / (G1_liq + zSin) + H1_liq) * S_low + & - ((F2_liq * zSin) / (G2_liq + zSin) + H2_liq) * (c1 - S_low) - q_melt = merge(c1, c0, (zqin > q0)) - - ! break enthalpy - qb = D_liq * zSin + E_liq - t_high = merge(c1, c0, (zqin > qb)) - t_low = c1 - t_high - - ! quadratic values - A = (AS1_liq * zSin + AC1_liq) * t_high + & - (AS2_liq * zSin + AC2_liq) * t_low - - B = (BS1_liq * zSin + BQ1_liq * zqin + BC1_liq) * t_high + & - (BS2_liq * zSin + BQ2_liq * zqin + BC2_liq) * t_low - - C = (CS1_liq * zSin + CQ1_liq * zqin + CC1_liq) * t_high + & - (CS2_liq * zSin + CQ2_liq * zqin + CC2_liq) * t_low - - zTin = (-B + sqrt(max(B**2 - c4 * A * C,puny))) / (c2 * A) - - ! change T if all melted - zTin = q_melt * zqin * I_liq + (c1 - q_melt) * zTin - - end function temperature_mush - -!======================================================================= - - function temperature_brine(qbr) result(zTin) - - real(kind=dbl_kind), intent(in) :: & - qbr ! enthalpy of brine (fully liquid) - - real(kind=dbl_kind) :: & - zTin ! ice layer temperature (C) - - zTin = qbr / (cp_ocn * rhow) - - end function temperature_brine - -!======================================================================= - - function temperature_mush_liquid_fraction(zqin, phi) result(zTin) - - ! temperature of mush from mush enthalpy - - real(kind=dbl_kind), intent(in) :: & - zqin , & ! ice enthalpy (J m-3) - phi ! liquid fraction - - real(kind=dbl_kind) :: & - zTin ! ice layer temperature (C) - - zTin = (zqin + (c1 - phi) * rhoi * Lfresh) / & - (phi * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) - - end function temperature_mush_liquid_fraction - -!======================================================================= - - function heat_conductivity(zTin, zSin) result(km) - - ! msuh heat conductivity from mush temperature and bulk salinity - - real(kind=dbl_kind), intent(in) :: & - zTin , & ! ice layer temperature (C) - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind) :: & - km ! ice layer conductivity (W m-1 K-1) - - real(kind=dbl_kind) :: & - phi ! liquid fraction - - phi = liquid_fraction(zTin, zSin) - - km = phi * (kb - ki) + ki - - end function heat_conductivity - - !======================================================================= - - function liquid_fraction(zTin, zSin) result(phi) - - ! liquid fraction of mush from mush temperature and bulk salinity - - real(kind=dbl_kind), intent(in) :: & - zTin, & ! ice layer temperature (C) - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind) :: & - phi , & ! liquid fraction - Sbr ! brine salinity (ppt) - - Sbr = max(liquidus_brine_salinity_mush(zTin),puny) - phi = zSin / max(Sbr, zSin) - - end function liquid_fraction - -!======================================================================= - -end module ice_mushy_physics - - diff --git a/components/mpas-seaice/src/column/ice_orbital.F90 b/components/mpas-seaice/src/column/ice_orbital.F90 deleted file mode 100644 index 45c3dd2b2b41..000000000000 --- a/components/mpas-seaice/src/column/ice_orbital.F90 +++ /dev/null @@ -1,686 +0,0 @@ -! SVN:$Id: ice_orbital.F90 1175 2017-03-02 19:53:26Z akt $ -!======================================================================= - -! Orbital parameters computed from date -! author: Bruce P. Briegleb, NCAR -! -! 2006 ECH: Converted to free source form (F90) -! 2014 ECH: Moved routines from csm_share/shr_orb_mod.F90 - - module ice_orbital - - use ice_kinds_mod - use ice_constants_colpkg, only: c2, p5, pi, secday - use ice_warnings, only: add_warning - - implicit none - private -#ifdef CCSMCOUPLED - public :: compute_coszen -#else - public :: shr_orb_params, compute_coszen -#endif - -!======================================================================= - - contains - -!======================================================================= - -! Uses orbital and lat/lon info to compute cosine solar zenith angle -! for the specified date. -! -! author: Bruce P. Briegleb, NCAR - - subroutine compute_coszen (tlat, tlon, & - calendar_type, days_per_year, & - nextsw_cday, yday, sec, & - coszen, dt) - - use ice_constants_colpkg, only: eccen, mvelpp, lambm0, obliqr, decln, eccf -#ifdef CCSMCOUPLED - use shr_orb_mod, only: shr_orb_decl -#endif - - real (kind=dbl_kind), intent(in) :: & - tlat, tlon ! latitude and longitude (radians) - - character (len=char_len), intent(in) :: & - calendar_type ! differentiates Gregorian from other calendars - - integer (kind=int_kind), intent(in) :: & - days_per_year, & ! number of days in one year - sec ! elapsed seconds into date - - real (kind=dbl_kind), intent(in) :: & - nextsw_cday , & ! julian day of next shortwave calculation - yday ! day of the year - - real (kind=dbl_kind), intent(inout) :: & - coszen ! cosine solar zenith angle - ! negative for sun below horizon - - real (kind=dbl_kind), intent(in) :: & - dt ! thermodynamic time step - - ! local variables - - real (kind=dbl_kind) :: ydayp1 ! day of year plus one time step - -! Solar declination for next time step - -#ifdef CCSMCOUPLED - if (calendar_type == "GREGORIAN") then - ydayp1 = min(nextsw_cday, real(days_per_year,kind=dbl_kind)) - else - ydayp1 = nextsw_cday - endif - - !--- update coszen when nextsw_cday valid - if (ydayp1 > -0.5_dbl_kind) then -#else - ydayp1 = yday + sec/secday -#endif - - call shr_orb_decl(ydayp1, eccen, mvelpp, lambm0, & - obliqr, decln, eccf) - - coszen = sin(tlat)*sin(decln) & - + cos(tlat)*cos(decln) & - *cos((sec/secday-p5)*c2*pi + tlon) !cos(hour angle) - -#ifdef CCSMCOUPLED - endif -#endif - - end subroutine compute_coszen - -!=============================================================================== - -#ifndef CCSMCOUPLED -SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & - & obliqr , lambm0, mvelpp, log_print, & - l_stop, stop_label) - -!------------------------------------------------------------------------------- -! -! Calculate earths orbital parameters using Dave Threshers formula which -! came from Berger, Andre. 1978 "A Simple Algorithm to Compute Long-Term -! Variations of Daily Insolation". Contribution 18, Institute of Astronomy -! and Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve, Belgium -! -!------------------------------Code history------------------------------------- -! -! Original Author: Erik Kluzek -! Date: Oct/97 -! -!------------------------------------------------------------------------------- - - !----------------------------- Arguments ------------------------------------ - integer(int_kind),intent(in) :: iyear_AD ! Year to calculate orbit for - real (dbl_kind),intent(inout) :: eccen ! orbital eccentricity - real (dbl_kind),intent(inout) :: obliq ! obliquity in degrees - real (dbl_kind),intent(inout) :: mvelp ! moving vernal equinox long - real (dbl_kind),intent(out) :: obliqr ! Earths obliquity in rad - real (dbl_kind),intent(out) :: lambm0 ! Mean long of perihelion at - ! vernal equinox (radians) - real (dbl_kind),intent(out) :: mvelpp ! moving vernal equinox long - ! of perihelion plus pi (rad) - logical(log_kind),intent(in) :: log_print ! Flags print of status/error - - logical(log_kind),intent(out) :: l_stop ! if true, abort model - character (len=char_len), intent(out) :: stop_label - - !------------------------------ Parameters ---------------------------------- - real (dbl_kind),parameter :: SHR_ORB_UNDEF_REAL = 1.e36_dbl_kind ! undefined real - integer(int_kind),parameter :: SHR_ORB_UNDEF_INT = 2000000000 ! undefined int - integer(int_kind),parameter :: poblen =47 ! # of elements in series wrt obliquity - integer(int_kind),parameter :: pecclen=19 ! # of elements in series wrt eccentricity - integer(int_kind),parameter :: pmvelen=78 ! # of elements in series wrt vernal equinox - real (dbl_kind),parameter :: psecdeg = 1.0_dbl_kind/3600.0_dbl_kind ! arc sec to deg conversion - - real (dbl_kind) :: degrad = pi/180._dbl_kind ! degree to radian conversion factor - real (dbl_kind) :: yb4_1950AD ! number of years before 1950 AD - - real (dbl_kind),parameter :: SHR_ORB_ECCEN_MIN = 0.0_dbl_kind ! min value for eccen - real (dbl_kind),parameter :: SHR_ORB_ECCEN_MAX = 0.1_dbl_kind ! max value for eccen - real (dbl_kind),parameter :: SHR_ORB_OBLIQ_MIN = -90.0_dbl_kind ! min value for obliq - real (dbl_kind),parameter :: SHR_ORB_OBLIQ_MAX = +90.0_dbl_kind ! max value for obliq - real (dbl_kind),parameter :: SHR_ORB_MVELP_MIN = 0.0_dbl_kind ! min value for mvelp - real (dbl_kind),parameter :: SHR_ORB_MVELP_MAX = 360.0_dbl_kind ! max value for mvelp - - character(len=*),parameter :: subname = '(shr_orb_params)' - - ! Cosine series data for computation of obliquity: amplitude (arc seconds), - ! rate (arc seconds/year), phase (degrees). - - real (dbl_kind), parameter :: obamp(poblen) = & ! amplitudes for obliquity cos series - & (/ -2462.2214466_dbl_kind, -857.3232075_dbl_kind, -629.3231835_dbl_kind, & - & -414.2804924_dbl_kind, -311.7632587_dbl_kind, 308.9408604_dbl_kind, & - & -162.5533601_dbl_kind, -116.1077911_dbl_kind, 101.1189923_dbl_kind, & - & -67.6856209_dbl_kind, 24.9079067_dbl_kind, 22.5811241_dbl_kind, & - & -21.1648355_dbl_kind, -15.6549876_dbl_kind, 15.3936813_dbl_kind, & - & 14.6660938_dbl_kind, -11.7273029_dbl_kind, 10.2742696_dbl_kind, & - & 6.4914588_dbl_kind, 5.8539148_dbl_kind, -5.4872205_dbl_kind, & - & -5.4290191_dbl_kind, 5.1609570_dbl_kind, 5.0786314_dbl_kind, & - & -4.0735782_dbl_kind, 3.7227167_dbl_kind, 3.3971932_dbl_kind, & - & -2.8347004_dbl_kind, -2.6550721_dbl_kind, -2.5717867_dbl_kind, & - & -2.4712188_dbl_kind, 2.4625410_dbl_kind, 2.2464112_dbl_kind, & - & -2.0755511_dbl_kind, -1.9713669_dbl_kind, -1.8813061_dbl_kind, & - & -1.8468785_dbl_kind, 1.8186742_dbl_kind, 1.7601888_dbl_kind, & - & -1.5428851_dbl_kind, 1.4738838_dbl_kind, -1.4593669_dbl_kind, & - & 1.4192259_dbl_kind, -1.1818980_dbl_kind, 1.1756474_dbl_kind, & - & -1.1316126_dbl_kind, 1.0896928_dbl_kind/) - - real (dbl_kind), parameter :: obrate(poblen) = & ! rates for obliquity cosine series - & (/ 31.609974_dbl_kind, 32.620504_dbl_kind, 24.172203_dbl_kind, & - & 31.983787_dbl_kind, 44.828336_dbl_kind, 30.973257_dbl_kind, & - & 43.668246_dbl_kind, 32.246691_dbl_kind, 30.599444_dbl_kind, & - & 42.681324_dbl_kind, 43.836462_dbl_kind, 47.439436_dbl_kind, & - & 63.219948_dbl_kind, 64.230478_dbl_kind, 1.010530_dbl_kind, & - & 7.437771_dbl_kind, 55.782177_dbl_kind, 0.373813_dbl_kind, & - & 13.218362_dbl_kind, 62.583231_dbl_kind, 63.593761_dbl_kind, & - & 76.438310_dbl_kind, 45.815258_dbl_kind, 8.448301_dbl_kind, & - & 56.792707_dbl_kind, 49.747842_dbl_kind, 12.058272_dbl_kind, & - & 75.278220_dbl_kind, 65.241008_dbl_kind, 64.604291_dbl_kind, & - & 1.647247_dbl_kind, 7.811584_dbl_kind, 12.207832_dbl_kind, & - & 63.856665_dbl_kind, 56.155990_dbl_kind, 77.448840_dbl_kind, & - & 6.801054_dbl_kind, 62.209418_dbl_kind, 20.656133_dbl_kind, & - & 48.344406_dbl_kind, 55.145460_dbl_kind, 69.000539_dbl_kind, & - & 11.071350_dbl_kind, 74.291298_dbl_kind, 11.047742_dbl_kind, & - & 0.636717_dbl_kind, 12.844549_dbl_kind/) - - real (dbl_kind), parameter :: obphas(poblen) = & ! phases for obliquity cosine series - & (/ 251.9025_dbl_kind, 280.8325_dbl_kind, 128.3057_dbl_kind, & - & 292.7252_dbl_kind, 15.3747_dbl_kind, 263.7951_dbl_kind, & - & 308.4258_dbl_kind, 240.0099_dbl_kind, 222.9725_dbl_kind, & - & 268.7809_dbl_kind, 316.7998_dbl_kind, 319.6024_dbl_kind, & - & 143.8050_dbl_kind, 172.7351_dbl_kind, 28.9300_dbl_kind, & - & 123.5968_dbl_kind, 20.2082_dbl_kind, 40.8226_dbl_kind, & - & 123.4722_dbl_kind, 155.6977_dbl_kind, 184.6277_dbl_kind, & - & 267.2772_dbl_kind, 55.0196_dbl_kind, 152.5268_dbl_kind, & - & 49.1382_dbl_kind, 204.6609_dbl_kind, 56.5233_dbl_kind, & - & 200.3284_dbl_kind, 201.6651_dbl_kind, 213.5577_dbl_kind, & - & 17.0374_dbl_kind, 164.4194_dbl_kind, 94.5422_dbl_kind, & - & 131.9124_dbl_kind, 61.0309_dbl_kind, 296.2073_dbl_kind, & - & 135.4894_dbl_kind, 114.8750_dbl_kind, 247.0691_dbl_kind, & - & 256.6114_dbl_kind, 32.1008_dbl_kind, 143.6804_dbl_kind, & - & 16.8784_dbl_kind, 160.6835_dbl_kind, 27.5932_dbl_kind, & - & 348.1074_dbl_kind, 82.6496_dbl_kind/) - - ! Cosine/sine series data for computation of eccentricity and fixed vernal - ! equinox longitude of perihelion (fvelp): amplitude, - ! rate (arc seconds/year), phase (degrees). - - real (dbl_kind), parameter :: ecamp (pecclen) = & ! ampl for eccen/fvelp cos/sin series - & (/ 0.01860798_dbl_kind, 0.01627522_dbl_kind, -0.01300660_dbl_kind, & - & 0.00988829_dbl_kind, -0.00336700_dbl_kind, 0.00333077_dbl_kind, & - & -0.00235400_dbl_kind, 0.00140015_dbl_kind, 0.00100700_dbl_kind, & - & 0.00085700_dbl_kind, 0.00064990_dbl_kind, 0.00059900_dbl_kind, & - & 0.00037800_dbl_kind, -0.00033700_dbl_kind, 0.00027600_dbl_kind, & - & 0.00018200_dbl_kind, -0.00017400_dbl_kind, -0.00012400_dbl_kind, & - & 0.00001250_dbl_kind/) - - real (dbl_kind), parameter :: ecrate(pecclen) = & ! rates for eccen/fvelp cos/sin series - & (/ 4.2072050_dbl_kind, 7.3460910_dbl_kind, 17.8572630_dbl_kind, & - & 17.2205460_dbl_kind, 16.8467330_dbl_kind, 5.1990790_dbl_kind, & - & 18.2310760_dbl_kind, 26.2167580_dbl_kind, 6.3591690_dbl_kind, & - & 16.2100160_dbl_kind, 3.0651810_dbl_kind, 16.5838290_dbl_kind, & - & 18.4939800_dbl_kind, 6.1909530_dbl_kind, 18.8677930_dbl_kind, & - & 17.4255670_dbl_kind, 6.1860010_dbl_kind, 18.4174410_dbl_kind, & - & 0.6678630_dbl_kind/) - - real (dbl_kind), parameter :: ecphas(pecclen) = & ! phases for eccen/fvelp cos/sin series - & (/ 28.620089_dbl_kind, 193.788772_dbl_kind, 308.307024_dbl_kind, & - & 320.199637_dbl_kind, 279.376984_dbl_kind, 87.195000_dbl_kind, & - & 349.129677_dbl_kind, 128.443387_dbl_kind, 154.143880_dbl_kind, & - & 291.269597_dbl_kind, 114.860583_dbl_kind, 332.092251_dbl_kind, & - & 296.414411_dbl_kind, 145.769910_dbl_kind, 337.237063_dbl_kind, & - & 152.092288_dbl_kind, 126.839891_dbl_kind, 210.667199_dbl_kind, & - & 72.108838_dbl_kind/) - - ! Sine series data for computation of moving vernal equinox longitude of - ! perihelion: amplitude (arc seconds), rate (arc sec/year), phase (degrees). - - real (dbl_kind), parameter :: mvamp (pmvelen) = & ! amplitudes for mvelp sine series - & (/ 7391.0225890_dbl_kind, 2555.1526947_dbl_kind, 2022.7629188_dbl_kind, & - & -1973.6517951_dbl_kind, 1240.2321818_dbl_kind, 953.8679112_dbl_kind, & - & -931.7537108_dbl_kind, 872.3795383_dbl_kind, 606.3544732_dbl_kind, & - & -496.0274038_dbl_kind, 456.9608039_dbl_kind, 346.9462320_dbl_kind, & - & -305.8412902_dbl_kind, 249.6173246_dbl_kind, -199.1027200_dbl_kind, & - & 191.0560889_dbl_kind, -175.2936572_dbl_kind, 165.9068833_dbl_kind, & - & 161.1285917_dbl_kind, 139.7878093_dbl_kind, -133.5228399_dbl_kind, & - & 117.0673811_dbl_kind, 104.6907281_dbl_kind, 95.3227476_dbl_kind, & - & 86.7824524_dbl_kind, 86.0857729_dbl_kind, 70.5893698_dbl_kind, & - & -69.9719343_dbl_kind, -62.5817473_dbl_kind, 61.5450059_dbl_kind, & - & -57.9364011_dbl_kind, 57.1899832_dbl_kind, -57.0236109_dbl_kind, & - & -54.2119253_dbl_kind, 53.2834147_dbl_kind, 52.1223575_dbl_kind, & - & -49.0059908_dbl_kind, -48.3118757_dbl_kind, -45.4191685_dbl_kind, & - & -42.2357920_dbl_kind, -34.7971099_dbl_kind, 34.4623613_dbl_kind, & - & -33.8356643_dbl_kind, 33.6689362_dbl_kind, -31.2521586_dbl_kind, & - & -30.8798701_dbl_kind, 28.4640769_dbl_kind, -27.1960802_dbl_kind, & - & 27.0860736_dbl_kind, -26.3437456_dbl_kind, 24.7253740_dbl_kind, & - & 24.6732126_dbl_kind, 24.4272733_dbl_kind, 24.0127327_dbl_kind, & - & 21.7150294_dbl_kind, -21.5375347_dbl_kind, 18.1148363_dbl_kind, & - & -16.9603104_dbl_kind, -16.1765215_dbl_kind, 15.5567653_dbl_kind, & - & 15.4846529_dbl_kind, 15.2150632_dbl_kind, 14.5047426_dbl_kind, & - & -14.3873316_dbl_kind, 13.1351419_dbl_kind, 12.8776311_dbl_kind, & - & 11.9867234_dbl_kind, 11.9385578_dbl_kind, 11.7030822_dbl_kind, & - & 11.6018181_dbl_kind, -11.2617293_dbl_kind, -10.4664199_dbl_kind, & - & 10.4333970_dbl_kind, -10.2377466_dbl_kind, 10.1934446_dbl_kind, & - & -10.1280191_dbl_kind, 10.0289441_dbl_kind, -10.0034259_dbl_kind/) - - real (dbl_kind), parameter :: mvrate(pmvelen) = & ! rates for mvelp sine series - & (/ 31.609974_dbl_kind, 32.620504_dbl_kind, 24.172203_dbl_kind, & - & 0.636717_dbl_kind, 31.983787_dbl_kind, 3.138886_dbl_kind, & - & 30.973257_dbl_kind, 44.828336_dbl_kind, 0.991874_dbl_kind, & - & 0.373813_dbl_kind, 43.668246_dbl_kind, 32.246691_dbl_kind, & - & 30.599444_dbl_kind, 2.147012_dbl_kind, 10.511172_dbl_kind, & - & 42.681324_dbl_kind, 13.650058_dbl_kind, 0.986922_dbl_kind, & - & 9.874455_dbl_kind, 13.013341_dbl_kind, 0.262904_dbl_kind, & - & 0.004952_dbl_kind, 1.142024_dbl_kind, 63.219948_dbl_kind, & - & 0.205021_dbl_kind, 2.151964_dbl_kind, 64.230478_dbl_kind, & - & 43.836462_dbl_kind, 47.439436_dbl_kind, 1.384343_dbl_kind, & - & 7.437771_dbl_kind, 18.829299_dbl_kind, 9.500642_dbl_kind, & - & 0.431696_dbl_kind, 1.160090_dbl_kind, 55.782177_dbl_kind, & - & 12.639528_dbl_kind, 1.155138_dbl_kind, 0.168216_dbl_kind, & - & 1.647247_dbl_kind, 10.884985_dbl_kind, 5.610937_dbl_kind, & - & 12.658184_dbl_kind, 1.010530_dbl_kind, 1.983748_dbl_kind, & - & 14.023871_dbl_kind, 0.560178_dbl_kind, 1.273434_dbl_kind, & - & 12.021467_dbl_kind, 62.583231_dbl_kind, 63.593761_dbl_kind, & - & 76.438310_dbl_kind, 4.280910_dbl_kind, 13.218362_dbl_kind, & - & 17.818769_dbl_kind, 8.359495_dbl_kind, 56.792707_dbl_kind, & - & 8.448301_dbl_kind, 1.978796_dbl_kind, 8.863925_dbl_kind, & - & 0.186365_dbl_kind, 8.996212_dbl_kind, 6.771027_dbl_kind, & - & 45.815258_dbl_kind, 12.002811_dbl_kind, 75.278220_dbl_kind, & - & 65.241008_dbl_kind, 18.870667_dbl_kind, 22.009553_dbl_kind, & - & 64.604291_dbl_kind, 11.498094_dbl_kind, 0.578834_dbl_kind, & - & 9.237738_dbl_kind, 49.747842_dbl_kind, 2.147012_dbl_kind, & - & 1.196895_dbl_kind, 2.133898_dbl_kind, 0.173168_dbl_kind/) - - real (dbl_kind), parameter :: mvphas(pmvelen) = & ! phases for mvelp sine series - & (/ 251.9025_dbl_kind, 280.8325_dbl_kind, 128.3057_dbl_kind, & - & 348.1074_dbl_kind, 292.7252_dbl_kind, 165.1686_dbl_kind, & - & 263.7951_dbl_kind, 15.3747_dbl_kind, 58.5749_dbl_kind, & - & 40.8226_dbl_kind, 308.4258_dbl_kind, 240.0099_dbl_kind, & - & 222.9725_dbl_kind, 106.5937_dbl_kind, 114.5182_dbl_kind, & - & 268.7809_dbl_kind, 279.6869_dbl_kind, 39.6448_dbl_kind, & - & 126.4108_dbl_kind, 291.5795_dbl_kind, 307.2848_dbl_kind, & - & 18.9300_dbl_kind, 273.7596_dbl_kind, 143.8050_dbl_kind, & - & 191.8927_dbl_kind, 125.5237_dbl_kind, 172.7351_dbl_kind, & - & 316.7998_dbl_kind, 319.6024_dbl_kind, 69.7526_dbl_kind, & - & 123.5968_dbl_kind, 217.6432_dbl_kind, 85.5882_dbl_kind, & - & 156.2147_dbl_kind, 66.9489_dbl_kind, 20.2082_dbl_kind, & - & 250.7568_dbl_kind, 48.0188_dbl_kind, 8.3739_dbl_kind, & - & 17.0374_dbl_kind, 155.3409_dbl_kind, 94.1709_dbl_kind, & - & 221.1120_dbl_kind, 28.9300_dbl_kind, 117.1498_dbl_kind, & - & 320.5095_dbl_kind, 262.3602_dbl_kind, 336.2148_dbl_kind, & - & 233.0046_dbl_kind, 155.6977_dbl_kind, 184.6277_dbl_kind, & - & 267.2772_dbl_kind, 78.9281_dbl_kind, 123.4722_dbl_kind, & - & 188.7132_dbl_kind, 180.1364_dbl_kind, 49.1382_dbl_kind, & - & 152.5268_dbl_kind, 98.2198_dbl_kind, 97.4808_dbl_kind, & - & 221.5376_dbl_kind, 168.2438_dbl_kind, 161.1199_dbl_kind, & - & 55.0196_dbl_kind, 262.6495_dbl_kind, 200.3284_dbl_kind, & - & 201.6651_dbl_kind, 294.6547_dbl_kind, 99.8233_dbl_kind, & - & 213.5577_dbl_kind, 154.1631_dbl_kind, 232.7153_dbl_kind, & - & 138.3034_dbl_kind, 204.6609_dbl_kind, 106.5938_dbl_kind, & - & 250.4676_dbl_kind, 332.3345_dbl_kind, 27.3039_dbl_kind/) - - !---------------------------Local variables---------------------------------- - integer(int_kind) :: i ! Index for series summations - real (dbl_kind) :: obsum ! Obliquity series summation - real (dbl_kind) :: cossum ! Cos series summation for eccentricity/fvelp - real (dbl_kind) :: sinsum ! Sin series summation for eccentricity/fvelp - real (dbl_kind) :: fvelp ! Fixed vernal equinox long of perihelion - real (dbl_kind) :: mvsum ! mvelp series summation - real (dbl_kind) :: beta ! Intermediate argument for lambm0 - real (dbl_kind) :: years ! Years to time of interest ( pos <=> future) - real (dbl_kind) :: eccen2 ! eccentricity squared - real (dbl_kind) :: eccen3 ! eccentricity cubed - integer (int_kind), parameter :: s_loglev = 0 - character(len=char_len_long) :: warning ! warning message - - !-------------------------- Formats ----------------------------------------- - character(*),parameter :: svnID = "SVN " // & - "$Id: ice_orbital.F90 1175 2017-03-02 19:53:26Z akt $" - character(*),parameter :: svnURL = "SVN " -! character(*),parameter :: svnURL = "SVN " // & -! "$URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_121022/shr/shr_orb_mod.F90 $" - character(len=*),parameter :: F00 = "('(shr_orb_params) ',4a)" - character(len=*),parameter :: F01 = "('(shr_orb_params) ',a,i9)" - character(len=*),parameter :: F02 = "('(shr_orb_params) ',a,f6.3)" - character(len=*),parameter :: F03 = "('(shr_orb_params) ',a,es14.6)" - - !---------------------------------------------------------------------------- - ! radinp and algorithms below will need a degree to radian conversion factor - - l_stop = .false. - stop_label = ' ' - - if ( log_print .and. s_loglev > 0 ) then - write(warning,F00) 'Calculate characteristics of the orbit:' - call add_warning(warning) - write(warning,F00) svnID - call add_warning(warning) -! write(warning,F00) svnURL -! call add_warning(warning) - end if - - ! Check for flag to use input orbit parameters - - IF ( iyear_AD == SHR_ORB_UNDEF_INT ) THEN - - ! Check input obliq, eccen, and mvelp to ensure reasonable - - if( obliq == SHR_ORB_UNDEF_REAL )then - write(warning,F00) trim(subname)//' Have to specify orbital parameters:' - call add_warning(warning) - write(warning,F00) 'Either set: iyear_AD, OR [obliq, eccen, and mvelp]:' - call add_warning(warning) - write(warning,F00) 'iyear_AD is the year to simulate orbit for (ie. 1950): ' - call add_warning(warning) - write(warning,F00) 'obliq, eccen, mvelp specify the orbit directly:' - call add_warning(warning) - write(warning,F00) 'The AMIP II settings (for a 1995 orbit) are: ' - call add_warning(warning) - write(warning,F00) ' obliq = 23.4441' - call add_warning(warning) - write(warning,F00) ' eccen = 0.016715' - call add_warning(warning) - write(warning,F00) ' mvelp = 102.7' - call add_warning(warning) - l_stop = .true. - stop_label = 'unreasonable oblip' - else if ( log_print ) then - write(warning,F00) 'Use input orbital parameters: ' - call add_warning(warning) - end if - if( (obliq < SHR_ORB_OBLIQ_MIN).or.(obliq > SHR_ORB_OBLIQ_MAX) ) then - write(warning,F03) 'Input obliquity unreasonable: ', obliq - call add_warning(warning) - l_stop = .true. - stop_label = 'unreasonable obliq' - end if - if( (eccen < SHR_ORB_ECCEN_MIN).or.(eccen > SHR_ORB_ECCEN_MAX) ) then - write(warning,F03) 'Input eccentricity unreasonable: ', eccen - call add_warning(warning) - l_stop = .true. - stop_label = 'unreasonable eccen' - end if - if( (mvelp < SHR_ORB_MVELP_MIN).or.(mvelp > SHR_ORB_MVELP_MAX) ) then - write(warning,F03) 'Input mvelp unreasonable: ' , mvelp - call add_warning(warning) - l_stop = .true. - stop_label = 'unreasonable mvelp' - end if - eccen2 = eccen*eccen - eccen3 = eccen2*eccen - - ELSE ! Otherwise calculate based on years before present - - if ( log_print .and. s_loglev > 0) then - write(warning,F01) 'Calculate orbit for year: ' , iyear_AD - call add_warning(warning) - end if - yb4_1950AD = 1950.0_dbl_kind - real(iyear_AD,dbl_kind) - if ( abs(yb4_1950AD) .gt. 1000000.0_dbl_kind )then - write(warning,F00) 'orbit only valid for years+-1000000' - call add_warning(warning) - write(warning,F00) 'Relative to 1950 AD' - call add_warning(warning) - write(warning,F03) '# of years before 1950: ',yb4_1950AD - call add_warning(warning) - write(warning,F01) 'Year to simulate was : ',iyear_AD - call add_warning(warning) - l_stop = .true. - stop_label = 'unreasonable year' - end if - - ! The following calculates the earths obliquity, orbital eccentricity - ! (and various powers of it) and vernal equinox mean longitude of - ! perihelion for years in the past (future = negative of years past), - ! using constants (see parameter section) given in the program of: - ! - ! Berger, Andre. 1978 A Simple Algorithm to Compute Long-Term Variations - ! of Daily Insolation. Contribution 18, Institute of Astronomy and - ! Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve, Belgium. - ! - ! and formulas given in the paper (where less precise constants are also - ! given): - ! - ! Berger, Andre. 1978. Long-Term Variations of Daily Insolation and - ! Quaternary Climatic Changes. J. of the Atmo. Sci. 35:2362-2367 - ! - ! The algorithm is valid only to 1,000,000 years past or hence. - ! For a solution valid to 5-10 million years past see the above author. - ! Algorithm below is better for years closer to present than is the - ! 5-10 million year solution. - ! - ! Years to time of interest must be negative of years before present - ! (1950) in formulas that follow. - - years = - yb4_1950AD - - ! In the summations below, cosine or sine arguments, which end up in - ! degrees, must be converted to radians via multiplication by degrad. - ! - ! Summation of cosine series for obliquity (epsilon in Berger 1978) in - ! degrees. Convert the amplitudes and rates, which are in arc secs, into - ! degrees via multiplication by psecdeg (arc seconds to degrees conversion - ! factor). For obliq, first term is Berger 1978 epsilon star; second - ! term is series summation in degrees. - - obsum = 0.0_dbl_kind - do i = 1, poblen - obsum = obsum + obamp(i)*psecdeg*cos((obrate(i)*psecdeg*years + & - & obphas(i))*degrad) - end do - obliq = 23.320556_dbl_kind + obsum - - ! Summation of cosine and sine series for computation of eccentricity - ! (eccen; e in Berger 1978) and fixed vernal equinox longitude of - ! perihelion (fvelp; pi in Berger 1978), which is used for computation - ! of moving vernal equinox longitude of perihelion. Convert the rates, - ! which are in arc seconds, into degrees via multiplication by psecdeg. - - cossum = 0.0_dbl_kind - do i = 1, pecclen - cossum = cossum+ecamp(i)*cos((ecrate(i)*psecdeg*years+ecphas(i))*degrad) - end do - - sinsum = 0.0_dbl_kind - do i = 1, pecclen - sinsum = sinsum+ecamp(i)*sin((ecrate(i)*psecdeg*years+ecphas(i))*degrad) - end do - - ! Use summations to calculate eccentricity - - eccen2 = cossum*cossum + sinsum*sinsum - eccen = sqrt(eccen2) - eccen3 = eccen2*eccen - - ! A series of cases for fvelp, which is in radians. - - if (abs(cossum) .le. 1.0E-8_dbl_kind) then - if (sinsum .eq. 0.0_dbl_kind) then - fvelp = 0.0_dbl_kind - else if (sinsum .lt. 0.0_dbl_kind) then - fvelp = 1.5_dbl_kind*pi - else if (sinsum .gt. 0.0_dbl_kind) then - fvelp = .5_dbl_kind*pi - endif - else if (cossum .lt. 0.0_dbl_kind) then - fvelp = atan(sinsum/cossum) + pi - else if (cossum .gt. 0.0_dbl_kind) then - if (sinsum .lt. 0.0_dbl_kind) then - fvelp = atan(sinsum/cossum) + 2.0_dbl_kind*pi - else - fvelp = atan(sinsum/cossum) - endif - endif - - ! Summation of sin series for computation of moving vernal equinox long - ! of perihelion (mvelp; omega bar in Berger 1978) in degrees. For mvelp, - ! first term is fvelp in degrees; second term is Berger 1978 psi bar - ! times years and in degrees; third term is Berger 1978 zeta; fourth - ! term is series summation in degrees. Convert the amplitudes and rates, - ! which are in arc seconds, into degrees via multiplication by psecdeg. - ! Series summation plus second and third terms constitute Berger 1978 - ! psi, which is the general precession. - - mvsum = 0.0_dbl_kind - do i = 1, pmvelen - mvsum = mvsum + mvamp(i)*psecdeg*sin((mvrate(i)*psecdeg*years + & - & mvphas(i))*degrad) - end do - mvelp = fvelp/degrad + 50.439273_dbl_kind*psecdeg*years + 3.392506_dbl_kind + mvsum - - ! Cases to make sure mvelp is between 0 and 360. - - do while (mvelp .lt. 0.0_dbl_kind) - mvelp = mvelp + 360.0_dbl_kind - end do - do while (mvelp .ge. 360.0_dbl_kind) - mvelp = mvelp - 360.0_dbl_kind - end do - - END IF ! end of test on whether to calculate or use input orbital params - - ! Orbit needs the obliquity in radians - - obliqr = obliq*degrad - - ! 180 degrees must be added to mvelp since observations are made from the - ! earth and the sun is considered (wrongly for the algorithm) to go around - ! the earth. For a more graphic explanation see Appendix B in: - ! - ! A. Berger, M. Loutre and C. Tricot. 1993. Insolation and Earth Orbital - ! Periods. J. of Geophysical Research 98:10,341-10,362. - ! - ! Additionally, orbit will need this value in radians. So mvelp becomes - ! mvelpp (mvelp plus pi) - - mvelpp = (mvelp + 180._dbl_kind)*degrad - - ! Set up an argument used several times in lambm0 calculation ahead. - - beta = sqrt(1._dbl_kind - eccen2) - - ! The mean longitude at the vernal equinox (lambda m nought in Berger - ! 1978; in radians) is calculated from the following formula given in - ! Berger 1978. At the vernal equinox the true longitude (lambda in Berger - ! 1978) is 0. - - lambm0 = 2._dbl_kind*((.5_dbl_kind*eccen + .125_dbl_kind*eccen3)*(1._dbl_kind + beta)*sin(mvelpp) & - & - .250_dbl_kind*eccen2*(.5_dbl_kind + beta)*sin(2._dbl_kind*mvelpp) & - & + .125_dbl_kind*eccen3*(1._dbl_kind/3._dbl_kind + beta)*sin(3._dbl_kind*mvelpp)) - - if ( log_print ) then - write(warning,F03) '------ Computed Orbital Parameters ------' - call add_warning(warning) - write(warning,F03) 'Eccentricity = ',eccen - call add_warning(warning) - write(warning,F03) 'Obliquity (deg) = ',obliq - call add_warning(warning) - write(warning,F03) 'Obliquity (rad) = ',obliqr - call add_warning(warning) - write(warning,F03) 'Long of perh(deg) = ',mvelp - call add_warning(warning) - write(warning,F03) 'Long of perh(rad) = ',mvelpp - call add_warning(warning) - write(warning,F03) 'Long at v.e.(rad) = ',lambm0 - call add_warning(warning) - write(warning,F03) '-----------------------------------------' - call add_warning(warning) - end if - -END SUBROUTINE shr_orb_params - -!=============================================================================== - -SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf) - -!------------------------------------------------------------------------------- -! -! Compute earth/orbit parameters using formula suggested by -! Duane Thresher. -! -!---------------------------Code history---------------------------------------- -! -! Original version: Erik Kluzek -! Date: Oct/1997 -! -!------------------------------------------------------------------------------- - - !------------------------------Arguments-------------------------------- - real (dbl_kind),intent(in) :: calday ! Calendar day, including fraction - real (dbl_kind),intent(in) :: eccen ! Eccentricity - real (dbl_kind),intent(in) :: obliqr ! Earths obliquity in radians - real (dbl_kind),intent(in) :: lambm0 ! Mean long of perihelion at the - ! vernal equinox (radians) - real (dbl_kind),intent(in) :: mvelpp ! moving vernal equinox longitude - ! of perihelion plus pi (radians) - real (dbl_kind),intent(out) :: delta ! Solar declination angle in rad - real (dbl_kind),intent(out) :: eccf ! Earth-sun distance factor (ie. (1/r)**2) - - !---------------------------Local variables----------------------------- - real (dbl_kind),parameter :: dayspy = 365.0_dbl_kind ! days per year - real (dbl_kind),parameter :: ve = 80.5_dbl_kind ! Calday of vernal equinox - ! assumes Jan 1 = calday 1 - - real (dbl_kind) :: lambm ! Lambda m, mean long of perihelion (rad) - real (dbl_kind) :: lmm ! Intermediate argument involving lambm - real (dbl_kind) :: lamb ! Lambda, the earths long of perihelion - real (dbl_kind) :: invrho ! Inverse normalized sun/earth distance - real (dbl_kind) :: sinl ! Sine of lmm - - ! Compute eccentricity factor and solar declination using - ! day value where a round day (such as 213.0) refers to 0z at - ! Greenwich longitude. - ! - ! Use formulas from Berger, Andre 1978: Long-Term Variations of Daily - ! Insolation and Quaternary Climatic Changes. J. of the Atmo. Sci. - ! 35:2362-2367. - ! - ! To get the earths true longitude (position in orbit; lambda in Berger - ! 1978) which is necessary to find the eccentricity factor and declination, - ! must first calculate the mean longitude (lambda m in Berger 1978) at - ! the present day. This is done by adding to lambm0 (the mean longitude - ! at the vernal equinox, set as March 21 at noon, when lambda=0; in radians) - ! an increment (delta lambda m in Berger 1978) that is the number of - ! days past or before (a negative increment) the vernal equinox divided by - ! the days in a model year times the 2*pi radians in a complete orbit. - - lambm = lambm0 + (calday - ve)*2._dbl_kind*pi/dayspy - lmm = lambm - mvelpp - - ! The earths true longitude, in radians, is then found from - ! the formula in Berger 1978: - - sinl = sin(lmm) - lamb = lambm + eccen*(2._dbl_kind*sinl + eccen*(1.25_dbl_kind*sin(2._dbl_kind*lmm) & - & + eccen*((13.0_dbl_kind/12.0_dbl_kind)*sin(3._dbl_kind*lmm) - 0.25_dbl_kind*sinl))) - - ! Using the obliquity, eccentricity, moving vernal equinox longitude of - ! perihelion (plus), and earths true longitude, the declination (delta) - ! and the normalized earth/sun distance (rho in Berger 1978; actually inverse - ! rho will be used), and thus the eccentricity factor (eccf), can be - ! calculated from formulas given in Berger 1978. - - invrho = (1._dbl_kind + eccen*cos(lamb - mvelpp)) / (1._dbl_kind - eccen*eccen) - - ! Set solar declination and eccentricity factor - - delta = asin(sin(obliqr)*sin(lamb)) - eccf = invrho*invrho - - return - -END SUBROUTINE shr_orb_decl -#endif - -!======================================================================= - - end module ice_orbital - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_shortwave.F90 b/components/mpas-seaice/src/column/ice_shortwave.F90 deleted file mode 100644 index 2a10a1c8a609..000000000000 --- a/components/mpas-seaice/src/column/ice_shortwave.F90 +++ /dev/null @@ -1,5419 +0,0 @@ -! SVN:$Id: ice_shortwave.F90 1182 2017-03-16 19:29:26Z njeffery $ -!======================================================================= -! -! The albedo and absorbed/transmitted flux parameterizations for -! snow over ice, bare ice and ponded ice. -! -! Presently, two methods are included: -! (1) CCSM3 -! (2) Delta-Eddington -! as two distinct routines. -! Either can be called from the ice driver. -! -! The Delta-Eddington method is described here: -! -! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple -! Scattering Parameterization for Solar Radiation in the Sea Ice -! Component of the Community Climate System Model, NCAR Technical -! Note NCAR/TN-472+STR February 2007 -! -! name: originally ice_albedo -! -! authors: Bruce P. Briegleb, NCAR -! Elizabeth C. Hunke and William H. Lipscomb, LANL -! 2005, WHL: Moved absorbed_solar from ice_therm_vertical to this -! module and changed name from ice_albedo -! 2006, WHL: Added Delta Eddington routines from Bruce Briegleb -! 2006, ECH: Changed data statements in Delta Eddington routines (no -! longer hardwired) -! Converted to free source form (F90) -! 2007, BPB: Completely updated Delta-Eddington code, so that: -! (1) multiple snow layers enabled (i.e. nslyr > 1) -! (2) included SSL for snow surface absorption -! (3) added Sswabs for internal snow layer absorption -! (4) variable sea ice layers allowed (i.e. not hardwired) -! (5) updated all inherent optical properties -! (6) included algae absorption for sea ice lowest layer -! (7) very complete internal documentation included -! 2007, ECH: Improved efficiency -! 2008, BPB: Added aerosols to Delta Eddington code -! 2013, ECH: merged with NCAR version, cleaned up - - module ice_shortwave - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c1p5, c2, c3, c4, c10, & - p01, p1, p15, p25, p5, p75, puny, & - albocn, Timelt, snowpatch, awtvdr, awtidr, awtvdf, awtidf, & - kappav, hs_min, rhofresh, rhos, nspint, nspint_5bd - use ice_colpkg_shared, only: hi_ssl, hs_ssl, modal_aero, max_aero - use ice_colpkg_shared, only: hi_ssl, hs_ssl, modal_aero, rsnw_fall, & - rsnw_tmax, snwlvlfac - use ice_warnings, only: add_warning - - implicit none - - private - public :: run_dEdd, shortwave_ccsm3, compute_shortwave_trcr - - real (kind=dbl_kind), parameter :: & - hpmin = 0.005_dbl_kind, & ! minimum allowed melt pond depth (m) - hp0 = 0.200_dbl_kind ! pond depth below which transition to bare ice - - real (kind=dbl_kind), parameter :: & - exp_argmax = c10 ! maximum argument of exponential - - real (kind=dbl_kind) :: & - exp_min ! minimum exponential value - -!======================================================================= - - contains - -!======================================================================= -! -! Driver for basic solar radiation from CCSM3. Albedos and absorbed solar. - - subroutine shortwave_ccsm3 (aicen, vicen, & - vsnon, Tsfcn, & - swvdr, swvdf, & - swidr, swidf, & - heat_capacity, & - albedo_type, & - albicev, albicei, & - albsnowv, albsnowi, & - ahmax, & - alvdrn, alidrn, & - alvdfn, alidfn, & - fswsfc, fswint, & - fswthru, fswpenl, & - Iswabs, SSwabs, & - albin, albsn, & - coszen, ncat) - - integer (kind=int_kind), intent(in) :: & - ncat ! number of ice thickness categories - - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen , & ! concentration of ice per category - vicen , & ! volume of ice per category - vsnon , & ! volume of ice per category - Tsfcn ! surface temperature - - real (kind=dbl_kind), intent(in) :: & - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf ! sw down, near IR, diffuse (W/m^2) - - ! baseline albedos for ccsm3 shortwave, set in namelist - real (kind=dbl_kind), intent(in) :: & - albicev , & ! visible ice albedo for h > ahmax - albicei , & ! near-ir ice albedo for h > ahmax - albsnowv, & ! cold snow albedo, visible - albsnowi, & ! cold snow albedo, near IR - ahmax ! thickness above which ice albedo is constant (m) - - logical(kind=log_kind), intent(in) :: & - heat_capacity! if true, ice has nonzero heat capacity - - character (len=char_len), intent(in) :: & - albedo_type ! albedo parameterization, 'default' ('ccsm3') or 'constant' - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - alvdrn , & ! visible, direct, avg (fraction) - alidrn , & ! near-ir, direct, avg (fraction) - alvdfn , & ! visible, diffuse, avg (fraction) - alidfn , & ! near-ir, diffuse, avg (fraction) - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - fswint , & ! SW absorbed in ice interior, below surface (W m-2) - fswthru , & ! SW through ice to ocean (W m-2) - albin , & ! bare ice albedo - albsn ! snow albedo - - real (kind=dbl_kind), intent(inout) :: & - coszen ! cosine(zenith angle) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - fswpenl , & ! SW entering ice layers (W m-2) - Iswabs , & ! SW absorbed in particular layer (W m-2) - Sswabs ! SW absorbed in particular layer (W m-2) - - ! local variables - - integer (kind=int_kind) :: & - n ! thickness category index - - ! ice and snow albedo for each category - - real (kind=dbl_kind) :: & - alvdrni, & ! visible, direct, ice (fraction) - alidrni, & ! near-ir, direct, ice (fraction) - alvdfni, & ! visible, diffuse, ice (fraction) - alidfni, & ! near-ir, diffuse, ice (fraction) - alvdrns, & ! visible, direct, snow (fraction) - alidrns, & ! near-ir, direct, snow (fraction) - alvdfns, & ! visible, diffuse, snow (fraction) - alidfns ! near-ir, diffuse, snow (fraction) - - !----------------------------------------------------------------- - ! Solar radiation: albedo and absorbed shortwave - !----------------------------------------------------------------- - - ! For basic shortwave, set coszen to a constant between 0 and 1. - coszen = p5 ! sun above the horizon - - do n = 1, ncat - - Sswabs(:,n) = c0 - - alvdrni = albocn - alidrni = albocn - alvdfni = albocn - alidfni = albocn - - alvdrns = albocn - alidrns = albocn - alvdfns = albocn - alidfns = albocn - - alvdrn(n) = albocn - alidrn(n) = albocn - alvdfn(n) = albocn - alidfn(n) = albocn - - albin(n) = c0 - albsn(n) = c0 - - fswsfc(n) = c0 - fswint(n) = c0 - fswthru(n) = c0 - fswpenl(:,n) = c0 - Iswabs (:,n) = c0 - - if (aicen(n) > puny) then - - !----------------------------------------------------------------- - ! Compute albedos for ice and snow. - !----------------------------------------------------------------- - - if (trim(albedo_type) == 'constant') then - - call constant_albedos (aicen(n), & - vsnon(n), & - Tsfcn(n), & - alvdrni, alidrni, & - alvdfni, alidfni, & - alvdrns, alidrns, & - alvdfns, alidfns, & - alvdrn(n), & - alidrn(n), & - alvdfn(n), & - alidfn(n), & - albin(n), & - albsn(n)) - else ! default - - call compute_albedos (aicen(n), & - vicen(n), & - vsnon(n), & - Tsfcn(n), & - albicev, albicei, & - albsnowv, albsnowi, & - ahmax, & - alvdrni, alidrni, & - alvdfni, alidfni, & - alvdrns, alidrns, & - alvdfns, alidfns, & - alvdrn(n), & - alidrn(n), & - alvdfn(n), & - alidfn(n), & - albin(n), & - albsn(n)) - endif - - !----------------------------------------------------------------- - ! Compute solar radiation absorbed in ice and penetrating to ocean. - !----------------------------------------------------------------- - - call absorbed_solar (heat_capacity, & - ncat, & - aicen(n), & - vicen(n), & - vsnon(n), & - swvdr, swvdf, & - swidr, swidf, & - alvdrni, alvdfni, & - alidrni, alidfni, & - alvdrns, alvdfns, & - alidrns, alidfns, & - fswsfc(n), & - fswint(n), & - fswthru(n), & - fswpenl(:,n), & - Iswabs(:,n)) - - endif ! aicen > puny - - enddo ! ncat - - end subroutine shortwave_ccsm3 - -!======================================================================= -! -! Compute albedos for each thickness category - - subroutine compute_albedos (aicen, vicen, & - vsnon, Tsfcn, & - albicev, albicei, & - albsnowv, albsnowi, & - ahmax, & - alvdrni, alidrni, & - alvdfni, alidfni, & - alvdrns, alidrns, & - alvdfns, alidfns, & - alvdrn, alidrn, & - alvdfn, alidfn, & - albin, albsn) - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice per category - vicen , & ! volume of ice per category - vsnon , & ! volume of ice per category - Tsfcn ! surface temperature - - ! baseline albedos for ccsm3 shortwave, set in namelist - real (kind=dbl_kind), intent(in) :: & - albicev , & ! visible ice albedo for h > ahmax - albicei , & ! near-ir ice albedo for h > ahmax - albsnowv, & ! cold snow albedo, visible - albsnowi, & ! cold snow albedo, near IR - ahmax ! thickness above which ice albedo is constant (m) - - real (kind=dbl_kind), intent(out) :: & - alvdrni , & ! visible, direct, ice (fraction) - alidrni , & ! near-ir, direct, ice (fraction) - alvdfni , & ! visible, diffuse, ice (fraction) - alidfni , & ! near-ir, diffuse, ice (fraction) - alvdrns , & ! visible, direct, snow (fraction) - alidrns , & ! near-ir, direct, snow (fraction) - alvdfns , & ! visible, diffuse, snow (fraction) - alidfns , & ! near-ir, diffuse, snow (fraction) - alvdrn , & ! visible, direct, avg (fraction) - alidrn , & ! near-ir, direct, avg (fraction) - alvdfn , & ! visible, diffuse, avg (fraction) - alidfn , & ! near-ir, diffuse, avg (fraction) - albin , & ! bare ice - albsn ! snow - - ! local variables - - real (kind=dbl_kind), parameter :: & - dT_melt = c1 , & ! change in temp to give dalb_mlt - ! albedo change - dalb_mlt = -0.075_dbl_kind, & ! albedo change per dT_melt change - ! in temp for ice - dalb_mltv = -p1 , & ! albedo vis change per dT_melt change - ! in temp for snow - dalb_mlti = -p15 ! albedo nir change per dT_melt change - ! in temp for snow - - real (kind=dbl_kind) :: & - hi , & ! ice thickness (m) - hs , & ! snow thickness (m) - albo, & ! effective ocean albedo, function of ice thickness - fh , & ! piecewise linear function of thickness - fT , & ! piecewise linear function of surface temperature - dTs , & ! difference of Tsfc and Timelt - fhtan,& ! factor used in albedo dependence on ice thickness - asnow ! fractional area of snow cover - - fhtan = atan(ahmax*c4) - - !----------------------------------------------------------------- - ! Compute albedo for each thickness category. - !----------------------------------------------------------------- - - hi = vicen / aicen - hs = vsnon / aicen - - ! bare ice, thickness dependence - fh = min(atan(hi*c4)/fhtan,c1) - albo = albocn*(c1-fh) - alvdfni = albicev*fh + albo - alidfni = albicei*fh + albo - - ! bare ice, temperature dependence - dTs = Timelt - Tsfcn - fT = min(dTs/dT_melt-c1,c0) - alvdfni = alvdfni - dalb_mlt*fT - alidfni = alidfni - dalb_mlt*fT - - ! avoid negative albedos for thin, bare, melting ice - alvdfni = max (alvdfni, albocn) - alidfni = max (alidfni, albocn) - - if (hs > puny) then - - alvdfns = albsnowv - alidfns = albsnowi - - ! snow on ice, temperature dependence - alvdfns = alvdfns - dalb_mltv*fT - alidfns = alidfns - dalb_mlti*fT - - endif ! hs > puny - - ! direct albedos (same as diffuse for now) - alvdrni = alvdfni - alidrni = alidfni - alvdrns = alvdfns - alidrns = alidfns - - ! fractional area of snow cover - if (hs > puny) then - asnow = hs / (hs + snowpatch) - else - asnow = c0 - endif - - ! combine ice and snow albedos (for coupler) - alvdfn = alvdfni*(c1-asnow) + & - alvdfns*asnow - alidfn = alidfni*(c1-asnow) + & - alidfns*asnow - alvdrn = alvdrni*(c1-asnow) + & - alvdrns*asnow - alidrn = alidrni*(c1-asnow) + & - alidrns*asnow - - ! save ice and snow albedos (for history) - albin = awtvdr*alvdrni + awtidr*alidrni & - + awtvdf*alvdfni + awtidf*alidfni - albsn = awtvdr*alvdrns + awtidr*alidrns & - + awtvdf*alvdfns + awtidf*alidfns - - end subroutine compute_albedos - -!======================================================================= -! -! Compute albedos for each thickness category - - subroutine constant_albedos (aicen, & - vsnon, Tsfcn, & - alvdrni, alidrni, & - alvdfni, alidfni, & - alvdrns, alidrns, & - alvdfns, alidfns, & - alvdrn, alidrn, & - alvdfn, alidfn, & - albin, albsn) - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice per category - vsnon , & ! volume of ice per category - Tsfcn ! surface temperature - - real (kind=dbl_kind), intent(out) :: & - alvdrni , & ! visible, direct, ice (fraction) - alidrni , & ! near-ir, direct, ice (fraction) - alvdfni , & ! visible, diffuse, ice (fraction) - alidfni , & ! near-ir, diffuse, ice (fraction) - alvdrns , & ! visible, direct, snow (fraction) - alidrns , & ! near-ir, direct, snow (fraction) - alvdfns , & ! visible, diffuse, snow (fraction) - alidfns , & ! near-ir, diffuse, snow (fraction) - alvdrn , & ! visible, direct, avg (fraction) - alidrn , & ! near-ir, direct, avg (fraction) - alvdfn , & ! visible, diffuse, avg (fraction) - alidfn , & ! near-ir, diffuse, avg (fraction) - albin , & ! bare ice - albsn ! snow - - ! local variables - - real (kind=dbl_kind), parameter :: & - warmice = 0.68_dbl_kind, & - coldice = 0.70_dbl_kind, & - warmsnow = 0.77_dbl_kind, & - coldsnow = 0.81_dbl_kind - - real (kind=dbl_kind) :: & - hs ! snow thickness (m) - - !----------------------------------------------------------------- - ! Compute albedo for each thickness category. - !----------------------------------------------------------------- - - hs = vsnon / aicen - - if (hs > puny) then - ! snow, temperature dependence - if (Tsfcn >= -c2*puny) then - alvdfn = warmsnow - alidfn = warmsnow - else - alvdfn = coldsnow - alidfn = coldsnow - endif - else ! hs < puny - ! bare ice, temperature dependence - if (Tsfcn >= -c2*puny) then - alvdfn = warmice - alidfn = warmice - else - alvdfn = coldice - alidfn = coldice - endif - endif ! hs > puny - - ! direct albedos (same as diffuse for now) - alvdrn = alvdfn - alidrn = alidfn - - alvdrni = alvdrn - alidrni = alidrn - alvdrns = alvdrn - alidrns = alidrn - alvdfni = alvdfn - alidfni = alidfn - alvdfns = alvdfn - alidfns = alidfn - - ! save ice and snow albedos (for history) - albin = awtvdr*alvdrni + awtidr*alidrni & - + awtvdf*alvdfni + awtidf*alidfni - albsn = awtvdr*alvdrns + awtidr*alidrns & - + awtvdf*alvdfns + awtidf*alidfns - - end subroutine constant_albedos - -!======================================================================= -! -! Compute solar radiation absorbed in ice and penetrating to ocean -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine absorbed_solar (heat_capacity, & - nilyr, aicen, & - vicen, vsnon, & - swvdr, swvdf, & - swidr, swidf, & - alvdrni, alvdfni, & - alidrni, alidfni, & - alvdrns, alvdfns, & - alidrns, alidfns, & - fswsfc, fswint, & - fswthru, fswpenl, & - Iswabs) - - logical(kind=log_kind), intent(in) :: & - heat_capacity ! if true, ice has nonzero heat capacity - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! fractional ice area - vicen , & ! ice volume - vsnon , & ! snow volume - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf , & ! sw down, near IR, diffuse (W/m^2) - alvdrni , & ! visible, direct albedo,ice - alidrni , & ! near-ir, direct albedo,ice - alvdfni , & ! visible, diffuse albedo,ice - alidfni , & ! near-ir, diffuse albedo,ice - alvdrns , & ! visible, direct albedo, snow - alidrns , & ! near-ir, direct albedo, snow - alvdfns , & ! visible, diffuse albedo, snow - alidfns ! near-ir, diffuse albedo, snow - - real (kind=dbl_kind), intent(out):: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - fswint , & ! SW absorbed in ice interior, below surface (W m-2) - fswthru ! SW through ice to ocean (W m-2) - - real (kind=dbl_kind), dimension (:), intent(out) :: & - Iswabs , & ! SW absorbed in particular layer (W m-2) - fswpenl ! visible SW entering ice layers (W m-2) - - ! local variables - - real (kind=dbl_kind), parameter :: & - i0vis = 0.70_dbl_kind ! fraction of penetrating solar rad (visible) - - integer (kind=int_kind) :: & - k ! ice layer index - - real (kind=dbl_kind) :: & - fswpen , & ! SW penetrating beneath surface (W m-2) - trantop , & ! transmitted frac of penetrating SW at layer top - tranbot ! transmitted frac of penetrating SW at layer bot - - real (kind=dbl_kind) :: & - swabs , & ! net SW down at surface (W m-2) - swabsv , & ! swabs in vis (wvlngth < 700nm) (W/m^2) - swabsi , & ! swabs in nir (wvlngth > 700nm) (W/m^2) - fswpenvdr , & ! penetrating SW, vis direct - fswpenvdf , & ! penetrating SW, vis diffuse - hi , & ! ice thickness (m) - hs , & ! snow thickness (m) - hilyr , & ! ice layer thickness - asnow ! fractional area of snow cover - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - trantop = c0 - tranbot = c0 - - hs = vsnon / aicen - - !----------------------------------------------------------------- - ! Fractional snow cover - !----------------------------------------------------------------- - if (hs > puny) then - asnow = hs / (hs + snowpatch) - else - asnow = c0 - endif - - !----------------------------------------------------------------- - ! Shortwave flux absorbed at surface, absorbed internally, - ! and penetrating to mixed layer. - ! This parameterization assumes that all IR is absorbed at the - ! surface; only visible is absorbed in the ice interior or - ! transmitted to the ocean. - !----------------------------------------------------------------- - - swabsv = swvdr * ( (c1-alvdrni)*(c1-asnow) & - + (c1-alvdrns)*asnow ) & - + swvdf * ( (c1-alvdfni)*(c1-asnow) & - + (c1-alvdfns)*asnow ) - - swabsi = swidr * ( (c1-alidrni)*(c1-asnow) & - + (c1-alidrns)*asnow ) & - + swidf * ( (c1-alidfni)*(c1-asnow) & - + (c1-alidfns)*asnow ) - - swabs = swabsv + swabsi - - fswpenvdr = swvdr * (c1-alvdrni) * (c1-asnow) * i0vis - fswpenvdf = swvdf * (c1-alvdfni) * (c1-asnow) * i0vis - - ! no penetrating radiation in near IR -! fswpenidr = swidr * (c1-alidrni) * (c1-asnow) * i0nir -! fswpenidf = swidf * (c1-alidfni) * (c1-asnow) * i0nir - - fswpen = fswpenvdr + fswpenvdf - - fswsfc = swabs - fswpen - - trantop = c1 ! transmittance at top of ice - - !----------------------------------------------------------------- - ! penetrating SW absorbed in each ice layer - !----------------------------------------------------------------- - - do k = 1, nilyr - - hi = vicen / aicen - hilyr = hi / real(nilyr,kind=dbl_kind) - - tranbot = exp (-kappav * hilyr * real(k,kind=dbl_kind)) - Iswabs(k) = fswpen * (trantop-tranbot) - - ! bottom of layer k = top of layer k+1 - trantop = tranbot - - ! bgc layer model - if (k == 1) then ! surface flux - fswpenl(k) = fswpen - fswpenl(k+1) = fswpen * tranbot - else - fswpenl(k+1) = fswpen * tranbot - endif - enddo ! nilyr - - ! SW penetrating thru ice into ocean - fswthru = fswpen * tranbot - - ! SW absorbed in ice interior - fswint = fswpen - fswthru - - !---------------------------------------------------------------- - ! if zero-layer model (no heat capacity), no SW is absorbed in ice - ! interior, so add to surface absorption - !---------------------------------------------------------------- - - if (.not. heat_capacity) then - - ! SW absorbed at snow/ice surface - fswsfc = fswsfc + fswint - - ! SW absorbed in ice interior (nilyr = 1) - fswint = c0 - Iswabs(1) = c0 - - endif ! heat_capacity - - end subroutine absorbed_solar - -! End ccsm3 shortwave method -!======================================================================= -! Begin Delta-Eddington shortwave method - -! Compute initial data for Delta-Eddington method, specifically, -! the approximate exponential look-up table. -! -! author: Bruce P. Briegleb, NCAR -! 2011 ECH modified for melt pond tracers -! 2013 ECH merged with NCAR version - - subroutine run_dEdd(dt, tr_aero, & - tr_pond_cesm, & - tr_pond_lvl, & - tr_pond_topo, & - ncat, n_aero, & - n_zaero, dEdd_algae,& - nlt_chl_sw, & - nlt_zaero_sw, & - tr_bgc_N, tr_zaero, & - nilyr, nslyr, & - aicen, vicen, & - vsnon, Tsfcn, & - alvln, apndn, & - hpndn, ipndn, & - snwredist, & - rsnow, tr_rsnw, & - aeron, kalg, & - zbion, & - heat_capacity, & - tlat, tlon, & - calendar_type, & - days_per_year, & - nextsw_cday, yday, & - sec, R_ice, & - R_pnd, R_snw, & - dT_mlt, rsnw_mlt, & - hs0, hs1, hp1, & - pndaspect, & - kaer_tab, waer_tab, & - gaer_tab, & - kaer_bc_tab, & - waer_bc_tab, & - gaer_bc_tab, & - bcenh, & - modal_aero, & - swvdr, swvdf, & - swidr, swidf, & - coszen, fsnow, & - alvdrn, alvdfn, & - alidrn, alidfn, & - fswsfcn, fswintn, & - fswthrun, fswpenln, & - Sswabsn, Iswabsn, & - albicen, albsnon, & - albpndn, apeffn, & - snowfracn, & - dhsn, ffracn, & - rsnw_dEddn, & - l_print_point, & - initonly, & - use_snicar, & - asm_prm_ice_drc, & - asm_prm_ice_dfs, & - ss_alb_ice_drc, & - ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, & - ext_cff_mss_ice_dfs, & - kaer_tab_5bd, & - waer_tab_5bd, & - gaer_tab_5bd, & - kaer_bc_tab_5bd, & - waer_bc_tab_5bd, & - gaer_bc_tab_5bd, & - bcenh_5bd) - - use ice_orbital, only: compute_coszen - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of ice thickness categories - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero , & ! number of aerosol tracers - n_zaero, & ! number of zaerosol tracers - nlt_chl_sw ! index for chla - - integer (kind=int_kind), dimension(:), intent(in) :: & - nlt_zaero_sw ! index for zaerosols - - logical(kind=log_kind), intent(in) :: & - heat_capacity,& ! if true, ice has nonzero heat capacity - tr_aero , & ! if .true., use aerosol tracers - tr_pond_cesm, & ! if .true., use explicit topography-based ponds - tr_pond_lvl , & ! if .true., use explicit topography-based ponds - tr_pond_topo, & ! if .true., use explicit topography-based ponds - tr_rsnw, & ! if .true., use snow grain radius tracer - dEdd_algae, & ! .true. use prognostic chla in dEdd - tr_bgc_N, & ! .true. active bgc (skl or z) - tr_zaero, & ! .true. use zaerosols - modal_aero ! .true. use modal aerosol treatment - - ! dEdd tuning parameters, set in namelist - real (kind=dbl_kind), intent(in) :: & - R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo - R_pnd , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo - R_snw , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt, & ! change in temp for non-melt to melt snow grain radius change (C) - rsnw_mlt, & ! maximum melting snow grain radius (10^-6 m) - hs0 , & ! snow depth for transition to bare sea ice (m) - pndaspect, & ! ratio of pond depth to pond fraction - hs1 , & ! tapering parameter for snow on pond ice - hp1 , & ! critical parameter for pond ice thickness - kalg ! algae absorption coefficient - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_tab, & ! aerosol single scatter albedo (fraction) - gaer_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Model SNICAR snow SSP - asm_prm_ice_drc, & ! snow asymmetry factor (cos(theta)) - asm_prm_ice_dfs, & ! snow asymmetry factor (cos(theta)) - ss_alb_ice_drc, & ! snow single scatter albedo (fraction) - ss_alb_ice_dfs, & ! snow single scatter albedo (fraction) - ext_cff_mss_ice_drc, & ! snow mass extinction cross section (m2/kg) - ext_cff_mss_ice_dfs ! snow mass extinction cross section (m2/kg) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab_5bd, & ! aerosol mass extinction cross section (m2/kg) - waer_tab_5bd, & ! aerosol single scatter albedo (fraction) - gaer_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab_5bd, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab_5bd, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh_5bd ! BC absorption enhancement factor - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh ! BC absorption enhancement factor - - character (len=char_len), intent(in) :: & - calendar_type ! differentiates Gregorian from other calendars - - integer (kind=int_kind), intent(in) :: & - days_per_year, & ! number of days in one year - sec ! elapsed seconds into date - - real (kind=dbl_kind), intent(in) :: & - nextsw_cday , & ! julian day of next shortwave calculation - yday ! day of the year - - real(kind=dbl_kind), intent(in) :: & - dt, & ! time step (s) - tlat, & ! latitude of temp pts (radians) - tlon, & ! longitude of temp pts (radians) - swvdr, & ! sw down, visible, direct (W/m^2) - swvdf, & ! sw down, visible, diffuse (W/m^2) - swidr, & ! sw down, near IR, direct (W/m^2) - swidf, & ! sw down, near IR, diffuse (W/m^2) - fsnow ! snowfall rate (kg/m^2 s) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - aicen, & ! concentration of ice - vicen, & ! volume per unit area of ice (m) - vsnon, & ! volume per unit area of snow (m) - ffracn,& ! fraction of fsurfn used to melt ipond - Tsfcn, & ! surface temperature (deg C) - alvln, & ! level-ice area fraction - apndn, & ! pond area fraction - hpndn, & ! pond depth (m) - ipndn ! pond refrozen lid thickness (m) - - character(len=char_len), intent(in) :: & - snwredist ! type of snow redistribution - - real(kind=dbl_kind), dimension(:,:), intent(in) :: & - rsnow, & ! snow grain radius tracer (10^-6 m) - aeron, & ! aerosols (kg/m^3) - zbion ! zaerosols (kg/m^3) + chlorophyll on shorthwave grid - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - rsnw_dEddn, & ! snow grain radius if .not. tr_rsnw (10^-6 m) - dhsn ! depth difference for snow on sea ice and pond ice - - real(kind=dbl_kind), intent(inout) :: & - coszen ! cosine solar zenith angle, < 0 for sun below horizon - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - alvdrn, & ! visible direct albedo (fraction) - alvdfn, & ! near-ir direct albedo (fraction) - alidrn, & ! visible diffuse albedo (fraction) - alidfn, & ! near-ir diffuse albedo (fraction) - fswsfcn, & ! SW absorbed at ice/snow surface (W m-2) - fswintn, & ! SW absorbed in ice interior, below surface (W m-2) - fswthrun, & ! SW through ice to ocean (W/m^2) - albicen, & ! albedo bare ice - albsnon, & ! albedo snow - albpndn, & ! albedo pond - apeffn, & ! effective pond area used for radiation calculation - snowfracn ! snow fraction on each category used for radiation - - real(kind=dbl_kind), dimension(:,:), intent(inout) :: & - Sswabsn , & ! SW radiation absorbed in snow layers (W m-2) - Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) - fswpenln ! visible SW entering ice layers (W m-2) - - logical (kind=log_kind), intent(in) :: & - use_snicar ! if true, use 5-band snicar IOPs for - ! shortwave radiative calculation of - ! snow-coverd sea ice - - logical (kind=log_kind), intent(in) :: & - l_print_point - - logical (kind=log_kind), optional :: & - initonly ! flag to indicate init only, default is false - - ! local temporary variables - - ! other local variables - ! snow variables for Delta-Eddington shortwave - real (kind=dbl_kind) :: & - fsn , & ! snow horizontal fraction - hsn , & ! snow depth (m) - hsnlvl , & ! snow depth over level ice (m) - vsn , & ! snow volume - alvl ! area fraction of level ice - - real (kind=dbl_kind), dimension (nslyr) :: & - rhosnwn , & ! snow density (kg/m3) - rsnwn ! snow grain radius (micrometers) - - ! pond variables for Delta-Eddington shortwave - real (kind=dbl_kind) :: & - fpn , & ! pond fraction of ice cover - hpn ! actual pond depth (m) - - integer (kind=int_kind) :: & - n , & ! thickness category index - k , & ! snow layer index - na ! aerosol index - - real (kind=dbl_kind) :: & - ipn , & ! refrozen pond ice thickness (m), mean over ice fraction - hp , & ! pond depth - hs , & ! snow depth - asnow , & ! fractional area of snow cover - rp , & ! volume fraction of retained melt water to total liquid content - hmx , & ! maximum available snow infiltration equivalent depth - dhs , & ! local difference in snow depth on sea ice and pond ice - spn , & ! snow depth on refrozen pond (m) - rnslyr , & ! 1/nslyr - tmp ! 0 or 1 - - logical (kind=log_kind) :: & - linitonly ! local initonly value - - linitonly = .false. - if (present(initonly)) then - linitonly = initonly - endif - - ! cosine of the zenith angle - call compute_coszen (tlat, tlon, & - calendar_type, days_per_year, & - nextsw_cday, yday, sec, & - coszen, dt) - - do n = 1, ncat - - ! note that rhoswn, rsnw, fp, hp and Sswabs ARE NOT dimensioned with ncat - ! BPB 19 Dec 2006 - - ! set snow properties - fsn = c0 - hsn = c0 - rhosnwn(:) = c0 - rsnwn(:) = c0 - apeffn(n) = c0 ! for history - snowfracn(n) = c0 ! for history - rsnw_dEddn(n) = c0 ! for history - - if (aicen(n) > puny) then - - call shortwave_dEdd_set_snow(nslyr, R_snw, & - dT_mlt, rsnw_mlt, & - aicen(n), vsnon(n), & - Tsfcn(n), fsn, & - hs0, hsn, & - rhosnwn, rsnwn, & - rsnow(:,n), tr_rsnw) - - ! set pond properties - if (tr_pond_cesm) then - ! fraction of ice area - fpn = apndn(n) - ! pond depth over fraction fpn - hpn = hpndn(n) - ! snow infiltration - if (hsn >= hs_min .and. hs0 > puny) then - asnow = min(hsn/hs0, c1) ! delta-Eddington formulation - fpn = (c1 - asnow) * fpn - hpn = pndaspect * fpn - endif - ! Zero out fraction of thin ponds for radiation only - if (hpn < hpmin) fpn = c0 - fsn = min(fsn, c1-fpn) - apeffn(n) = fpn ! for history - elseif (tr_pond_lvl) then - hsnlvl = hsn ! initialize - if (trim(snwredist) == '30percent') then - hsnlvl = hsn / (c1 + snwlvlfac*(c1-alvln(n))) - ! snow volume over level ice - alvl = aicen(n) * alvln(n) - if (alvl > puny) then - vsn = hsnlvl * alvl - else - vsn = vsnon(n) - alvl = aicen(n) - endif - ! set snow properties over level ice - call shortwave_dEdd_set_snow(nslyr, R_snw, & - dT_mlt, rsnw_mlt, & - alvl, vsn, & - Tsfcn(n), fsn, & - hs0, hsnlvl, & - rhosnwn(:), rsnwn(:), & - rsnow(:,n), tr_rsnw) - endif ! snwredist - fpn = c0 ! fraction of ice covered in pond - hpn = c0 ! pond depth over fpn - ! refrozen pond lid thickness avg over ice - ! allow snow to cover pond ice - ipn = alvln(n) * apndn(n) * ipndn(n) - dhs = dhsn(n) ! snow depth difference, sea ice - pond - if (.not. linitonly .and. ipn > puny .and. & - dhs < puny .and. fsnow*dt > hs_min) & - dhs = hsnlvl - fsnow*dt ! initialize dhs>0 - spn = hsnlvl - dhs ! snow depth on pond ice - if (.not. linitonly .and. ipn*spn < puny) dhs = c0 - dhsn(n) = dhs ! save: constant until reset to 0 - - ! not using ipn assumes that lid ice is perfectly clear - ! if (ipn <= 0.3_dbl_kind) then - - ! fraction of ice area - fpn = apndn(n) * alvln(n) - ! pond depth over fraction fpn - hpn = hpndn(n) - - ! reduce effective pond area absorbing surface heat flux - ! due to flux already having been used to melt pond ice - fpn = (c1 - ffracn(n)) * fpn - - ! taper pond area with snow on pond ice - if (dhs > puny .and. spn >= puny .and. hs1 > puny) then - asnow = min(spn/hs1, c1) - fpn = (c1 - asnow) * fpn - endif - - ! infiltrate snow - hp = hpn - if (hp > puny) then - hs = hsnlvl ! melt ponds reside on level ice - rp = rhofresh*hp/(rhofresh*hp + rhos*hs) - if (rp < p15) then - fpn = c0 - hpn = c0 - else - hmx = hs*(rhofresh - rhos)/rhofresh - tmp = max(c0, sign(c1, hp-hmx)) ! 1 if hp>=hmx, else 0 - hp = (rhofresh*hp + rhos*hs*tmp) & - / (rhofresh - rhos*(c1-tmp)) -!echmod hsn = hs - hp*fpn*(c1-tmp) - hsn = hsn - hp*fpn*(c1-tmp) - hpn = hp * tmp - fpn = fpn * tmp - endif - endif ! hp > puny - - ! Zero out fraction of thin ponds for radiation only - if (hpn < hpmin) fpn = c0 - fsn = min(fsn, c1-fpn) - - ! endif ! masking by lid ice - apeffn(n) = fpn ! for history - - elseif (tr_pond_topo) then - ! Lid effective if thicker than hp1 - if (apndn(n)*aicen(n) > puny .and. ipndn(n) < hp1) then - fpn = apndn(n) - else - fpn = c0 - endif - if (apndn(n) > puny) then - hpn = hpndn(n) - else - fpn = c0 - hpn = c0 - endif - - ! Zero out fraction of thin ponds for radiation only - if (hpn < hpmin) fpn = c0 - - ! If ponds are present snow fraction reduced to - ! non-ponded part dEdd scheme - fsn = min(fsn, c1-fpn) - - apeffn(n) = fpn - else - fpn = c0 - hpn = c0 - call shortwave_dEdd_set_pond(Tsfcn(n), & - fsn, fpn, & - hpn) - - apeffn(n) = fpn ! for history - fpn = c0 - hpn = c0 - endif ! pond type - - snowfracn(n) = fsn ! for history - - call shortwave_dEdd(n_aero, n_zaero, & - dEdd_algae, nlt_chl_sw, & - nlt_zaero_sw(:), & - tr_bgc_N, tr_zaero, & - nslyr, nilyr, & - coszen, heat_capacity, & - aicen(n), vicen(n), & - hsn, fsn, & - rhosnwn, rsnwn, & - fpn, hpn, & - aeron(:,n), tr_aero, & - R_ice, R_pnd, & - kaer_tab, waer_tab, & - gaer_tab, & - kaer_bc_tab, & - waer_bc_tab, & - gaer_bc_tab, & - bcenh, modal_aero, & - kalg, & - swvdr, swvdf, & - swidr, swidf, & - alvdrn(n), alvdfn(n), & - alidrn(n), alidfn(n), & - fswsfcn(n), fswintn(n), & - fswthrun(n), & - Sswabsn(:,n), & - Iswabsn(:,n), & - albicen(n), & - albsnon(n), albpndn(n), & - fswpenln(:,n), zbion(:,n), & - l_print_point, & - use_snicar, & - asm_prm_ice_drc, & - asm_prm_ice_dfs, & - ss_alb_ice_drc, & - ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, & - ext_cff_mss_ice_dfs, & - kaer_tab_5bd, & - waer_tab_5bd, & - gaer_tab_5bd, & - kaer_bc_tab_5bd, & - waer_bc_tab_5bd, & - gaer_bc_tab_5bd, & - bcenh_5bd) - - if (.not. tr_rsnw) then - rnslyr = c1/max(c1,(real(nslyr,kind=dbl_kind))) - do k = 1,nslyr - rsnw_dEddn(n) = rsnw_dEddn(n) + rsnwn(k)*rnslyr - enddo - endif - - endif ! aicen > puny - - enddo ! ncat - - end subroutine run_dEdd - -!======================================================================= -! -! Compute snow/bare ice/ponded ice shortwave albedos, absorbed and transmitted -! flux using the Delta-Eddington solar radiation method as described in: -! -! "A Delta-Eddington Multiple Scattering Parameterization for Solar Radiation -! in the Sea Ice Component of the Community Climate System Model" -! B.P.Briegleb and B.Light NCAR/TN-472+STR February 2007 -! -! Compute shortwave albedos and fluxes for three surface types: -! snow over ice, bare ice and ponded ice. -! -! Albedos and fluxes are output for later use by thermodynamic routines. -! Invokes three calls to compute_dEdd, which sets inherent optical properties -! appropriate for the surface type. Within compute_dEdd, a call to solution_dEdd -! evaluates the Delta-Eddington solution. The final albedos and fluxes are then -! evaluated in compute_dEdd. Albedos and fluxes are transferred to output in -! this routine. -! -! NOTE regarding albedo diagnostics: This method yields zero albedo values -! if there is no incoming solar and thus the albedo diagnostics are masked -! out when the sun is below the horizon. To estimate albedo from the history -! output (post-processing), compute ice albedo using -! (1 - albedo)*swdn = swabs. -ECH -! -! author: Bruce P. Briegleb, NCAR -! 2013: E Hunke merged with NCAR version -! - subroutine shortwave_dEdd (n_aero, n_zaero, & - dEdd_algae, & - nlt_chl_sw, & - nlt_zaero_sw, & - tr_bgc_N, tr_zaero, & - nslyr, nilyr, & - coszen, heat_capacity,& - aice, vice, & - hs, fs, & - rhosnw, rsnw, & - fp, hp, & - aero, tr_aero, & - R_ice, R_pnd, & - kaer_tab, waer_tab, & - gaer_tab, & - kaer_bc_tab, & - waer_bc_tab, & - gaer_bc_tab, & - bcenh, modal_aero, & - kalg, & - swvdr, swvdf, & - swidr, swidf, & - alvdr, alvdf, & - alidr, alidf, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, albice, & - albsno, albpnd, & - fswpenl, zbio, & - l_print_point, & - use_snicar, & - asm_prm_ice_drc, & - asm_prm_ice_dfs, & - ss_alb_ice_drc, & - ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, & - ext_cff_mss_ice_dfs, & - kaer_tab_5bd, & - waer_tab_5bd, & - gaer_tab_5bd, & - kaer_bc_tab_5bd, & - waer_bc_tab_5bd, & - gaer_bc_tab_5bd, & - bcenh_5bd) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero , & ! number of aerosol tracers in use - n_zaero , & ! number of zaerosol tracers in use - nlt_chl_sw ! index for chla - - integer (kind=int_kind), dimension(:), intent(in) :: & - nlt_zaero_sw ! index for zaerosols - - logical (kind=log_kind), intent(in) :: & - heat_capacity, & ! if true, ice has nonzero heat capacity - tr_aero, & ! if .true., use aerosol tracers - dEdd_algae, & ! .true. use prognostic chla in dEdd - tr_bgc_N, & ! .true. active bgc (skl or z) - tr_zaero, & ! .true. use zaerosols - modal_aero ! .true. use modal aerosol treatment - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh ! BC absorption enhancement factor - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_tab, & ! aerosol single scatter albedo (fraction) - gaer_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), intent(in) :: & - kalg , & ! algae absorption coefficient - R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo - R_pnd , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo - aice , & ! concentration of ice - vice , & ! volume of ice - hs , & ! snow depth - fs ! horizontal coverage of snow - - real (kind=dbl_kind), dimension (:), intent(in) :: & - rhosnw , & ! density in snow layer (kg/m3) - rsnw , & ! grain radius in snow layer (m) - aero , & ! aerosol tracers - zbio ! shortwave tracers (zaero+chla) - - real (kind=dbl_kind), intent(in) :: & - fp , & ! pond fractional coverage (0 to 1) - hp , & ! pond depth (m) - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf ! sw down, near IR, diffuse (W/m^2) - - real (kind=dbl_kind), intent(inout) :: & - coszen , & ! cosine of solar zenith angle - alvdr , & ! visible, direct, albedo (fraction) - alvdf , & ! visible, diffuse, albedo (fraction) - alidr , & ! near-ir, direct, albedo (fraction) - alidf , & ! near-ir, diffuse, albedo (fraction) - fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface (W m-2) - fswint , & ! SW interior absorption (below surface, above ocean,W m-2) - fswthru ! SW through snow/bare ice/ponded ice into ocean (W m-2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - fswpenl , & ! visible SW entering ice layers (W m-2) - Sswabs , & ! SW absorbed in snow layer (W m-2) - Iswabs ! SW absorbed in ice layer (W m-2) - - real (kind=dbl_kind), intent(out) :: & - albice , & ! bare ice albedo, for history - albsno , & ! snow albedo, for history - albpnd ! pond albedo, for history - - logical (kind=log_kind), intent(in) :: & - use_snicar ! if true, use 5-band snicar IOPs for - ! shortwave radiative calculation of - ! snow-coverd sea ice - - logical (kind=log_kind) , intent(in) :: & - l_print_point - - ! local variables - - real (kind=dbl_kind) :: & - netsw , & ! net shortwave - fnidr , & ! fraction of direct to total down surface flux in nir - hstmp , & ! snow thickness (set to 0 for bare ice case) - hi , & ! ice thickness (all sea ice layers, m) - fi ! snow/bare ice fractional coverage (0 to 1) - - real (kind=dbl_kind), dimension (4*max_aero) :: & - aero_mp ! aerosol mass path in kg/m2 - - integer (kind=int_kind) :: & - srftyp ! surface type over ice: (0=air, 1=snow, 2=pond) - - integer (kind=int_kind) :: & - k , & ! level index - na , & ! aerosol index - klev , & ! number of radiation layers - 1 - klevp ! number of radiation interfaces - 1 - ! (0 layer is included also) - - real (kind=dbl_kind) :: & - vsno ! volume of snow - - ! for printing points - integer (kind=int_kind) :: & - n ! point number for prints - - real (kind=dbl_kind) :: & - swdn , & ! swvdr(i,j)+swvdf(i,j)+swidr(i,j)+swidf(i,j) - swab , & ! fswsfc(i,j)+fswint(i,j)+fswthru(i,j) - swalb ! (1.-swab/(swdn+.0001)) - - ! for history - real (kind=dbl_kind) :: & - avdrl , & ! visible, direct, albedo (fraction) - avdfl , & ! visible, diffuse, albedo (fraction) - aidrl , & ! near-ir, direct, albedo (fraction) - aidfl ! near-ir, diffuse, albedo (fraction) - - character(len=char_len_long) :: & - warning ! warning message - - ! snow grain single-scattering properties for - ! direct (drc) and diffuse (dfs) shortwave incidents - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Model SNICAR snow SSP - asm_prm_ice_drc, & ! snow asymmetry factor (cos(theta)) - asm_prm_ice_dfs, & ! snow asymmetry factor (cos(theta)) - ss_alb_ice_drc, & ! snow single scatter albedo (fraction) - ss_alb_ice_dfs, & ! snow single scatter albedo (fraction) - ext_cff_mss_ice_drc, & ! snow mass extinction cross section (m2/kg) - ext_cff_mss_ice_dfs ! snow mass extinction cross section (m2/kg) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab_5bd, & ! aerosol mass extinction cross section (m2/kg) - waer_tab_5bd, & ! aerosol single scatter albedo (fraction) - gaer_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab_5bd, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab_5bd, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh_5bd ! BC absorption enhancement factor - -!----------------------------------------------------------------------- - - klev = nslyr + nilyr + 1 ! number of radiation layers - 1 - klevp = klev + 1 ! number of radiation interfaces - 1 - ! (0 layer is included also) - - ! zero storage albedos and fluxes for accumulation over surface types: - hstmp = c0 - hi = c0 - fi = c0 - alvdr = c0 - alvdf = c0 - alidr = c0 - alidf = c0 - avdrl = c0 - avdfl = c0 - aidrl = c0 - aidfl = c0 - fswsfc = c0 - fswint = c0 - fswthru = c0 - - ! compute fraction of nir down direct to total over all points: - fnidr = c0 - if( swidr + swidf > puny ) then - fnidr = swidr/(swidr+swidf) - endif - albice = c0 - albsno = c0 - albpnd = c0 - fswpenl(:) = c0 - Sswabs(:) = c0 - Iswabs(:) = c0 - - ! compute aerosol mass path - - aero_mp(:) = c0 - if( tr_aero ) then - ! assume 4 layers for each aerosol, a snow SSL, snow below SSL, - ! sea ice SSL, and sea ice below SSL, in that order. - do na = 1, 4*n_aero, 4 - vsno = hs * aice - netsw = swvdr + swidr + swvdf + swidf - if (netsw > puny) then ! sun above horizon - aero_mp(na ) = aero(na )*vsno - aero_mp(na+1) = aero(na+1)*vsno - aero_mp(na+2) = aero(na+2)*vice - aero_mp(na+3) = aero(na+3)*vice - endif ! aice > 0 and netsw > 0 - enddo ! na - endif ! if aerosols - - ! compute shortwave radiation accounting for snow/ice (both snow over - ! ice and bare ice) and ponded ice (if any): - - ! sea ice points with sun above horizon - netsw = swvdr + swidr + swvdf + swidf - if (netsw > puny) then ! sun above horizon - coszen = max(puny,coszen) - ! evaluate sea ice thickness and fraction - hi = vice / aice - fi = c1 - fs - fp - ! bare sea ice points - if(fi > c0) then - ! calculate bare sea ice - - srftyp = 0 - call compute_dEdd(nilyr, nslyr, klev, klevp, & - n_zaero, zbio, dEdd_algae, & - nlt_chl_sw,nlt_zaero_sw, tr_bgc_N, & - tr_zaero, & - heat_capacity, fnidr, coszen, & - n_aero, tr_aero, R_ice, R_pnd, & - kaer_tab, waer_tab, gaer_tab, & - kaer_bc_tab, waer_bc_tab, gaer_bc_tab, & - bcenh, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & - hstmp, rhosnw, rsnw, hi, hp, & - fi, aero_mp, avdrl, avdfl, & - aidrl, aidfl, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, fswpenl) - - alvdr = alvdr + avdrl *fi - alvdf = alvdf + avdfl *fi - alidr = alidr + aidrl *fi - alidf = alidf + aidfl *fi - ! for history - albice = albice & - + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl - endif - endif - - ! sea ice points with sun above horizon - netsw = swvdr + swidr + swvdf + swidf - if (netsw > puny) then ! sun above horizon - coszen = max(puny,coszen) - ! snow-covered sea ice points - if(fs > c0) then - ! calculate snow covered sea ice - - srftyp = 1 - if (use_snicar) then ! use 5-band snicar IOPs for snow - call compute_dEdd_5bd(nilyr, nslyr, klev, klevp, & - n_zaero, zbio, dEdd_algae, & - nlt_chl_sw,nlt_zaero_sw, tr_bgc_N, & - tr_zaero, & - heat_capacity, fnidr, coszen, & - n_aero, tr_aero, R_ice, R_pnd, & - kaer_tab_5bd, waer_tab_5bd, gaer_tab_5bd, & - kaer_bc_tab_5bd, waer_bc_tab_5bd, gaer_bc_tab_5bd,& - bcenh_5bd, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & - hs, rhosnw, rsnw, hi, hp, & - fs, aero_mp, avdrl, avdfl, & - aidrl, aidfl, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, fswpenl, & - asm_prm_ice_drc, asm_prm_ice_dfs, & - ss_alb_ice_drc, ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, ext_cff_mss_ice_dfs) - - alvdr = alvdr + avdrl *fs - alvdf = alvdf + avdfl *fs - alidr = alidr + aidrl *fs - alidf = alidf + aidfl *fs - ! for history - albsno = albsno & - + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl - else ! use 3 band IOPs for snow - call compute_dEdd(nilyr, nslyr, klev, klevp, & - n_zaero, zbio, dEdd_algae, & - nlt_chl_sw,nlt_zaero_sw, tr_bgc_N, & - tr_zaero, & - heat_capacity, fnidr, coszen, & - n_aero, tr_aero, R_ice, R_pnd, & - kaer_tab, waer_tab, gaer_tab, & - kaer_bc_tab, waer_bc_tab, gaer_bc_tab, & - bcenh, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & - hs, rhosnw, rsnw, hi, hp, & - fs, aero_mp, avdrl, avdfl, & - aidrl, aidfl, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, fswpenl) - - alvdr = alvdr + avdrl *fs - alvdf = alvdf + avdfl *fs - alidr = alidr + aidrl *fs - alidf = alidf + aidfl *fs - ! for history - albsno = albsno & - + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl - endif ! end if using 5band snicar subroutine - - endif - endif - - hi = c0 - - ! sea ice points with sun above horizon - netsw = swvdr + swidr + swvdf + swidf - if (netsw > puny) then ! sun above horizon - coszen = max(puny,coszen) - hi = vice / aice - ! if nonzero pond fraction and sufficient pond depth - ! if( fp > puny .and. hp > hpmin ) then - if (fp > puny) then - - ! calculate ponded ice - - srftyp = 2 - call compute_dEdd(nilyr, nslyr, klev, klevp, & - n_zaero, zbio, dEdd_algae, & - nlt_chl_sw,nlt_zaero_sw, tr_bgc_N, & - tr_zaero, & - heat_capacity, fnidr, coszen, & - n_aero, tr_aero, R_ice, R_pnd, & - kaer_tab, waer_tab, gaer_tab, & - kaer_bc_tab, waer_bc_tab, gaer_bc_tab, & - bcenh, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & - hs, rhosnw, rsnw, hi, hp, & - fp, aero_mp, avdrl, avdfl, & - aidrl, aidfl, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, fswpenl) - - alvdr = alvdr + avdrl *fp - alvdf = alvdf + avdfl *fp - alidr = alidr + aidrl *fp - alidf = alidf + aidfl *fp - ! for history - albpnd = albpnd & - + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl - endif - endif - - ! if no incoming shortwave, set albedos to 1 - netsw = swvdr + swidr + swvdf + swidf - if (netsw <= puny) then ! sun above horizon - alvdr = c1 - alvdf = c1 - alidr = c1 - alidf = c1 - endif - - if (l_print_point .and. netsw > puny) then - - write(warning,*) ' printing point = ',n - call add_warning(warning) - write(warning,*) ' coszen = ', & - coszen - call add_warning(warning) - write(warning,*) ' swvdr swvdf = ', & - swvdr,swvdf - call add_warning(warning) - write(warning,*) ' swidr swidf = ', & - swidr,swidf - call add_warning(warning) - write(warning,*) ' aice = ', & - aice - call add_warning(warning) - write(warning,*) ' hs = ', & - hs - call add_warning(warning) - write(warning,*) ' hp = ', & - hp - call add_warning(warning) - write(warning,*) ' fs = ', & - fs - call add_warning(warning) - write(warning,*) ' fi = ', & - fi - call add_warning(warning) - write(warning,*) ' fp = ', & - fp - call add_warning(warning) - write(warning,*) ' hi = ', & - hi - call add_warning(warning) - write(warning,*) ' alvdr alvdf = ', & - alvdr,alvdf - call add_warning(warning) - write(warning,*) ' alidr alidf = ', & - alidr,alidf - call add_warning(warning) - write(warning,*) ' fswsfc fswint fswthru = ', & - fswsfc,fswint,fswthru - call add_warning(warning) - swdn = swvdr+swvdf+swidr+swidf - swab = fswsfc+fswint+fswthru - swalb = (1.-swab/(swdn+.0001)) - write(warning,*) ' swdn swab swalb = ',swdn,swab,swalb - do k = 1, nslyr - write(warning,*) ' snow layer k = ', k, & - ' rhosnw = ', & - rhosnw(k), & - ' rsnw = ', & - rsnw(k) - call add_warning(warning) - enddo - do k = 1, nslyr - write(warning,*) ' snow layer k = ', k, & - ' Sswabs(k) = ', Sswabs(k) - call add_warning(warning) - enddo - do k = 1, nilyr - write(warning,*) ' sea ice layer k = ', k, & - ' Iswabs(k) = ', Iswabs(k) - call add_warning(warning) - enddo - - endif ! l_print_point .and. coszen > .01 - - end subroutine shortwave_dEdd - -!======================================================================= -! -! Evaluate snow/ice/ponded ice inherent optical properties (IOPs), and -! then calculate the multiple scattering solution by calling solution_dEdd. -! -! author: Bruce P. Briegleb, NCAR -! 2013: E Hunke merged with NCAR version - - subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & - n_zaero, zbio, dEdd_algae, & - nlt_chl_sw,nlt_zaero_sw, tr_bgc_N, & - tr_zaero, & - heat_capacity, fnidr, coszen, & - n_aero, tr_aero, R_ice, R_pnd, & - kaer_tab, waer_tab, gaer_tab, & - kaer_bc_tab, waer_bc_tab, gaer_bc_tab, & - bcenh, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & - hs, rhosnw, rsnw, hi, hp, & - fi, aero_mp, alvdr, alvdf, & - alidr, alidf, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, fswpenl) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero, & ! number of aerosol tracers - n_zaero , & ! number of zaerosol tracers in use - nlt_chl_sw, &! index for chla - klev , & ! number of radiation layers - 1 - klevp ! number of radiation interfaces - 1 - ! (0 layer is included also) - - integer (kind=int_kind), dimension(:), intent(in) :: & - nlt_zaero_sw ! index for zaerosols - - logical (kind=log_kind), intent(in) :: & - heat_capacity,& ! if true, ice has nonzero heat capacity - tr_aero, & ! if .true., use aerosol tracers - dEdd_algae, & ! .true. use prognostic chla in dEdd - tr_bgc_N, & ! .true. active bgc (skl or z) - tr_zaero, & ! .true. use zaerosols - modal_aero ! .true. use modal aerosol treatment - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab, & ! aerosol single scatter albedo (fraction) - gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh ! BC absorption enhancement factor - - ! dEdd tuning parameters, set in namelist - real (kind=dbl_kind), intent(in) :: & - R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo - R_pnd ! ponded ice tuning parameter; +1 > 1sig increase in albedo - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_tab, & ! aerosol single scatter albedo (fraction) - gaer_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), intent(in) :: & - kalg , & ! algae absorption coefficient - fnidr , & ! fraction of direct to total down flux in nir - coszen , & ! cosine solar zenith angle - swvdr , & ! shortwave down at surface, visible, direct (W/m^2) - swvdf , & ! shortwave down at surface, visible, diffuse (W/m^2) - swidr , & ! shortwave down at surface, near IR, direct (W/m^2) - swidf ! shortwave down at surface, near IR, diffuse (W/m^2) - - integer (kind=int_kind), intent(in) :: & - srftyp ! surface type over ice: (0=air, 1=snow, 2=pond) - - real (kind=dbl_kind), intent(in) :: & - hs ! snow thickness (m) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - rhosnw , & ! snow density in snow layer (kg/m3) - rsnw , & ! snow grain radius in snow layer (m) - zbio , & ! zaerosol + chla shortwave tracers kg/m^3 - aero_mp ! aerosol mass path in kg/m2 - - real (kind=dbl_kind), intent(in) :: & - hi , & ! ice thickness (m) - hp , & ! pond depth (m) - fi ! snow/bare ice fractional coverage (0 to 1) - - real (kind=dbl_kind), intent(inout) :: & - alvdr , & ! visible, direct, albedo (fraction) - alvdf , & ! visible, diffuse, albedo (fraction) - alidr , & ! near-ir, direct, albedo (fraction) - alidf , & ! near-ir, diffuse, albedo (fraction) - fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface (W m-2) - fswint , & ! SW interior absorption (below surface, above ocean,W m-2) - fswthru ! SW through snow/bare ice/ponded ice into ocean (W m-2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - fswpenl , & ! visible SW entering ice layers (W m-2) - Sswabs , & ! SW absorbed in snow layer (W m-2) - Iswabs ! SW absorbed in ice layer (W m-2) - -!----------------------------------------------------------------------- -! -! Set up optical property profiles, based on snow, sea ice and ponded -! ice IOPs from: -! -! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple -! Scattering Parameterization for Solar Radiation in the Sea Ice -! Component of the Community Climate System Model, NCAR Technical -! Note NCAR/TN-472+STR February 2007 -! -! Computes column Delta-Eddington radiation solution for specific -! surface type: either snow over sea ice, bare sea ice, or ponded sea ice. -! -! Divides solar spectrum into 3 intervals: 0.2-0.7, 0.7-1.19, and -! 1.19-5.0 micro-meters. The latter two are added (using an assumed -! partition of incident shortwave in the 0.7-5.0 micro-meter band between -! the 0.7-1.19 and 1.19-5.0 micro-meter band) to give the final output -! of 0.2-0.7 visible and 0.7-5.0 near-infrared albedos and fluxes. -! -! Specifies vertical layer optical properties based on input snow depth, -! density and grain radius, along with ice and pond depths, then computes -! layer by layer Delta-Eddington reflectivity, transmissivity and combines -! layers (done by calling routine solution_dEdd). Finally, surface albedos -! and internal fluxes/flux divergences are evaluated. -! -! Description of the level and layer index conventions. This is -! for the standard case of one snow layer and four sea ice layers. -! -! Please read the following; otherwise, there is 99.9% chance you -! will be confused about indices at some point in time........ :) -! -! CICE4.0 snow treatment has one snow layer above the sea ice. This -! snow layer has finite heat capacity, so that surface absorption must -! be distinguished from internal. The Delta-Eddington solar radiation -! thus adds extra surface scattering layers to both snow and sea ice. -! Note that in the following, we assume a fixed vertical layer structure -! for the radiation calculation. In other words, we always have the -! structure shown below for one snow and four sea ice layers, but for -! ponded ice the pond fills "snow" layer 1 over the sea ice, and for -! bare sea ice the top layers over sea ice are treated as transparent air. -! -! SSL = surface scattering layer for either snow or sea ice -! DL = drained layer for sea ice immediately under sea ice SSL -! INT = interior layers for sea ice below the drained layer. -! -! Notice that the radiation level starts with 0 at the top. Thus, -! the total number radiation layers is klev+1, where klev is the -! sum of nslyr, the number of CCSM snow layers, and nilyr, the -! number of CCSM sea ice layers, plus the sea ice SSL: -! klev = 1 + nslyr + nilyr -! -! For the standard case illustrated below, nslyr=1, nilyr=4, -! and klev=6, with the number of layer interfaces klevp=klev+1. -! Layer interfaces are the surfaces on which reflectivities, -! transmissivities and fluxes are evaluated. -! -! CCSM3 Sea Ice Model Delta-Eddington Solar Radiation -! Layers and Interfaces -! Layer Index Interface Index -! --------------------- --------------------- 0 -! 0 \\\ snow SSL \\\ -! snow layer 1 --------------------- 1 -! 1 rest of snow layer -! +++++++++++++++++++++ +++++++++++++++++++++ 2 -! 2 \\\ sea ice SSL \\\ -! sea ice layer 1 --------------------- 3 -! 3 sea ice DL -! --------------------- --------------------- 4 -! -! sea ice layer 2 4 sea ice INT -! -! --------------------- --------------------- 5 -! -! sea ice layer 3 5 sea ice INT -! -! --------------------- --------------------- 6 -! -! sea ice layer 4 6 sea ice INT -! -! --------------------- --------------------- 7 -! -! When snow lies over sea ice, the radiation absorbed in the -! snow SSL is used for surface heating, and that in the rest -! of the snow layer for its internal heating. For sea ice in -! this case, all of the radiant heat absorbed in both the -! sea ice SSL and the DL are used for sea ice layer 1 heating. -! -! When pond lies over sea ice, and for bare sea ice, all of the -! radiant heat absorbed within and above the sea ice SSL is used -! for surface heating, and that absorbed in the sea ice DL is -! used for sea ice layer 1 heating. -! -! Basically, vertical profiles of the layer extinction optical depth (tau), -! single scattering albedo (w0) and asymmetry parameter (g) are required over -! the klev+1 layers, where klev+1 = 2 + nslyr + nilyr. All of the surface type -! information and snow/ice iop properties are evaulated in this routine, so -! the tau,w0,g profiles can be passed to solution_dEdd for multiple scattering -! evaluation. Snow, bare ice and ponded ice iops are contained in data arrays -! in this routine. -! -!----------------------------------------------------------------------- - - ! local variables - - integer (kind=int_kind) :: & - k , & ! level index - ns , & ! spectral index - nr , & ! index for grain radius tables - ki , & ! index for internal absorption - km , & ! k starting index for snow, sea ice internal absorption - kp , & ! k+1 or k+2 index for snow, sea ice internal absorption - ksrf , & ! level index for surface absorption - ksnow , & ! level index for snow density and grain size - kii ! level starting index for sea ice (nslyr+1) - - integer (kind=int_kind), parameter :: & - nmbrad = 32 ! number of snow grain radii in tables - - real (kind=dbl_kind) :: & - avdr , & ! visible albedo, direct (fraction) - avdf , & ! visible albedo, diffuse (fraction) - aidr , & ! near-ir albedo, direct (fraction) - aidf ! near-ir albedo, diffuse (fraction) - - real (kind=dbl_kind) :: & - fsfc , & ! shortwave absorbed at snow/bare ice/ponded ice surface (W m-2) - fint , & ! shortwave absorbed in interior (W m-2) - fthru ! shortwave through snow/bare ice/ponded ice to ocean (W/m^2) - - real (kind=dbl_kind), dimension(nslyr) :: & - Sabs ! shortwave absorbed in snow layer (W m-2) - - real (kind=dbl_kind), dimension(nilyr) :: & - Iabs ! shortwave absorbed in ice layer (W m-2) - - real (kind=dbl_kind), dimension(nilyr+1) :: & - fthrul ! shortwave through to ice layers (W m-2) - - real (kind=dbl_kind), dimension (nspint) :: & - wghtns ! spectral weights - - real (kind=dbl_kind), parameter :: & - cp67 = 0.67_dbl_kind , & ! nir band weight parameter - cp33 = 0.33_dbl_kind , & ! nir band weight parameter - cp78 = 0.78_dbl_kind , & ! nir band weight parameter - cp22 = 0.22_dbl_kind , & ! nir band weight parameter - cp01 = 0.01_dbl_kind ! for ocean visible albedo - - real (kind=dbl_kind), dimension (0:klev) :: & - tau , & ! layer extinction optical depth - w0 , & ! layer single scattering albedo - g ! layer asymmetry parameter - - ! following arrays are defined at model interfaces; 0 is the top of the - ! layer above the sea ice; klevp is the sea ice/ocean interface. - real (kind=dbl_kind), dimension (0:klevp) :: & - trndir , & ! solar beam down transmission from top - trntdr , & ! total transmission to direct beam for layers above - trndif , & ! diffuse transmission to diffuse beam for layers above - rupdir , & ! reflectivity to direct radiation for layers below - rupdif , & ! reflectivity to diffuse radiation for layers below - rdndif ! reflectivity to diffuse radiation for layers above - - real (kind=dbl_kind), dimension (0:klevp) :: & - dfdir , & ! down-up flux at interface due to direct beam at top surface - dfdif ! down-up flux at interface due to diffuse beam at top surface - - real (kind=dbl_kind) :: & - refk , & ! interface k multiple scattering term - delr , & ! snow grain radius interpolation parameter - ! inherent optical properties (iop) for snow - Qs , & ! Snow extinction efficiency - ks , & ! Snow extinction coefficient (/m) - ws , & ! Snow single scattering albedo - gs ! Snow asymmetry parameter - - real (kind=dbl_kind), dimension(nslyr) :: & - frsnw ! snow grain radius in snow layer * adjustment factor (m) - - ! actual used ice and ponded ice IOPs, allowing for tuning - ! modifications of the above "_mn" value - real (kind=dbl_kind), dimension (nspint) :: & - ki_ssl , & ! Surface-scattering-layer ice extinction coefficient (/m) - wi_ssl , & ! Surface-scattering-layer ice single scattering albedo - gi_ssl , & ! Surface-scattering-layer ice asymmetry parameter - ki_dl , & ! Drained-layer ice extinction coefficient (/m) - wi_dl , & ! Drained-layer ice single scattering albedo - gi_dl , & ! Drained-layer ice asymmetry parameter - ki_int , & ! Interior-layer ice extinction coefficient (/m) - wi_int , & ! Interior-layer ice single scattering albedo - gi_int , & ! Interior-layer ice asymmetry parameter - ki_p_ssl , & ! Ice under pond srf scat layer extinction coefficient (/m) - wi_p_ssl , & ! Ice under pond srf scat layer single scattering albedo - gi_p_ssl , & ! Ice under pond srf scat layer asymmetry parameter - ki_p_int , & ! Ice under pond extinction coefficient (/m) - wi_p_int , & ! Ice under pond single scattering albedo - gi_p_int ! Ice under pond asymmetry parameter - - real (kind=dbl_kind), dimension(0:klev) :: & - dzk ! layer thickness - - real (kind=dbl_kind) :: & - dz , & ! snow, sea ice or pond water layer thickness - dz_ssl , & ! snow or sea ice surface scattering layer thickness - fs ! scaling factor to reduce (nilyr<4) or increase (nilyr>4) DL - ! extinction coefficient to maintain DL optical depth constant - ! with changing number of sea ice layers, to approximately - ! conserve computed albedo for constant physical depth of sea - ! ice when the number of sea ice layers vary - real (kind=dbl_kind) :: & - sig , & ! scattering coefficient for tuning - kabs , & ! absorption coefficient for tuning - sigp ! modified scattering coefficient for tuning - - real (kind=dbl_kind), dimension(nspint, 0:klev) :: & - kabs_chl , & ! absorption coefficient for chlorophyll (/m) - tzaer , & ! total aerosol extinction optical depth - wzaer , & ! total aerosol single scatter albedo - gzaer ! total aerosol asymmetry parameter - - real (kind=dbl_kind) :: & - albodr , & ! spectral ocean albedo to direct rad - albodf ! spectral ocean albedo to diffuse rad - - ! for melt pond transition to bare sea ice for small pond depths - real (kind=dbl_kind) :: & - sig_i , & ! ice scattering coefficient (/m) - sig_p , & ! pond scattering coefficient (/m) - kext ! weighted extinction coefficient (/m) - - ! aerosol optical properties from Mark Flanner, 26 June 2008 - ! order assumed: hydrophobic black carbon, hydrophilic black carbon, - ! four dust aerosols by particle size range: - ! dust1(.05-0.5 micron), dust2(0.5-1.25 micron), - ! dust3(1.25-2.5 micron), dust4(2.5-5.0 micron) - ! spectral bands same as snow/sea ice: (0.3-0.7 micron, 0.7-1.19 micron - ! and 1.19-5.0 micron in wavelength) - - integer (kind=int_kind) :: & - na , n ! aerosol index - - real (kind=dbl_kind) :: & - taer , & ! total aerosol extinction optical depth - waer , & ! total aerosol single scatter albedo - gaer , & ! total aerosol asymmetry parameter - swdr , & ! shortwave down at surface, direct (W/m^2) - swdf , & ! shortwave down at surface, diffuse (W/m^2) - rnilyr , & ! real(nilyr) - rnslyr , & ! real(nslyr) - rns , & ! real(ns) - tmp_0, tmp_ks, tmp_kl ! temp variables - - integer(kind=int_kind), dimension(0:klev) :: & - k_bcini , & ! - k_bcins , & - k_bcexs - real(kind=dbl_kind):: & - tmp_gs, tmp1 ! temp variables - - ! snow grain radii (micro-meters) for table - real (kind=dbl_kind), dimension(nmbrad), parameter :: & - rsnw_tab = (/ & ! snow grain radius for each table entry (micro-meters) - 5._dbl_kind, 7._dbl_kind, 10._dbl_kind, 15._dbl_kind, & - 20._dbl_kind, 30._dbl_kind, 40._dbl_kind, 50._dbl_kind, & - 65._dbl_kind, 80._dbl_kind, 100._dbl_kind, 120._dbl_kind, & - 140._dbl_kind, 170._dbl_kind, 200._dbl_kind, 240._dbl_kind, & - 290._dbl_kind, 350._dbl_kind, 420._dbl_kind, 500._dbl_kind, & - 570._dbl_kind, 660._dbl_kind, 760._dbl_kind, 870._dbl_kind, & - 1000._dbl_kind, 1100._dbl_kind, 1250._dbl_kind, 1400._dbl_kind, & - 1600._dbl_kind, 1800._dbl_kind, 2000._dbl_kind, 2500._dbl_kind/) - - ! snow extinction efficiency (unitless) - real (kind=dbl_kind), dimension (nspint,nmbrad), parameter :: & - Qs_tab = reshape((/ & - 2.131798_dbl_kind, 2.187756_dbl_kind, 2.267358_dbl_kind, & - 2.104499_dbl_kind, 2.148345_dbl_kind, 2.236078_dbl_kind, & - 2.081580_dbl_kind, 2.116885_dbl_kind, 2.175067_dbl_kind, & - 2.062595_dbl_kind, 2.088937_dbl_kind, 2.130242_dbl_kind, & - 2.051403_dbl_kind, 2.072422_dbl_kind, 2.106610_dbl_kind, & - 2.039223_dbl_kind, 2.055389_dbl_kind, 2.080586_dbl_kind, & - 2.032383_dbl_kind, 2.045751_dbl_kind, 2.066394_dbl_kind, & - 2.027920_dbl_kind, 2.039388_dbl_kind, 2.057224_dbl_kind, & - 2.023444_dbl_kind, 2.033137_dbl_kind, 2.048055_dbl_kind, & - 2.020412_dbl_kind, 2.028840_dbl_kind, 2.041874_dbl_kind, & - 2.017608_dbl_kind, 2.024863_dbl_kind, 2.036046_dbl_kind, & - 2.015592_dbl_kind, 2.022021_dbl_kind, 2.031954_dbl_kind, & - 2.014083_dbl_kind, 2.019887_dbl_kind, 2.028853_dbl_kind, & - 2.012368_dbl_kind, 2.017471_dbl_kind, 2.025353_dbl_kind, & - 2.011092_dbl_kind, 2.015675_dbl_kind, 2.022759_dbl_kind, & - 2.009837_dbl_kind, 2.013897_dbl_kind, 2.020168_dbl_kind, & - 2.008668_dbl_kind, 2.012252_dbl_kind, 2.017781_dbl_kind, & - 2.007627_dbl_kind, 2.010813_dbl_kind, 2.015678_dbl_kind, & - 2.006764_dbl_kind, 2.009577_dbl_kind, 2.013880_dbl_kind, & - 2.006037_dbl_kind, 2.008520_dbl_kind, 2.012382_dbl_kind, & - 2.005528_dbl_kind, 2.007807_dbl_kind, 2.011307_dbl_kind, & - 2.005025_dbl_kind, 2.007079_dbl_kind, 2.010280_dbl_kind, & - 2.004562_dbl_kind, 2.006440_dbl_kind, 2.009333_dbl_kind, & - 2.004155_dbl_kind, 2.005898_dbl_kind, 2.008523_dbl_kind, & - 2.003794_dbl_kind, 2.005379_dbl_kind, 2.007795_dbl_kind, & - 2.003555_dbl_kind, 2.005041_dbl_kind, 2.007329_dbl_kind, & - 2.003264_dbl_kind, 2.004624_dbl_kind, 2.006729_dbl_kind, & - 2.003037_dbl_kind, 2.004291_dbl_kind, 2.006230_dbl_kind, & - 2.002776_dbl_kind, 2.003929_dbl_kind, 2.005700_dbl_kind, & - 2.002590_dbl_kind, 2.003627_dbl_kind, 2.005276_dbl_kind, & - 2.002395_dbl_kind, 2.003391_dbl_kind, 2.004904_dbl_kind, & - 2.002071_dbl_kind, 2.002922_dbl_kind, 2.004241_dbl_kind/), & - (/nspint,nmbrad/)) - - ! snow single scattering albedo (unitless) - real (kind=dbl_kind), dimension (nspint,nmbrad), parameter :: & - ws_tab = reshape((/ & - 0.9999994_dbl_kind, 0.9999673_dbl_kind, 0.9954589_dbl_kind, & - 0.9999992_dbl_kind, 0.9999547_dbl_kind, 0.9938576_dbl_kind, & - 0.9999990_dbl_kind, 0.9999382_dbl_kind, 0.9917989_dbl_kind, & - 0.9999985_dbl_kind, 0.9999123_dbl_kind, 0.9889724_dbl_kind, & - 0.9999979_dbl_kind, 0.9998844_dbl_kind, 0.9866190_dbl_kind, & - 0.9999970_dbl_kind, 0.9998317_dbl_kind, 0.9823021_dbl_kind, & - 0.9999960_dbl_kind, 0.9997800_dbl_kind, 0.9785269_dbl_kind, & - 0.9999951_dbl_kind, 0.9997288_dbl_kind, 0.9751601_dbl_kind, & - 0.9999936_dbl_kind, 0.9996531_dbl_kind, 0.9706974_dbl_kind, & - 0.9999922_dbl_kind, 0.9995783_dbl_kind, 0.9667577_dbl_kind, & - 0.9999903_dbl_kind, 0.9994798_dbl_kind, 0.9621007_dbl_kind, & - 0.9999885_dbl_kind, 0.9993825_dbl_kind, 0.9579541_dbl_kind, & - 0.9999866_dbl_kind, 0.9992862_dbl_kind, 0.9541924_dbl_kind, & - 0.9999838_dbl_kind, 0.9991434_dbl_kind, 0.9490959_dbl_kind, & - 0.9999810_dbl_kind, 0.9990025_dbl_kind, 0.9444940_dbl_kind, & - 0.9999772_dbl_kind, 0.9988171_dbl_kind, 0.9389141_dbl_kind, & - 0.9999726_dbl_kind, 0.9985890_dbl_kind, 0.9325819_dbl_kind, & - 0.9999670_dbl_kind, 0.9983199_dbl_kind, 0.9256405_dbl_kind, & - 0.9999605_dbl_kind, 0.9980117_dbl_kind, 0.9181533_dbl_kind, & - 0.9999530_dbl_kind, 0.9976663_dbl_kind, 0.9101540_dbl_kind, & - 0.9999465_dbl_kind, 0.9973693_dbl_kind, 0.9035031_dbl_kind, & - 0.9999382_dbl_kind, 0.9969939_dbl_kind, 0.8953134_dbl_kind, & - 0.9999289_dbl_kind, 0.9965848_dbl_kind, 0.8865789_dbl_kind, & - 0.9999188_dbl_kind, 0.9961434_dbl_kind, 0.8773350_dbl_kind, & - 0.9999068_dbl_kind, 0.9956323_dbl_kind, 0.8668233_dbl_kind, & - 0.9998975_dbl_kind, 0.9952464_dbl_kind, 0.8589990_dbl_kind, & - 0.9998837_dbl_kind, 0.9946782_dbl_kind, 0.8476493_dbl_kind, & - 0.9998699_dbl_kind, 0.9941218_dbl_kind, 0.8367318_dbl_kind, & - 0.9998515_dbl_kind, 0.9933966_dbl_kind, 0.8227881_dbl_kind, & - 0.9998332_dbl_kind, 0.9926888_dbl_kind, 0.8095131_dbl_kind, & - 0.9998148_dbl_kind, 0.9919968_dbl_kind, 0.7968620_dbl_kind, & - 0.9997691_dbl_kind, 0.9903277_dbl_kind, 0.7677887_dbl_kind/), & - (/nspint,nmbrad/)) - - ! snow asymmetry parameter (unitless) - real (kind=dbl_kind), dimension (nspint,nmbrad), parameter :: & - gs_tab = reshape((/ & - 0.859913_dbl_kind, 0.848003_dbl_kind, 0.824415_dbl_kind, & - 0.867130_dbl_kind, 0.858150_dbl_kind, 0.848445_dbl_kind, & - 0.873381_dbl_kind, 0.867221_dbl_kind, 0.861714_dbl_kind, & - 0.878368_dbl_kind, 0.874879_dbl_kind, 0.874036_dbl_kind, & - 0.881462_dbl_kind, 0.879661_dbl_kind, 0.881299_dbl_kind, & - 0.884361_dbl_kind, 0.883903_dbl_kind, 0.890184_dbl_kind, & - 0.885937_dbl_kind, 0.886256_dbl_kind, 0.895393_dbl_kind, & - 0.886931_dbl_kind, 0.887769_dbl_kind, 0.899072_dbl_kind, & - 0.887894_dbl_kind, 0.889255_dbl_kind, 0.903285_dbl_kind, & - 0.888515_dbl_kind, 0.890236_dbl_kind, 0.906588_dbl_kind, & - 0.889073_dbl_kind, 0.891127_dbl_kind, 0.910152_dbl_kind, & - 0.889452_dbl_kind, 0.891750_dbl_kind, 0.913100_dbl_kind, & - 0.889730_dbl_kind, 0.892213_dbl_kind, 0.915621_dbl_kind, & - 0.890026_dbl_kind, 0.892723_dbl_kind, 0.918831_dbl_kind, & - 0.890238_dbl_kind, 0.893099_dbl_kind, 0.921540_dbl_kind, & - 0.890441_dbl_kind, 0.893474_dbl_kind, 0.924581_dbl_kind, & - 0.890618_dbl_kind, 0.893816_dbl_kind, 0.927701_dbl_kind, & - 0.890762_dbl_kind, 0.894123_dbl_kind, 0.930737_dbl_kind, & - 0.890881_dbl_kind, 0.894397_dbl_kind, 0.933568_dbl_kind, & - 0.890975_dbl_kind, 0.894645_dbl_kind, 0.936148_dbl_kind, & - 0.891035_dbl_kind, 0.894822_dbl_kind, 0.937989_dbl_kind, & - 0.891097_dbl_kind, 0.895020_dbl_kind, 0.939949_dbl_kind, & - 0.891147_dbl_kind, 0.895212_dbl_kind, 0.941727_dbl_kind, & - 0.891189_dbl_kind, 0.895399_dbl_kind, 0.943339_dbl_kind, & - 0.891225_dbl_kind, 0.895601_dbl_kind, 0.944915_dbl_kind, & - 0.891248_dbl_kind, 0.895745_dbl_kind, 0.945950_dbl_kind, & - 0.891277_dbl_kind, 0.895951_dbl_kind, 0.947288_dbl_kind, & - 0.891299_dbl_kind, 0.896142_dbl_kind, 0.948438_dbl_kind, & - 0.891323_dbl_kind, 0.896388_dbl_kind, 0.949762_dbl_kind, & - 0.891340_dbl_kind, 0.896623_dbl_kind, 0.950916_dbl_kind, & - 0.891356_dbl_kind, 0.896851_dbl_kind, 0.951945_dbl_kind, & - 0.891386_dbl_kind, 0.897399_dbl_kind, 0.954156_dbl_kind/), & - (/nspint,nmbrad/)) - - ! inherent optical property (iop) arrays for ice and ponded ice - ! mn = specified mean (or base) value - ! ki = extinction coefficient (/m) - ! wi = single scattering albedo - ! gi = asymmetry parameter - - ! ice surface scattering layer (ssl) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_ssl_mn = (/ 1000.1_dbl_kind, 1003.7_dbl_kind, 7042._dbl_kind/), & - wi_ssl_mn = (/ .9999_dbl_kind, .9963_dbl_kind, .9088_dbl_kind/), & - gi_ssl_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind/) - - ! ice drained layer (dl) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_dl_mn = (/ 100.2_dbl_kind, 107.7_dbl_kind, 1309._dbl_kind /), & - wi_dl_mn = (/ .9980_dbl_kind, .9287_dbl_kind, .0305_dbl_kind /), & - gi_dl_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! ice interior layer (int) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_int_mn = (/ 20.2_dbl_kind, 27.7_dbl_kind, 1445._dbl_kind /), & - wi_int_mn = (/ .9901_dbl_kind, .7223_dbl_kind, .0277_dbl_kind /), & - gi_int_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! ponded ice surface scattering layer (ssl) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_p_ssl_mn = (/ 70.2_dbl_kind, 77.7_dbl_kind, 1309._dbl_kind/), & - wi_p_ssl_mn = (/ .9972_dbl_kind, .9009_dbl_kind, .0305_dbl_kind/), & - gi_p_ssl_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! ponded ice interior layer (int) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_p_int_mn = (/ 20.2_dbl_kind, 27.7_dbl_kind, 1445._dbl_kind/), & - wi_p_int_mn = (/ .9901_dbl_kind, .7223_dbl_kind, .0277_dbl_kind/), & - gi_p_int_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! inherent optical property (iop) arrays for pond water and underlying ocean - ! kw = Pond water extinction coefficient (/m) - ! ww = Pond water single scattering albedo - ! gw = Pond water asymmetry parameter - real (kind=dbl_kind), dimension (nspint), parameter :: & - kw = (/ 0.20_dbl_kind, 12.0_dbl_kind, 729._dbl_kind /), & - ww = (/ 0.00_dbl_kind, 0.00_dbl_kind, 0.00_dbl_kind /), & - gw = (/ 0.00_dbl_kind, 0.00_dbl_kind, 0.00_dbl_kind /) - - real (kind=dbl_kind), parameter :: & - rhoi = 917.0_dbl_kind,& ! pure ice mass density (kg/m3) - fr_max = 1.00_dbl_kind, & ! snow grain adjustment factor max - fr_min = 0.80_dbl_kind, & ! snow grain adjustment factor min - ! tuning parameters - ! ice and pond scat coeff fractional change for +- one-sigma in albedo - fp_ice = 0.15_dbl_kind, & ! ice fraction of scat coeff for + stn dev in alb - fm_ice = 0.15_dbl_kind, & ! ice fraction of scat coeff for - stn dev in alb - fp_pnd = 2.00_dbl_kind, & ! ponded ice fraction of scat coeff for + stn dev in alb - fm_pnd = 0.50_dbl_kind ! ponded ice fraction of scat coeff for - stn dev in alb - - real (kind=dbl_kind), parameter :: & !chla-specific absorption coefficient - kchl_tab = 0.01 !0.0023-0.0029 Perovich 1993, also 0.0067 m^2 (mg Chl)^-1 - ! found values of 0.006 to 0.023 m^2/ mg (676 nm) Neukermans 2014 - ! and averages over the 300-700nm of 0.0075 m^2/mg in ice Fritsen (2011) - ! at 440nm values as high as 0.2 m^2/mg in under ice bloom (Balch 2014) - ! Grenfell 1991 uses 0.004 (m^2/mg) which is (0.0078 * spectral weighting) - !chlorophyll mass extinction cross section (m^2/mg chla) - - character(len=char_len_long) :: & - warning ! warning message - -!----------------------------------------------------------------------- -! Initialize and tune bare ice/ponded ice iops - - k_bcini(:) = c0 - k_bcins(:) = c0 - k_bcexs(:) = c0 - - rnilyr = c1/real(nilyr,kind=dbl_kind) - rnslyr = c1/real(nslyr,kind=dbl_kind) - kii = nslyr + 1 - - ! initialize albedos and fluxes to 0 - fthrul = c0 - Iabs = c0 - kabs_chl(:,:) = c0 - tzaer(:,:) = c0 - wzaer(:,:) = c0 - gzaer(:,:) = c0 - - avdr = c0 - avdf = c0 - aidr = c0 - aidf = c0 - fsfc = c0 - fint = c0 - fthru = c0 - - ! spectral weights - ! weights 2 (0.7-1.19 micro-meters) and 3 (1.19-5.0 micro-meters) - ! are chosen based on 1D calculations using ratio of direct to total - ! near-infrared solar (0.7-5.0 micro-meter) which indicates clear/cloudy - ! conditions: more cloud, the less 1.19-5.0 relative to the - ! 0.7-1.19 micro-meter due to cloud absorption. - wghtns(1) = c1 - wghtns(2) = cp67 + (cp78-cp67)*(c1-fnidr) -! wghtns(3) = cp33 + (cp22-cp33)*(c1-fnidr) - wghtns(3) = c1 - wghtns(2) - - ! find snow grain adjustment factor, dependent upon clear/overcast sky - ! estimate. comparisons with SNICAR show better agreement with DE when - ! this factor is included (clear sky near 1 and overcast near 0.8 give - ! best agreement). Multiply by rnsw here for efficiency. - do k = 1, nslyr - frsnw(k) = (fr_max*fnidr + fr_min*(c1-fnidr))*rsnw(k) - Sabs(k) = c0 - enddo - - ! layer thicknesses - ! snow - dz = hs*rnslyr - ! for small enough snow thickness, ssl thickness half of top snow layer -!ech: note this is highly resolution dependent! - dzk(0) = min(hs_ssl, dz/c2) - dzk(1) = dz - dzk(0) - if (nslyr > 1) then - do k = 2, nslyr - dzk(k) = dz - enddo - endif - - ! ice - dz = hi*rnilyr - ! empirical reduction in sea ice ssl thickness for ice thinner than 1.5m; - ! factor of 30 gives best albedo comparison with limited observations - dz_ssl = hi_ssl -!ech: note hardwired parameters -! if( hi < 1.5_dbl_kind ) dz_ssl = hi/30._dbl_kind - dz_ssl = min(hi_ssl, hi/30._dbl_kind) - ! set sea ice ssl thickness to half top layer if sea ice thin enough -!ech: note this is highly resolution dependent! - dz_ssl = min(dz_ssl, dz/c2) - - dzk(kii) = dz_ssl - dzk(kii+1) = dz - dz_ssl - if (kii+2 <= klev) then - do k = kii+2, klev - dzk(k) = dz - enddo - endif - - ! adjust sea ice iops with tuning parameters; tune only the - ! scattering coefficient by factors of R_ice, R_pnd, where - ! R values of +1 correspond approximately to +1 sigma changes in albedo, and - ! R values of -1 correspond approximately to -1 sigma changes in albedo - ! Note: the albedo change becomes non-linear for R values > +1 or < -1 - if( R_ice >= c0 ) then - do ns = 1, nspint - sigp = ki_ssl_mn(ns)*wi_ssl_mn(ns)*(c1+fp_ice*R_ice) - ki_ssl(ns) = sigp+ki_ssl_mn(ns)*(c1-wi_ssl_mn(ns)) - wi_ssl(ns) = sigp/ki_ssl(ns) - gi_ssl(ns) = gi_ssl_mn(ns) - - sigp = ki_dl_mn(ns)*wi_dl_mn(ns)*(c1+fp_ice*R_ice) - ki_dl(ns) = sigp+ki_dl_mn(ns)*(c1-wi_dl_mn(ns)) - wi_dl(ns) = sigp/ki_dl(ns) - gi_dl(ns) = gi_dl_mn(ns) - - sigp = ki_int_mn(ns)*wi_int_mn(ns)*(c1+fp_ice*R_ice) - ki_int(ns) = sigp+ki_int_mn(ns)*(c1-wi_int_mn(ns)) - wi_int(ns) = sigp/ki_int(ns) - gi_int(ns) = gi_int_mn(ns) - enddo - else !if( R_ice < c0 ) then - do ns = 1, nspint - sigp = ki_ssl_mn(ns)*wi_ssl_mn(ns)*(c1+fm_ice*R_ice) - sigp = max(sigp, c0) - ki_ssl(ns) = sigp+ki_ssl_mn(ns)*(c1-wi_ssl_mn(ns)) - wi_ssl(ns) = sigp/ki_ssl(ns) - gi_ssl(ns) = gi_ssl_mn(ns) - - sigp = ki_dl_mn(ns)*wi_dl_mn(ns)*(c1+fm_ice*R_ice) - sigp = max(sigp, c0) - ki_dl(ns) = sigp+ki_dl_mn(ns)*(c1-wi_dl_mn(ns)) - wi_dl(ns) = sigp/ki_dl(ns) - gi_dl(ns) = gi_dl_mn(ns) - - sigp = ki_int_mn(ns)*wi_int_mn(ns)*(c1+fm_ice*R_ice) - sigp = max(sigp, c0) - ki_int(ns) = sigp+ki_int_mn(ns)*(c1-wi_int_mn(ns)) - wi_int(ns) = sigp/ki_int(ns) - gi_int(ns) = gi_int_mn(ns) - enddo - endif ! adjust ice iops - - ! adjust ponded ice iops with tuning parameters - if( R_pnd >= c0 ) then - do ns = 1, nspint - sigp = ki_p_ssl_mn(ns)*wi_p_ssl_mn(ns)*(c1+fp_pnd*R_pnd) - ki_p_ssl(ns) = sigp+ki_p_ssl_mn(ns)*(c1-wi_p_ssl_mn(ns)) - wi_p_ssl(ns) = sigp/ki_p_ssl(ns) - gi_p_ssl(ns) = gi_p_ssl_mn(ns) - - sigp = ki_p_int_mn(ns)*wi_p_int_mn(ns)*(c1+fp_pnd*R_pnd) - ki_p_int(ns) = sigp+ki_p_int_mn(ns)*(c1-wi_p_int_mn(ns)) - wi_p_int(ns) = sigp/ki_p_int(ns) - gi_p_int(ns) = gi_p_int_mn(ns) - enddo - else !if( R_pnd < c0 ) then - do ns = 1, nspint - sigp = ki_p_ssl_mn(ns)*wi_p_ssl_mn(ns)*(c1+fm_pnd*R_pnd) - sigp = max(sigp, c0) - ki_p_ssl(ns) = sigp+ki_p_ssl_mn(ns)*(c1-wi_p_ssl_mn(ns)) - wi_p_ssl(ns) = sigp/ki_p_ssl(ns) - gi_p_ssl(ns) = gi_p_ssl_mn(ns) - - sigp = ki_p_int_mn(ns)*wi_p_int_mn(ns)*(c1+fm_pnd*R_pnd) - sigp = max(sigp, c0) - ki_p_int(ns) = sigp+ki_p_int_mn(ns)*(c1-wi_p_int_mn(ns)) - wi_p_int(ns) = sigp/ki_p_int(ns) - gi_p_int(ns) = gi_p_int_mn(ns) - enddo - endif ! adjust ponded ice iops - - ! use srftyp to determine interface index of surface absorption - if (srftyp == 1) then - ! snow covered sea ice - ksrf = 1 - else - ! bare sea ice or ponded ice - ksrf = nslyr + 2 - endif - - if (tr_bgc_N .and. dEdd_algae) then ! compute kabs_chl for chlorophyll - do k = 0, klev - kabs_chl(1,k) = kchl_tab*zbio(nlt_chl_sw+k) - enddo - else - k = klev - kabs_chl(1,k) = kalg*(0.50_dbl_kind/dzk(k)) - endif ! kabs_chl - -!mgf++ - if (modal_aero) then - do k=0,klev - if (k < nslyr+1) then ! define indices for snow layer - ! use top rsnw, rhosnw for snow ssl and rest of top layer - ksnow = k - min(k-1,0) - tmp_gs = frsnw(ksnow) - - ! get grain size index: - ! works for 25 < snw_rds < 1625 um: - if (tmp_gs < 125.0_dbl_kind) then - tmp1 = tmp_gs/50.0_dbl_kind - k_bcini(k) = nint(tmp1) - elseif (tmp_gs < 175.0_dbl_kind) then - k_bcini(k) = 2 - else - tmp1 = (tmp_gs/250.0_dbl_kind)+c2 - k_bcini(k) = nint(tmp1) - endif - else ! use the largest snow grain size for ice - k_bcini(k) = 8 - endif - ! Set index corresponding to BC effective radius. Here, - ! asssume constant BC effective radius of 100nm - ! (corresponding to index 2) - k_bcins(k) = 2 - k_bcexs(k) = 2 - - ! check bounds: - if (k_bcini(k) < 1) k_bcini(k) = 1 - if (k_bcini(k) > 8) k_bcini(k) = 8 - if (k_bcins(k) < 1) k_bcins(k) = 1 - if (k_bcins(k) > 10) k_bcins(k) = 10 - if (k_bcexs(k) < 1) k_bcexs(k) = 1 - if (k_bcexs(k) > 10) k_bcexs(k) = 10 - - ! print ice radius index: - ! write(warning,*) "MGFICE2:k, ice index= ",k, k_bcini(k) - ! call add_warning(warning) - enddo ! k - - if (tr_zaero .and. dEdd_algae) then ! compute kzaero for chlorophyll - do n = 1,n_zaero - if (n == 1) then ! interstitial BC - do k = 0, klev - do ns = 1,nspint ! not weighted by aice - tzaer(ns,k) = tzaer(ns,k)+kaer_bc_tab(ns,k_bcexs(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer(ns,k) = wzaer(ns,k)+kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer(ns,k) = gzaer(ns,k)+kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k))* & - gaer_bc_tab(ns,k_bcexs(k))*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - elseif (n==2) then ! within-ice BC - do k = 0, klev - do ns = 1,nspint - tzaer(ns,k) = tzaer(ns,k)+kaer_bc_tab(ns,k_bcins(k)) * & - bcenh(ns,k_bcins(k),k_bcini(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer(ns,k) = wzaer(ns,k)+kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer(ns,k) = gzaer(ns,k)+kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))* & - gaer_bc_tab(ns,k_bcins(k))*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - else ! dust - do k = 0, klev - do ns = 1,nspint ! not weighted by aice - tzaer(ns,k) = tzaer(ns,k)+kaer_tab(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer(ns,k) = wzaer(ns,k)+kaer_tab(ns,n)*waer_tab(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer(ns,k) = gzaer(ns,k)+kaer_tab(ns,n)*waer_tab(ns,n)* & - gaer_tab(ns,n)*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - endif !(n=1) - enddo ! n_zaero - endif ! tr_zaero and dEdd_algae - - else ! Bulk aerosol treatment - if (tr_zaero .and. dEdd_algae) then ! compute kzaero for chlorophyll - do n = 1,n_zaero ! multiply by aice? - do k = 0, klev - do ns = 1,nspint ! not weighted by aice - tzaer(ns,k) = tzaer(ns,k)+kaer_tab(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer(ns,k) = wzaer(ns,k)+kaer_tab(ns,n)*waer_tab(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer(ns,k) = gzaer(ns,k)+kaer_tab(ns,n)*waer_tab(ns,n)* & - gaer_tab(ns,n)*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - enddo - endif !tr_zaero - - endif ! modal_aero - -!----------------------------------------------------------------------- - - ! begin spectral loop - do ns = 1, nspint - - ! set optical properties of air/snow/pond overlying sea ice - ! air - if( srftyp == 0 ) then - do k=0,nslyr - tau(k) = c0 - w0(k) = c0 - g(k) = c0 - enddo - ! snow - else if( srftyp == 1 ) then - ! interpolate snow iops using input snow grain radius, - ! snow density and tabular data - do k=0,nslyr - ! use top rsnw, rhosnw for snow ssl and rest of top layer - ksnow = k - min(k-1,0) - ! find snow iops using input snow density and snow grain radius: - if( frsnw(ksnow) < rsnw_tab(1) ) then - Qs = Qs_tab(ns,1) - ws = ws_tab(ns,1) - gs = gs_tab(ns,1) - else if( frsnw(ksnow) >= rsnw_tab(nmbrad) ) then - Qs = Qs_tab(ns,nmbrad) - ws = ws_tab(ns,nmbrad) - gs = gs_tab(ns,nmbrad) - else - ! linear interpolation in rsnw - do nr=2,nmbrad - if( rsnw_tab(nr-1) <= frsnw(ksnow) .and. & - frsnw(ksnow) < rsnw_tab(nr)) then - delr = (frsnw(ksnow) - rsnw_tab(nr-1)) / & - (rsnw_tab(nr) - rsnw_tab(nr-1)) - Qs = Qs_tab(ns,nr-1)*(c1-delr) + & - Qs_tab(ns,nr)*delr - ws = ws_tab(ns,nr-1)*(c1-delr) + & - ws_tab(ns,nr)*delr - gs = gs_tab(ns,nr-1)*(c1-delr) + & - gs_tab(ns,nr)*delr - endif - enddo ! nr - endif - ks = Qs*((rhosnw(ksnow)/rhoi)*3._dbl_kind / & - (4._dbl_kind*frsnw(ksnow)*1.0e-6_dbl_kind)) - - tau(k) = (ks + kabs_chl(ns,k))*dzk(k) - w0(k) = ks/(ks + kabs_chl(ns,k)) *ws - g(k) = gs - enddo ! k - - ! aerosol in snow - if (tr_zaero .and. dEdd_algae) then - do k = 0,nslyr - g(k) = (g(k)*w0(k)*tau(k) + gzaer(ns,k)) / & - (w0(k)*tau(k) + wzaer(ns,k)) - w0(k) = (w0(k)*tau(k) + wzaer(ns,k)) / & - (tau(k) + tzaer(ns,k)) - tau(k) = tau(k) + tzaer(ns,k) - enddo - elseif (tr_aero) then - k = 0 ! snow SSL - taer = c0 - waer = c0 - gaer = c0 - - do na=1,4*n_aero,4 -! mgf++ - if (modal_aero) then - if (na == 1) then - !interstitial BC - taer = taer + & - aero_mp(na)*kaer_bc_tab(ns,k_bcexs(k)) - waer = waer + & - aero_mp(na)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k)) - gaer = gaer + & - aero_mp(na)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k))*gaer_bc_tab(ns,k_bcexs(k)) - elseif (na == 5)then - !within-ice BC - taer = taer + & - aero_mp(na)*kaer_bc_tab(ns,k_bcins(k))* & - bcenh(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - aero_mp(na)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k)) - gaer = gaer + & - aero_mp(na)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) - else - ! other species (dust) - taer = taer + & - aero_mp(na)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif - else - taer = taer + & - aero_mp(na)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif !modal_aero -!mgf-- - enddo ! na - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - - do k=1,nslyr - taer = c0 - waer = c0 - gaer = c0 - do na=1,4*n_aero,4 - if (modal_aero) then -!mgf++ - if (na==1) then - ! interstitial BC - taer = taer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcexs(k)) - waer = waer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k)) - gaer = gaer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k))*gaer_bc_tab(ns,k_bcexs(k)) - elseif (na==5) then - ! within-ice BC - taer = taer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcins(k))*& - bcenh(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k)) - gaer = gaer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) - - else - ! other species (dust) - taer = taer + & - (aero_mp(na+1)/rnslyr)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+1)/rnslyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+1)/rnslyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif !(na==1) - - else - taer = taer + & - (aero_mp(na+1)*rnslyr)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+1)*rnslyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+1)*rnslyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif ! modal_aero -!mgf-- - enddo ! na - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - g(k) = (g(k)*w0(k)*tau(k) + gaer*waer*taer) / & - (w0(k)*tau(k) + waer*taer) - w0(k) = (w0(k)*tau(k) + waer*taer) / & - (tau(k) + taer) - tau(k) = tau(k) + taer - enddo ! k - endif ! tr_aero - - ! pond - else !if( srftyp == 2 ) then - ! pond water layers evenly spaced - dz = hp/(c1/rnslyr+c1) - do k=0,nslyr - tau(k) = kw(ns)*dz - w0(k) = ww(ns) - g(k) = gw(ns) - ! no aerosol in pond - enddo ! k - endif ! srftyp - - ! set optical properties of sea ice - - ! bare or snow-covered sea ice layers - if( srftyp <= 1 ) then - ! ssl - k = kii - tau(k) = (ki_ssl(ns)+kabs_chl(ns,k))*dzk(k) - w0(k) = ki_ssl(ns)/(ki_ssl(ns) + kabs_chl(ns,k))*wi_ssl(ns) - g(k) = gi_ssl(ns) - ! dl - k = kii + 1 - ! scale dz for dl relative to 4 even-layer-thickness 1.5m case - fs = p25/rnilyr - tau(k) = (ki_dl(ns) + kabs_chl(ns,k)) *dzk(k)*fs - w0(k) = ki_dl(ns)/(ki_dl(ns) + kabs_chl(ns,k)) *wi_dl(ns) - g(k) = gi_dl(ns) - ! int above lowest layer - if (kii+2 <= klev-1) then - do k = kii+2, klev-1 - tau(k) = (ki_int(ns) + kabs_chl(ns,k))*dzk(k) - w0(k) = ki_int(ns)/(ki_int(ns) + kabs_chl(ns,k)) *wi_int(ns) - g(k) = gi_int(ns) - enddo - endif - ! lowest layer - k = klev - ! add algae to lowest sea ice layer, visible only: - kabs = ki_int(ns)*(c1-wi_int(ns)) - if( ns == 1 ) then - ! total layer absorption optical depth fixed at value - ! of kalg*0.50m, independent of actual layer thickness - kabs = kabs + kabs_chl(ns,k) - endif - sig = ki_int(ns)*wi_int(ns) - tau(k) = (kabs+sig)*dzk(k) - w0(k) = (sig/(sig+kabs)) - g(k) = gi_int(ns) - ! aerosol in sea ice - if (tr_zaero .and. dEdd_algae) then - do k = kii, klev - g(k) = (g(k)*w0(k)*tau(k) + gzaer(ns,k))/ & - (w0(k)*tau(k) + wzaer(ns,k)) - w0(k) = (w0(k)*tau(k) + wzaer(ns,k)) / & - (tau(k) + tzaer(ns,k)) - tau(k) = tau(k) + tzaer(ns,k) - enddo - elseif (tr_aero) then - k = kii ! sea ice SSL - taer = c0 - waer = c0 - gaer = c0 - do na=1,4*n_aero,4 -!mgf++ - if (modal_aero) then - if (na==1) then - ! interstitial BC - taer = taer + & - aero_mp(na+2)*kaer_bc_tab(ns,k_bcexs(k)) - waer = waer + & - aero_mp(na+2)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k)) - gaer = gaer + & - aero_mp(na+2)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k))*gaer_bc_tab(ns,k_bcexs(k)) - elseif (na==5) then - ! within-ice BC - taer = taer + & - aero_mp(na+2)*kaer_bc_tab(ns,k_bcins(k))* & - bcenh(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - aero_mp(na+2)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k)) - gaer = gaer + & - aero_mp(na+2)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) - else - ! other species (dust) - taer = taer + & - aero_mp(na+2)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na+2)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na+2)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif - else !bulk - taer = taer + & - aero_mp(na+2)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na+2)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na+2)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif ! modal_aero -!mgf-- - enddo ! na - - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - g(k) = (g(k)*w0(k)*tau(k) + gaer*waer*taer) / & - (w0(k)*tau(k) + waer*taer) - w0(k) = (w0(k)*tau(k) + waer*taer) / & - (tau(k) + taer) - tau(k) = tau(k) + taer - do k = kii+1, klev - taer = c0 - waer = c0 - gaer = c0 - do na=1,4*n_aero,4 -!mgf++ - if (modal_aero) then - if (na==1) then - ! interstitial BC - taer = taer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcexs(k)) - waer = waer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k)) - gaer = gaer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcexs(k))* & - waer_bc_tab(ns,k_bcexs(k))*gaer_bc_tab(ns,k_bcexs(k)) - elseif (na==5) then - ! within-ice BC - taer = taer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcins(k))* & - bcenh(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k)) - gaer = gaer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) - - else - ! other species (dust) - taer = taer + & - (aero_mp(na+3)/rnilyr)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+3)/rnilyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+3)/rnilyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif - else !bulk - - taer = taer + & - (aero_mp(na+3)*rnilyr)*kaer_tab(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+3)*rnilyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+3)*rnilyr)*kaer_tab(ns,(1+(na-1)/4))* & - waer_tab(ns,(1+(na-1)/4))*gaer_tab(ns,(1+(na-1)/4)) - endif ! modal_aero -!mgf-- - enddo ! na - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - g(k) = (g(k)*w0(k)*tau(k) + gaer*waer*taer) / & - (w0(k)*tau(k) + waer*taer) - w0(k) = (w0(k)*tau(k) + waer*taer) / & - (tau(k) + taer) - tau(k) = tau(k) + taer - enddo ! k - endif ! tr_aero - - ! sea ice layers under ponds - else !if( srftyp == 2 ) then - k = kii - tau(k) = ki_p_ssl(ns)*dzk(k) - w0(k) = wi_p_ssl(ns) - g(k) = gi_p_ssl(ns) - k = kii + 1 - tau(k) = ki_p_int(ns)*dzk(k) - w0(k) = wi_p_int(ns) - g(k) = gi_p_int(ns) - if (kii+2 <= klev) then - do k = kii+2, klev - tau(k) = ki_p_int(ns)*dzk(k) - w0(k) = wi_p_int(ns) - g(k) = gi_p_int(ns) - enddo ! k - endif - ! adjust pond iops if pond depth within specified range - if( hpmin <= hp .and. hp <= hp0 ) then - k = kii - sig_i = ki_ssl(ns)*wi_ssl(ns) - sig_p = ki_p_ssl(ns)*wi_p_ssl(ns) - sig = sig_i + (sig_p-sig_i)*(hp/hp0) - kext = sig + ki_p_ssl(ns)*(c1-wi_p_ssl(ns)) - tau(k) = kext*dzk(k) - w0(k) = sig/kext - g(k) = gi_p_int(ns) - k = kii + 1 - ! scale dz for dl relative to 4 even-layer-thickness 1.5m case - fs = p25/rnilyr - sig_i = ki_dl(ns)*wi_dl(ns)*fs - sig_p = ki_p_int(ns)*wi_p_int(ns) - sig = sig_i + (sig_p-sig_i)*(hp/hp0) - kext = sig + ki_p_int(ns)*(c1-wi_p_int(ns)) - tau(k) = kext*dzk(k) - w0(k) = sig/kext - g(k) = gi_p_int(ns) - if (kii+2 <= klev) then - do k = kii+2, klev - sig_i = ki_int(ns)*wi_int(ns) - sig_p = ki_p_int(ns)*wi_p_int(ns) - sig = sig_i + (sig_p-sig_i)*(hp/hp0) - kext = sig + ki_p_int(ns)*(c1-wi_p_int(ns)) - tau(k) = kext*dzk(k) - w0(k) = sig/kext - g(k) = gi_p_int(ns) - enddo ! k - endif - endif ! small pond depth transition to bare sea ice - endif ! srftyp - - ! set reflectivities for ocean underlying sea ice - rns = real(ns-1, kind=dbl_kind) - albodr = cp01 * (c1 - min(rns, c1)) - albodf = cp01 * (c1 - min(rns, c1)) - - ! layer input properties now completely specified: tau, w0, g, - ! albodr, albodf; now compute the Delta-Eddington solution - ! reflectivities and transmissivities for each layer; then, - ! combine the layers going downwards accounting for multiple - ! scattering between layers, and finally start from the - ! underlying ocean and combine successive layers upwards to - ! the surface; see comments in solution_dEdd for more details. - - call solution_dEdd & - (coszen, srftyp, klev, klevp, nslyr, & - tau, w0, g, albodr, albodf, & - trndir, trntdr, trndif, rupdir, rupdif, & - rdndif) - - ! the interface reflectivities and transmissivities required - ! to evaluate interface fluxes are returned from solution_dEdd; - ! now compute up and down fluxes for each interface, using the - ! combined layer properties at each interface: - ! - ! layers interface - ! - ! --------------------- k - ! k - ! --------------------- - - do k = 0, klevp - ! interface scattering - refk = c1/(c1 - rdndif(k)*rupdif(k)) - ! dir tran ref from below times interface scattering, plus diff - ! tran and ref from below times interface scattering - ! fdirup(k) = (trndir(k)*rupdir(k) + & - ! (trntdr(k)-trndir(k)) & - ! *rupdif(k))*refk - ! dir tran plus total diff trans times interface scattering plus - ! dir tran with up dir ref and down dif ref times interface scattering - ! fdirdn(k) = trndir(k) + (trntdr(k) & - ! - trndir(k) + trndir(k) & - ! *rupdir(k)*rdndif(k))*refk - ! diffuse tran ref from below times interface scattering - ! fdifup(k) = trndif(k)*rupdif(k)*refk - ! diffuse tran times interface scattering - ! fdifdn(k) = trndif(k)*refk - - ! dfdir = fdirdn - fdirup - dfdir(k) = trndir(k) & - + (trntdr(k)-trndir(k)) * (c1 - rupdif(k)) * refk & - - trndir(k)*rupdir(k) * (c1 - rdndif(k)) * refk - if (dfdir(k) < puny) dfdir(k) = c0 !echmod necessary? - ! dfdif = fdifdn - fdifup - dfdif(k) = trndif(k) * (c1 - rupdif(k)) * refk - if (dfdif(k) < puny) dfdif(k) = c0 !echmod necessary? - enddo ! k - - ! calculate final surface albedos and fluxes- - ! all absorbed flux above ksrf is included in surface absorption - - if( ns == 1) then ! visible - - swdr = swvdr - swdf = swvdf - avdr = rupdir(0) - avdf = rupdif(0) - - tmp_0 = dfdir(0 )*swdr + dfdif(0 )*swdf - tmp_ks = dfdir(ksrf )*swdr + dfdif(ksrf )*swdf - tmp_kl = dfdir(klevp)*swdr + dfdif(klevp)*swdf - - ! for layer biology: save visible only - do k = nslyr+2, klevp ! Start at DL layer of ice after SSL scattering - fthrul(k-nslyr-1) = dfdir(k)*swdr + dfdif(k)*swdf - enddo - - fsfc = fsfc + tmp_0 - tmp_ks - fint = fint + tmp_ks - tmp_kl - fthru = fthru + tmp_kl - - ! if snow covered ice, set snow internal absorption; else, Sabs=0 - if( srftyp == 1 ) then - ki = 0 - do k=1,nslyr - ! skip snow SSL, since SSL absorption included in the surface - ! absorption fsfc above - km = k - kp = km + 1 - ki = ki + 1 - Sabs(ki) = Sabs(ki) & - + dfdir(km)*swdr + dfdif(km)*swdf & - - (dfdir(kp)*swdr + dfdif(kp)*swdf) - enddo ! k - endif - - ! complex indexing to insure proper absorptions for sea ice - ki = 0 - do k=nslyr+2,nslyr+1+nilyr - ! for bare ice, DL absorption for sea ice layer 1 - km = k - kp = km + 1 - ! modify for top sea ice layer for snow over sea ice - if( srftyp == 1 ) then - ! must add SSL and DL absorption for sea ice layer 1 - if( k == nslyr+2 ) then - km = k - 1 - kp = km + 2 - endif - endif - ki = ki + 1 - Iabs(ki) = Iabs(ki) & - + dfdir(km)*swdr + dfdif(km)*swdf & - - (dfdir(kp)*swdr + dfdif(kp)*swdf) - enddo ! k - - else !if(ns > 1) then ! near IR - - swdr = swidr - swdf = swidf - - ! let fr1 = alb_1*swd*wght1 and fr2 = alb_2*swd*wght2 be the ns=2,3 - ! reflected fluxes respectively, where alb_1, alb_2 are the band - ! albedos, swd = nir incident shortwave flux, and wght1, wght2 are - ! the 2,3 band weights. thus, the total reflected flux is: - ! fr = fr1 + fr2 = alb_1*swd*wght1 + alb_2*swd*wght2 hence, the - ! 2,3 nir band albedo is alb = fr/swd = alb_1*wght1 + alb_2*wght2 - - aidr = aidr + rupdir(0)*wghtns(ns) - aidf = aidf + rupdif(0)*wghtns(ns) - - tmp_0 = dfdir(0 )*swdr + dfdif(0 )*swdf - tmp_ks = dfdir(ksrf )*swdr + dfdif(ksrf )*swdf - tmp_kl = dfdir(klevp)*swdr + dfdif(klevp)*swdf - - tmp_0 = tmp_0 * wghtns(ns) - tmp_ks = tmp_ks * wghtns(ns) - tmp_kl = tmp_kl * wghtns(ns) - - fsfc = fsfc + tmp_0 - tmp_ks - fint = fint + tmp_ks - tmp_kl - fthru = fthru + tmp_kl - - ! if snow covered ice, set snow internal absorption; else, Sabs=0 - if( srftyp == 1 ) then - ki = 0 - do k=1,nslyr - ! skip snow SSL, since SSL absorption included in the surface - ! absorption fsfc above - km = k - kp = km + 1 - ki = ki + 1 - Sabs(ki) = Sabs(ki) & - + (dfdir(km)*swdr + dfdif(km)*swdf & - - (dfdir(kp)*swdr + dfdif(kp)*swdf)) & - * wghtns(ns) - enddo ! k - endif - - ! complex indexing to insure proper absorptions for sea ice - ki = 0 - do k=nslyr+2,nslyr+1+nilyr - ! for bare ice, DL absorption for sea ice layer 1 - km = k - kp = km + 1 - ! modify for top sea ice layer for snow over sea ice - if( srftyp == 1 ) then - ! must add SSL and DL absorption for sea ice layer 1 - if( k == nslyr+2 ) then - km = k - 1 - kp = km + 2 - endif - endif - ki = ki + 1 - Iabs(ki) = Iabs(ki) & - + (dfdir(km)*swdr + dfdif(km)*swdf & - - (dfdir(kp)*swdr + dfdif(kp)*swdf)) & - * wghtns(ns) - enddo ! k - - endif ! ns = 1, ns > 1 - - enddo ! end spectral loop ns - - ! accumulate fluxes over bare sea ice - alvdr = avdr - alvdf = avdf - alidr = aidr - alidf = aidf - fswsfc = fswsfc + fsfc *fi - fswint = fswint + fint *fi - fswthru = fswthru + fthru*fi - - do k = 1, nslyr - Sswabs(k) = Sswabs(k) + Sabs(k)*fi - enddo ! k - - do k = 1, nilyr - Iswabs(k) = Iswabs(k) + Iabs(k)*fi - - ! bgc layer - fswpenl(k) = fswpenl(k) + fthrul(k)* fi - if (k == nilyr) then - fswpenl(k+1) = fswpenl(k+1) + fthrul(k+1)*fi - endif - enddo ! k - - !---------------------------------------------------------------- - ! if ice has zero heat capacity, no SW can be absorbed - ! in the ice/snow interior, so add to surface absorption. - ! Note: nilyr = nslyr = 1 for this case - !---------------------------------------------------------------- - - if (.not. heat_capacity) then - - ! SW absorbed at snow/ice surface - fswsfc = fswsfc + Iswabs(1) + Sswabs(1) - - ! SW absorbed in ice interior - fswint = c0 - Iswabs(1) = c0 - Sswabs(1) = c0 - - endif ! heat_capacity - - end subroutine compute_dEdd - -!======================================================================= -! -! Given input vertical profiles of optical properties, evaluate the -! monochromatic Delta-Eddington solution. -! -! author: Bruce P. Briegleb, NCAR -! 2013: E Hunke merged with NCAR version - subroutine solution_dEdd & - (coszen, srftyp, klev, klevp, nslyr, & - tau, w0, g, albodr, albodf, & - trndir, trntdr, trndif, rupdir, rupdif, & - rdndif) - - real (kind=dbl_kind), intent(in) :: & - coszen ! cosine solar zenith angle - - integer (kind=int_kind), intent(in) :: & - srftyp , & ! surface type over ice: (0=air, 1=snow, 2=pond) - klev , & ! number of radiation layers - 1 - klevp , & ! number of radiation interfaces - 1 - ! (0 layer is included also) - nslyr ! number of snow layers - - real (kind=dbl_kind), dimension(0:klev), intent(in) :: & - tau , & ! layer extinction optical depth - w0 , & ! layer single scattering albedo - g ! layer asymmetry parameter - - real (kind=dbl_kind), intent(in) :: & - albodr , & ! ocean albedo to direct rad - albodf ! ocean albedo to diffuse rad - - ! following arrays are defined at model interfaces; 0 is the top of the - ! layer above the sea ice; klevp is the sea ice/ocean interface. - real (kind=dbl_kind), dimension (0:klevp), intent(out) :: & - trndir , & ! solar beam down transmission from top - trntdr , & ! total transmission to direct beam for layers above - trndif , & ! diffuse transmission to diffuse beam for layers above - rupdir , & ! reflectivity to direct radiation for layers below - rupdif , & ! reflectivity to diffuse radiation for layers below - rdndif ! reflectivity to diffuse radiation for layers above - -!----------------------------------------------------------------------- -! -! Delta-Eddington solution for snow/air/pond over sea ice -! -! Generic solution for a snow/air/pond input column of klev+1 layers, -! with srftyp determining at what interface fresnel refraction occurs. -! -! Computes layer reflectivities and transmissivities, from the top down -! to the lowest interface using the Delta-Eddington solutions for each -! layer; combines layers from top down to lowest interface, and from the -! lowest interface (underlying ocean) up to the top of the column. -! -! Note that layer diffuse reflectivity and transmissivity are computed -! by integrating the direct over several gaussian angles. This is -! because the diffuse reflectivity expression sometimes is negative, -! but the direct reflectivity is always well-behaved. We assume isotropic -! radiation in the upward and downward hemispheres for this integration. -! -! Assumes monochromatic (spectrally uniform) properties across a band -! for the input optical parameters. -! -! If total transmission of the direct beam to the interface above a particular -! layer is less than trmin, then no further Delta-Eddington solutions are -! evaluated for layers below. -! -! The following describes how refraction is handled in the calculation. -! -! First, we assume that radiation is refracted when entering either -! sea ice at the base of the surface scattering layer, or water (i.e. melt -! pond); we assume that radiation does not refract when entering snow, nor -! upon entering sea ice from a melt pond, nor upon entering the underlying -! ocean from sea ice. -! -! To handle refraction, we define a "fresnel" layer, which physically -! is of neglible thickness and is non-absorbing, which can be combined to -! any sea ice layer or top of melt pond. The fresnel layer accounts for -! refraction of direct beam and associated reflection and transmission for -! solar radiation. A fresnel layer is combined with the top of a melt pond -! or to the surface scattering layer of sea ice if no melt pond lies over it. -! -! Some caution must be exercised for the fresnel layer, because any layer -! to which it is combined is no longer a homogeneous layer, as are all other -! individual layers. For all other layers for example, the direct and diffuse -! reflectivities/transmissivities (R/T) are the same for radiation above or -! below the layer. This is the meaning of homogeneous! But for the fresnel -! layer this is not so. Thus, the R/T for this layer must be distinguished -! for radiation above from that from radiation below. For generality, we -! treat all layers to be combined as inhomogeneous. -! -!----------------------------------------------------------------------- - - ! local variables - - integer (kind=int_kind) :: & - kfrsnl ! radiation interface index for fresnel layer - - ! following variables are defined for each layer; 0 refers to the top - ! layer. In general we must distinguish directions above and below in - ! the diffuse reflectivity and transmissivity, as layers are not assumed - ! to be homogeneous (apart from the single layer Delta-Edd solutions); - ! the direct is always from above. - real (kind=dbl_kind), dimension (0:klev) :: & - rdir , & ! layer reflectivity to direct radiation - rdif_a , & ! layer reflectivity to diffuse radiation from above - rdif_b , & ! layer reflectivity to diffuse radiation from below - tdir , & ! layer transmission to direct radiation (solar beam + diffuse) - tdif_a , & ! layer transmission to diffuse radiation from above - tdif_b , & ! layer transmission to diffuse radiation from below - trnlay ! solar beam transm for layer (direct beam only) - - integer (kind=int_kind) :: & - k ! level index - - real (kind=dbl_kind), parameter :: & - trmin = 0.001_dbl_kind ! minimum total transmission allowed - ! total transmission is that due to the direct beam; i.e. it includes - ! both the directly transmitted solar beam and the diffuse downwards - ! transmitted radiation resulting from scattering out of the direct beam - real (kind=dbl_kind) :: & - tautot , & ! layer optical depth - wtot , & ! layer single scattering albedo - gtot , & ! layer asymmetry parameter - ftot , & ! layer forward scattering fraction - ts , & ! layer scaled extinction optical depth - ws , & ! layer scaled single scattering albedo - gs , & ! layer scaled asymmetry parameter - rintfc , & ! reflection (multiple) at an interface - refkp1 , & ! interface multiple scattering for k+1 - refkm1 , & ! interface multiple scattering for k-1 - tdrrdir , & ! direct tran times layer direct ref - tdndif ! total down diffuse = tot tran - direct tran - - ! perpendicular and parallel relative to plane of incidence and scattering - real (kind=dbl_kind) :: & - R1 , & ! perpendicular polarization reflection amplitude - R2 , & ! parallel polarization reflection amplitude - T1 , & ! perpendicular polarization transmission amplitude - T2 , & ! parallel polarization transmission amplitude - Rf_dir_a , & ! fresnel reflection to direct radiation - Tf_dir_a , & ! fresnel transmission to direct radiation - Rf_dif_a , & ! fresnel reflection to diff radiation from above - Rf_dif_b , & ! fresnel reflection to diff radiation from below - Tf_dif_a , & ! fresnel transmission to diff radiation from above - Tf_dif_b ! fresnel transmission to diff radiation from below - - ! refractive index for sea ice, water; pre-computed, band-independent, - ! diffuse fresnel reflectivities - real (kind=dbl_kind), parameter :: & - refindx = 1.310_dbl_kind , & ! refractive index of sea ice (water also) - cp063 = 0.063_dbl_kind , & ! diffuse fresnel reflectivity from above - cp455 = 0.455_dbl_kind ! diffuse fresnel reflectivity from below - - real (kind=dbl_kind) :: & - mu0 , & ! cosine solar zenith angle incident - mu0nij ! cosine solar zenith angle in medium below fresnel level - - real (kind=dbl_kind) :: & - mu0n ! cosine solar zenith angle in medium - - real (kind=dbl_kind) :: & - alpha , & ! term in direct reflectivity and transmissivity - agamm , & ! term in direct reflectivity and transmissivity - el , & ! term in alpha,agamm,n,u - taus , & ! scaled extinction optical depth - omgs , & ! scaled single particle scattering albedo - asys , & ! scaled asymmetry parameter - u , & ! term in diffuse reflectivity and transmissivity - n , & ! term in diffuse reflectivity and transmissivity - lm , & ! temporary for el - mu , & ! cosine solar zenith for either snow or water - ne ! temporary for n - - real (kind=dbl_kind) :: & - w , & ! dummy argument for statement function - uu , & ! dummy argument for statement function - gg , & ! dummy argument for statement function - e , & ! dummy argument for statement function - f , & ! dummy argument for statement function - t , & ! dummy argument for statement function - et ! dummy argument for statement function - - real (kind=dbl_kind) :: & - alp , & ! temporary for alpha - gam , & ! temporary for agamm - ue , & ! temporary for u - extins , & ! extinction - amg , & ! alp - gam - apg ! alp + gam - - integer (kind=int_kind), parameter :: & - ngmax = 8 ! number of gaussian angles in hemisphere - - real (kind=dbl_kind), dimension (ngmax), parameter :: & - gauspt & ! gaussian angles (radians) - = (/ .9894009_dbl_kind, .9445750_dbl_kind, & - .8656312_dbl_kind, .7554044_dbl_kind, & - .6178762_dbl_kind, .4580168_dbl_kind, & - .2816036_dbl_kind, .0950125_dbl_kind/), & - gauswt & ! gaussian weights - = (/ .0271525_dbl_kind, .0622535_dbl_kind, & - .0951585_dbl_kind, .1246290_dbl_kind, & - .1495960_dbl_kind, .1691565_dbl_kind, & - .1826034_dbl_kind, .1894506_dbl_kind/) - - integer (kind=int_kind) :: & - ng ! gaussian integration index - - real (kind=dbl_kind) :: & - gwt , & ! gaussian weight - swt , & ! sum of weights - trn , & ! layer transmission - rdr , & ! rdir for gaussian integration - tdr , & ! tdir for gaussian integration - smr , & ! accumulator for rdif gaussian integration - smt ! accumulator for tdif gaussian integration - - real (kind=dbl_kind) :: & - exp_min ! minimum exponential value - - ! Delta-Eddington solution expressions - alpha(w,uu,gg,e) = p75*w*uu*((c1 + gg*(c1-w))/(c1 - e*e*uu*uu)) - agamm(w,uu,gg,e) = p5*w*((c1 + c3*gg*(c1-w)*uu*uu)/(c1-e*e*uu*uu)) - n(uu,et) = ((uu+c1)*(uu+c1)/et ) - ((uu-c1)*(uu-c1)*et) - u(w,gg,e) = c1p5*(c1 - w*gg)/e - el(w,gg) = sqrt(c3*(c1-w)*(c1 - w*gg)) - taus(w,f,t) = (c1 - w*f)*t - omgs(w,f) = (c1 - f)*w/(c1 - w*f) - asys(gg,f) = (gg - f)/(c1 - f) - -!----------------------------------------------------------------------- - - do k = 0, klevp - trndir(k) = c0 - trntdr(k) = c0 - trndif(k) = c0 - rupdir(k) = c0 - rupdif(k) = c0 - rdndif(k) = c0 - enddo - - ! initialize top interface of top layer - trndir(0) = c1 - trntdr(0) = c1 - trndif(0) = c1 - rdndif(0) = c0 - - ! mu0 is cosine solar zenith angle above the fresnel level; make - ! sure mu0 is large enough for stable and meaningful radiation - ! solution: .01 is like sun just touching horizon with its lower edge - mu0 = max(coszen,p01) - - ! mu0n is cosine solar zenith angle used to compute the layer - ! Delta-Eddington solution; it is initially computed to be the - ! value below the fresnel level, i.e. the cosine solar zenith - ! angle below the fresnel level for the refracted solar beam: - mu0nij = sqrt(c1-((c1-mu0**2)/(refindx*refindx))) - - ! compute level of fresnel refraction - ! if ponded sea ice, fresnel level is the top of the pond. - kfrsnl = 0 - ! if snow over sea ice or bare sea ice, fresnel level is - ! at base of sea ice SSL (and top of the sea ice DL); the - ! snow SSL counts for one, then the number of snow layers, - ! then the sea ice SSL which also counts for one: - if( srftyp < 2 ) kfrsnl = nslyr + 2 - - ! proceed down one layer at a time; if the total transmission to - ! the interface just above a given layer is less than trmin, then no - ! Delta-Eddington computation for that layer is done. - - ! begin main level loop - do k = 0, klev - - ! initialize all layer apparent optical properties to 0 - rdir (k) = c0 - rdif_a(k) = c0 - rdif_b(k) = c0 - tdir (k) = c0 - tdif_a(k) = c0 - tdif_b(k) = c0 - trnlay(k) = c0 - - ! compute next layer Delta-eddington solution only if total transmission - ! of radiation to the interface just above the layer exceeds trmin. - - if (trntdr(k) > trmin ) then - - ! calculation over layers with penetrating radiation - - tautot = tau(k) - wtot = w0(k) - gtot = g(k) - ftot = gtot*gtot - - ts = taus(wtot,ftot,tautot) - ws = omgs(wtot,ftot) - gs = asys(gtot,ftot) - lm = el(ws,gs) - ue = u(ws,gs,lm) - - mu0n = mu0nij - ! if level k is above fresnel level and the cell is non-pond, use the - ! non-refracted beam instead - if( srftyp < 2 .and. k < kfrsnl ) mu0n = mu0 - - !extins = max(exp_min, exp(-lm*ts)) - exp_min = min(exp_argmax,lm*ts) - extins = exp(-exp_min) - ne = n(ue,extins) - - ! first calculation of rdif, tdif using Delta-Eddington formulas -! rdif_a(k) = (ue+c1)*(ue-c1)*(c1/extins - extins)/ne - rdif_a(k) = (ue**2-c1)*(c1/extins - extins)/ne - tdif_a(k) = c4*ue/ne - - ! evaluate rdir,tdir for direct beam - !trnlay(k) = max(exp_min, exp(-ts/mu0n)) - exp_min = min(exp_argmax,ts/mu0n) - trnlay(k) = exp(-exp_min) - alp = alpha(ws,mu0n,gs,lm) - gam = agamm(ws,mu0n,gs,lm) - apg = alp + gam - amg = alp - gam - rdir(k) = apg*rdif_a(k) + amg*(tdif_a(k)*trnlay(k) - c1) - tdir(k) = apg*tdif_a(k) + (amg* rdif_a(k)-apg+c1)*trnlay(k) - - ! recalculate rdif,tdif using direct angular integration over rdir,tdir, - ! since Delta-Eddington rdif formula is not well-behaved (it is usually - ! biased low and can even be negative); use ngmax angles and gaussian - ! integration for most accuracy: - R1 = rdif_a(k) ! use R1 as temporary - T1 = tdif_a(k) ! use T1 as temporary - swt = c0 - smr = c0 - smt = c0 - do ng=1,ngmax - mu = gauspt(ng) - gwt = gauswt(ng) - swt = swt + mu*gwt - !trn = max(exp_min, exp(-ts/mu)) - exp_min = min(exp_argmax,ts/mu) - trn = exp(-exp_min) - alp = alpha(ws,mu,gs,lm) - gam = agamm(ws,mu,gs,lm) - apg = alp + gam - amg = alp - gam - rdr = apg*R1 + amg*T1*trn - amg - tdr = apg*T1 + amg*R1*trn - apg*trn + trn - smr = smr + mu*rdr*gwt - smt = smt + mu*tdr*gwt - enddo ! ng - rdif_a(k) = smr/swt - tdif_a(k) = smt/swt - - ! homogeneous layer - rdif_b(k) = rdif_a(k) - tdif_b(k) = tdif_a(k) - - ! add fresnel layer to top of desired layer if either - ! air or snow overlies ice; we ignore refraction in ice - ! if a melt pond overlies it: - - if( k == kfrsnl ) then - ! compute fresnel reflection and transmission amplitudes - ! for two polarizations: 1=perpendicular and 2=parallel to - ! the plane containing incident, reflected and refracted rays. - R1 = (mu0 - refindx*mu0n) / & - (mu0 + refindx*mu0n) - R2 = (refindx*mu0 - mu0n) / & - (refindx*mu0 + mu0n) - T1 = c2*mu0 / & - (mu0 + refindx*mu0n) - T2 = c2*mu0 / & - (refindx*mu0 + mu0n) - - ! unpolarized light for direct beam - Rf_dir_a = p5 * (R1*R1 + R2*R2) - Tf_dir_a = p5 * (T1*T1 + T2*T2)*refindx*mu0n/mu0 - - ! precalculated diffuse reflectivities and transmissivities - ! for incident radiation above and below fresnel layer, using - ! the direct albedos and accounting for complete internal - ! reflection from below; precalculated because high order - ! number of gaussian points (~256) is required for convergence: - - ! above - Rf_dif_a = cp063 - Tf_dif_a = c1 - Rf_dif_a - ! below - Rf_dif_b = cp455 - Tf_dif_b = c1 - Rf_dif_b - - ! the k = kfrsnl layer properties are updated to combined - ! the fresnel (refractive) layer, always taken to be above - ! the present layer k (i.e. be the top interface): - - rintfc = c1 / (c1-Rf_dif_b*rdif_a(k)) - tdir(k) = Tf_dir_a*tdir(k) + & - Tf_dir_a*rdir(k) * & - Rf_dif_b*rintfc*tdif_a(k) - rdir(k) = Rf_dir_a + & - Tf_dir_a*rdir(k) * & - rintfc*Tf_dif_b - rdif_a(k) = Rf_dif_a + & - Tf_dif_a*rdif_a(k) * & - rintfc*Tf_dif_b - rdif_b(k) = rdif_b(k) + & - tdif_b(k)*Rf_dif_b * & - rintfc*tdif_a(k) - tdif_a(k) = tdif_a(k)*rintfc*Tf_dif_a - tdif_b(k) = tdif_b(k)*rintfc*Tf_dif_b - - ! update trnlay to include fresnel transmission - trnlay(k) = Tf_dir_a*trnlay(k) - - endif ! k = kfrsnl - - endif ! trntdr(k) > trmin - - ! initialize current layer properties to zero; only if total - ! transmission to the top interface of the current layer exceeds the - ! minimum, will these values be computed below: - ! Calculate the solar beam transmission, total transmission, and - ! reflectivity for diffuse radiation from below at interface k, - ! the top of the current layer k: - ! - ! layers interface - ! - ! --------------------- k-1 - ! k-1 - ! --------------------- k - ! k - ! --------------------- - ! For k = klevp - ! note that we ignore refraction between sea ice and underlying ocean: - ! - ! layers interface - ! - ! --------------------- k-1 - ! k-1 - ! --------------------- k - ! \\\\\\\ ocean \\\\\\\ - - trndir(k+1) = trndir(k)*trnlay(k) - refkm1 = c1/(c1 - rdndif(k)*rdif_a(k)) - tdrrdir = trndir(k)*rdir(k) - tdndif = trntdr(k) - trndir(k) - trntdr(k+1) = trndir(k)*tdir(k) + & - (tdndif + tdrrdir*rdndif(k))*refkm1*tdif_a(k) - rdndif(k+1) = rdif_b(k) + & - (tdif_b(k)*rdndif(k)*refkm1*tdif_a(k)) - trndif(k+1) = trndif(k)*refkm1*tdif_a(k) - - enddo ! k end main level loop - - ! compute reflectivity to direct and diffuse radiation for layers - ! below by adding succesive layers starting from the underlying - ! ocean and working upwards: - ! - ! layers interface - ! - ! --------------------- k - ! k - ! --------------------- k+1 - ! k+1 - ! --------------------- - - rupdir(klevp) = albodr - rupdif(klevp) = albodf - - do k=klev,0,-1 - ! interface scattering - refkp1 = c1/( c1 - rdif_b(k)*rupdif(k+1)) - ! dir from top layer plus exp tran ref from lower layer, interface - ! scattered and tran thru top layer from below, plus diff tran ref - ! from lower layer with interface scattering tran thru top from below - rupdir(k) = rdir(k) & - + ( trnlay(k) *rupdir(k+1) & - + (tdir(k)-trnlay(k))*rupdif(k+1))*refkp1*tdif_b(k) - ! dif from top layer from above, plus dif tran upwards reflected and - ! interface scattered which tran top from below - rupdif(k) = rdif_a(k) + tdif_a(k)*rupdif(k+1)*refkp1*tdif_b(k) - enddo ! k - - end subroutine solution_dEdd - -!======================================================================= -! -! Set snow horizontal coverage, density and grain radius diagnostically -! for the Delta-Eddington solar radiation method. -! -! author: Bruce P. Briegleb, NCAR -! 2013: E Hunke merged with NCAR version - - subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & - dT_mlt, rsnw_mlt, & - aice, vsno, & - Tsfc, fs, & - hs0, hs, & - rhosnw, rsnw, & - rsnow, tr_rsnw) - - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - R_snw , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt, & ! change in temp for non-melt to melt snow grain radius change (C) - rsnw_mlt ! maximum melting snow grain radius (10^-6 m) - - real (kind=dbl_kind), intent(in) :: & - aice , & ! concentration of ice - vsno , & ! volume of snow - Tsfc , & ! surface temperature - hs0 ! snow depth for transition to bare sea ice (m) - - real (kind=dbl_kind), intent(out) :: & - fs , & ! horizontal coverage of snow - hs ! snow depth - - real (kind=dbl_kind), dimension (:), intent(in) :: & - rsnow ! snow grain radius tracer (micro-meters) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - rhosnw , & ! density in snow layer (kg/m3) - rsnw ! grain radius in snow layer (micro-meters) - - logical(kind=log_kind), intent(in) :: & - tr_rsnw ! if true, use rsnow - - ! local variables - - integer (kind=int_kind) :: & - ks ! snow vertical index - - real (kind=dbl_kind) :: & - fT , & ! piecewise linear function of surface temperature - dTs , & ! difference of Tsfc and Timelt - rsnw_nm ! actual used nonmelt snow grain radius (micro-meters) - - real (kind=dbl_kind), parameter :: & - ! units for the following are 1.e-6 m (micro-meters) - rsnw_nonmelt = 500._dbl_kind, & ! nonmelt snow grain radius - rsnw_sig = 250._dbl_kind ! assumed sigma for snow grain radius - -!----------------------------------------------------------------------- - - ! set snow horizontal fraction - hs = vsno / aice - - if (hs >= hs_min) then - fs = c1 - if (hs0 > puny) fs = min(hs/hs0, c1) - endif - - if (tr_rsnw) then !use snow grain tracer - - do ks = 1, nslyr - rsnw(ks) = max(rsnw_fall,rsnow(ks)) - rsnw(ks) = min(rsnw_tmax,rsnw(ks)) - rhosnw(ks) = rhos - enddo - - else - - ! bare ice, temperature dependence - dTs = Timelt - Tsfc - fT = -min(dTs/dT_mlt-c1,c0) - ! tune nonmelt snow grain radius if desired: note that - ! the sign is negative so that if R_snw is 1, then the - ! snow grain radius is reduced and thus albedo increased. - rsnw_nm = rsnw_nonmelt - R_snw*rsnw_sig - rsnw_nm = max(rsnw_nm, rsnw_fall) - rsnw_nm = min(rsnw_nm, rsnw_mlt) - - do ks = 1, nslyr - ! snow density ccsm3 constant value - rhosnw(ks) = rhos - ! snow grain radius between rsnw_nonmelt and rsnw_mlt - rsnw(ks) = rsnw_nm + (rsnw_mlt-rsnw_nm)*fT - rsnw(ks) = max(rsnw(ks), rsnw_fall) - rsnw(ks) = min(rsnw(ks), rsnw_mlt) - enddo ! ks - - endif - - end subroutine shortwave_dEdd_set_snow - -!======================================================================= -! -! Set pond fraction and depth diagnostically for -! the Delta-Eddington solar radiation method. -! -! author: Bruce P. Briegleb, NCAR -! 2013: E Hunke merged with NCAR version - - subroutine shortwave_dEdd_set_pond(Tsfc, & - fs, fp, & - hp) - - real (kind=dbl_kind), intent(in) :: & - Tsfc , & ! surface temperature - fs ! horizontal coverage of snow - - real (kind=dbl_kind), intent(out) :: & - fp , & ! pond fractional coverage (0 to 1) - hp ! pond depth (m) - - ! local variables - - real (kind=dbl_kind) :: & - fT , & ! piecewise linear function of surface temperature - dTs ! difference of Tsfc and Timelt - - real (kind=dbl_kind), parameter :: & - dT_pnd = c1 ! change in temp for pond fraction and depth - -!----------------------------------------------------------------------- - - ! bare ice, temperature dependence - dTs = Timelt - Tsfc - fT = -min(dTs/dT_pnd-c1,c0) - ! pond - fp = 0.3_dbl_kind*fT*(c1-fs) - hp = 0.3_dbl_kind*fT*(c1-fs) - - end subroutine shortwave_dEdd_set_pond - -! End Delta-Eddington shortwave method - -!======================================================================= -! -! authors Nicole Jeffery, LANL - - subroutine compute_shortwave_trcr(n_algae, nslyr, & - trcrn, trcrn_sw, & - sw_grid, hin, & - hbri, ntrcr, & - nilyr, nblyr, & - i_grid, & - nbtrcr_sw, n_zaero, & - skl_bgc, z_tracers, & - l_stop, stop_label) - - use ice_constants_colpkg, only: c0, c1, c2, p5, sk_l - use ice_colpkg_tracers, only: nt_bgc_N, nt_zaero, tr_bgc_N, & - tr_zaero, nlt_chl_sw, nlt_zaero_sw - use ice_colpkg_shared, only: dEdd_algae, bgc_flux_type, & - R_chl2N, min_bgc, F_abs_chl, hi_ssl - use ice_zbgc_shared, only: remap_zbgc - - integer (kind=int_kind), intent(in) :: & - nslyr, & ! number of snow layers - n_zaero , & ! number of cells with aicen > puny - nbtrcr_sw, n_algae, & ! nilyr+nslyr+2 for chlorophyll - ntrcr - - integer (kind=int_kind), intent(in) :: & - nblyr , & ! number of bio layers - nilyr ! number of ice layers - - real (kind=dbl_kind), dimension (ntrcr), intent(in) :: & - trcrn ! aerosol or chlorophyll - - real (kind=dbl_kind), dimension (nbtrcr_sw), & - intent(out) :: & - trcrn_sw ! ice on shortwave grid tracers - - real (kind=dbl_kind), dimension (:), intent(in) :: & - sw_grid , & ! - i_grid ! CICE bio grid - - real(kind=dbl_kind), intent(in) :: & - hin , & ! CICE ice thickness - hbri ! brine height - - logical (kind=log_kind), intent(in) :: & - skl_bgc, & ! skeletal layer bgc - z_tracers ! zbgc - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len), intent(inout) :: stop_label - - ! local variables - - integer (kind=int_kind) :: k, n, nn - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0, & ! temporary, remapped tracers - trtmp - - real (kind=dbl_kind), dimension (nilyr+1):: & - icegrid ! correct for large ice surface layers - - real (kind=dbl_kind):: & - top_conc ! 1% (min_bgc) of surface concentration - ! when hin > hbri: just used in sw calculation - - !----------------------------------------------------------------- - ! Compute aerosols and algal chlorophyll on shortwave grid - !----------------------------------------------------------------- - - trtmp0(:) = c0 - trtmp(:) = c0 - trcrn_sw(:) = c0 - - do k = 1,nilyr+1 - icegrid(k) = sw_grid(k) - enddo - if (sw_grid(1)*hin*c2 > hi_ssl .and. hin > puny) then - icegrid(1) = hi_ssl/c2/hin - endif - icegrid(2) = c2*sw_grid(1) + (sw_grid(2) - sw_grid(1)) - if (z_tracers) then - if (tr_bgc_N) then - do k = 1, nblyr+1 - do n = 1, n_algae - trtmp0(nt_bgc_N(1) + k-1) = trtmp0(nt_bgc_N(1) + k-1) + & - R_chl2N(n)*F_abs_chl(n)*trcrn(nt_bgc_N(n)+k-1) - enddo ! n - enddo ! k - - top_conc = trtmp0(nt_bgc_N(1))*min_bgc - call remap_zbgc (ntrcr, nilyr+1, & - nt_bgc_N(1), & - trtmp0(1:ntrcr ), & - trtmp (1:ntrcr+2), & - 1, nblyr+1, & - hin, hbri, & - icegrid(1:nilyr+1), & - i_grid(1:nblyr+1), top_conc, & - l_stop, stop_label) - - if (l_stop) return - - do k = 1, nilyr+1 - trcrn_sw(nlt_chl_sw+nslyr+k) = trtmp(nt_bgc_N(1) + k-1) - enddo ! k - - do n = 1, n_algae ! snow contribution - trcrn_sw(nlt_chl_sw)= trcrn_sw(nlt_chl_sw) & - + R_chl2N(n)*F_abs_chl(n)*trcrn(nt_bgc_N(n)+nblyr+1) - ! snow surface layer - trcrn_sw(nlt_chl_sw+1:nlt_chl_sw+nslyr) = & - trcrn_sw(nlt_chl_sw+1:nlt_chl_sw+nslyr) & - + R_chl2N(n)*F_abs_chl(n)*trcrn(nt_bgc_N(n)+nblyr+2) - ! only 1 snow layer in zaero - enddo ! n - endif ! tr_bgc_N - - if (tr_zaero) then - do n = 1, n_zaero - - trtmp0(:) = c0 - trtmp(:) = c0 - - do k = 1, nblyr+1 - trtmp0(nt_zaero(n) + k-1) = trcrn(nt_zaero(n)+k-1) - enddo - - top_conc = trtmp0(nt_zaero(n))*min_bgc - call remap_zbgc (ntrcr, nilyr+1, & - nt_zaero(n), & - trtmp0(1:ntrcr ), & - trtmp (1:ntrcr+2), & - 1, nblyr+1, & - hin, hbri, & - icegrid(1:nilyr+1), & - i_grid(1:nblyr+1), top_conc, & - l_stop, stop_label) - - if (l_stop) return - - do k = 1,nilyr+1 - trcrn_sw(nlt_zaero_sw(n)+nslyr+k) = trtmp(nt_zaero(n) + k-1) - enddo - trcrn_sw(nlt_zaero_sw(n))= trcrn(nt_zaero(n)+nblyr+1) !snow ssl - trcrn_sw(nlt_zaero_sw(n)+1:nlt_zaero_sw(n)+nslyr)= trcrn(nt_zaero(n)+nblyr+2) - enddo ! n - endif ! tr_zaero - elseif (skl_bgc) then - - do nn = 1,n_algae - trcrn_sw(nbtrcr_sw) = trcrn_sw(nbtrcr_sw) & - + F_abs_chl(nn)*R_chl2N(nn) & - * trcrn(nt_bgc_N(nn))*sk_l/hin & - * real(nilyr,kind=dbl_kind) - enddo - - endif - end subroutine compute_shortwave_trcr - - -!======================================================================= -! --- Begin 5 band dEdd subroutine --- -! Evaluate snow/ice/ponded ice inherent optical properties (IOPs), and -! then calculate the multiple scattering solution by calling solution_dEdd. -! -! author: Bruce P. Briegleb, NCAR -! 2013: E Hunke merged with NCAR version -! 2018: Cheng Dang merged with SNICAR 5-band snow and aersols IOPs, UC Irvine -! -! Note by Cheng Dang 2018: -! This subroutine kept the existing delta-eddington adding-doubling -! method, snow and sea ice layer sturcture, and most of the code structures -! of subroutine compute_dEdd, with major changeds listed below to merge -! current snow treatments in SNICAR Model -! 1. The shortwave radiative transfer properties of snow-covered sea ice are -! calcualted for 5 bands (1 visible and 4 near-IR) defined in SNICAR -! 2. The reflection/absorption/transmission of direct and diffuse shortwave -! incidents are calculated seperately to remove the snow grain adjustment -! in subroutine compute_dEdd -! 3. The albedo and absorption of snow-covered sea ice are adjusted when solar -! zenith angle is above 75 degree -! 4. Comments given in subroutine compute_dEdd are all kepted in this subroutine -! with modifications at where above changes applies to. -! 5. This subroutine can be modified and merged with subroutine compute_dEdd -! to compute shortwave properties of bare and ponded sea ice if requested. -! For now, these two subroutines are seperated for testing new features. -! -! The justification and explaination for above changes can be find in paper: -! Dang, C., Zender, C. S., and Flanner, M. G.: Inter-comparison and improvement -! of 2-stream shortwave radiative transfer models for unified treatment of -! cryospheric surfaces in ESMs, The Cryosphere Discuss., -! https://doi.org/10.5194/tc-2019-22, in review, 2019 - - subroutine compute_dEdd_5bd (nilyr, nslyr, klev, klevp, & - n_zaero, zbio, dEdd_algae, & - nlt_chl_sw,nlt_zaero_sw, tr_bgc_N, & - tr_zaero, & - heat_capacity, fnidr, coszen, & - n_aero, tr_aero, R_ice, R_pnd, & - kaer_tab_5bd, waer_tab_5bd, gaer_tab_5bd, & - kaer_bc_tab_5bd, waer_bc_tab_5bd, & - gaer_bc_tab_5bd, bcenh_5bd, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & - hs, rhosnw, rsnw, hi, hp, & - fi, aero_mp, alvdr, alvdf, & - alidr, alidf, & - fswsfc, fswint, & - fswthru, Sswabs, & - Iswabs, fswpenl, & - asm_prm_ice_drc, asm_prm_ice_dfs, & - ss_alb_ice_drc, ss_alb_ice_dfs, & - ext_cff_mss_ice_drc, ext_cff_mss_ice_dfs) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - n_aero , & ! number of aerosol tracers - n_zaero , & ! number of zaerosol tracers in use - nlt_chl_sw , & ! index for chla - klev , & ! number of radiation layers - 1 - klevp ! number of radiation interfaces - 1 - ! (0 layer is included also) - - integer (kind=int_kind), dimension(:), intent(in) :: & - nlt_zaero_sw ! index for zaerosols - - logical (kind=log_kind), intent(in) :: & - heat_capacity , & ! if true, ice has nonzero heat capacity - tr_aero , & ! if .true., use aerosol tracers - dEdd_algae , & ! .true. use prognostic chla in dEdd - tr_bgc_N , & ! .true. active bgc (skl or z) - tr_zaero , & ! .true. use zaerosols - modal_aero ! .true. use modal aerosol treatment - - ! dEdd tuning parameters, set in namelist - real (kind=dbl_kind), intent(in) :: & - R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo - R_pnd ! ponded ice tuning parameter; +1 > 1sig increase in albedo - - real (kind=dbl_kind), intent(in) :: & - kalg , & ! algae absorption coefficient - fnidr , & ! fraction of direct to total down flux in nir - coszen , & ! cosine solar zenith angle - swvdr , & ! shortwave down at surface, visible, direct (W/m^2) - swvdf , & ! shortwave down at surface, visible, diffuse (W/m^2) - swidr , & ! shortwave down at surface, near IR, direct (W/m^2) - swidf ! shortwave down at surface, near IR, diffuse (W/m^2) - - integer (kind=int_kind), intent(in) :: & - srftyp ! surface type over ice: (0=air, 1=snow, 2=pond) - - real (kind=dbl_kind), intent(in) :: & - hs ! snow thickness (m) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - rhosnw , & ! snow density in snow layer (kg/m3) - rsnw , & ! snow grain radius in snow layer (m) - zbio , & ! zaerosol + chla shortwave tracers kg/m^3 - aero_mp ! aerosol mass path in kg/m2 - - real (kind=dbl_kind), intent(in) :: & - hi , & ! ice thickness (m) - hp , & ! pond depth (m) - fi ! snow/bare ice fractional coverage (0 to 1) - - real (kind=dbl_kind), intent(inout) :: & - alvdr , & ! visible, direct, albedo (fraction) - alvdf , & ! visible, diffuse, albedo (fraction) - alidr , & ! near-ir, direct, albedo (fraction) - alidf , & ! near-ir, diffuse, albedo (fraction) - fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface (W m-2) - fswint , & ! SW interior absorption (below surface, above ocean,W m-2) - fswthru ! SW through snow/bare ice/ponded ice into ocean (W m-2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - fswpenl , & ! visible SW entering ice layers (W m-2) - Sswabs , & ! SW absorbed in snow layer (W m-2) - Iswabs ! SW absorbed in ice layer (W m-2) - - - ! snow grain single-scattering properties for - ! direct (drc) and diffuse (dfs) shortwave incidents - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Model SNICAR snow SSP - asm_prm_ice_drc , & ! snow asymmetry factor (cos(theta)) - asm_prm_ice_dfs , & ! snow asymmetry factor (cos(theta)) - ss_alb_ice_drc , & ! snow single scatter albedo (fraction) - ss_alb_ice_dfs , & ! snow single scatter albedo (fraction) - ext_cff_mss_ice_drc , & ! snow mass extinction cross section (m2/kg) - ext_cff_mss_ice_dfs ! snow mass extinction cross section (m2/kg) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - kaer_tab_5bd , & ! aerosol mass extinction cross section (m2/kg) - waer_tab_5bd , & ! aerosol single scatter albedo (fraction) - gaer_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment - kaer_bc_tab_5bd , & ! aerosol mass extinction cross section (m2/kg) - waer_bc_tab_5bd , & ! aerosol single scatter albedo (fraction) - gaer_bc_tab_5bd ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment - bcenh_5bd ! BC absorption enhancement factor - -!----------------------------------------------------------------------- -! Set up optical property profiles, based on snow, sea ice and ponded -! ice IOPs from: -! -! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple -! Scattering Parameterization for Solar Radiation in the Sea Ice -! Component of the Community Climate System Model, NCAR Technical -! Note NCAR/TN-472+STR February 2007 -! -! Computes column Delta-Eddington radiation solution for specific -! surface type: either snow over sea ice, bare sea ice, or ponded sea ice. -! -! Divides solar spectrum into 3 intervals: 0.2-0.7, 0.7-1.19, and -! 1.19-5.0 micro-meters. The latter two are added (using an assumed -! partition of incident shortwave in the 0.7-5.0 micro-meter band between -! the 0.7-1.19 and 1.19-5.0 micro-meter band) to give the final output -! of 0.2-0.7 visible and 0.7-5.0 near-infrared albedos and fluxes. -! -! Specifies vertical layer optical properties based on input snow depth, -! density and grain radius, along with ice and pond depths, then computes -! layer by layer Delta-Eddington reflectivity, transmissivity and combines -! layers (done by calling routine solution_dEdd). Finally, surface albedos -! and internal fluxes/flux divergences are evaluated. -! -! Description of the level and layer index conventions. This is -! for the standard case of one snow layer and four sea ice layers. -! -! Please read the following; otherwise, there is 99.9% chance you -! will be confused about indices at some point in time........ :) -! -! CICE4.0 snow treatment has one snow layer above the sea ice. This -! snow layer has finite heat capacity, so that surface absorption must -! be distinguished from internal. The Delta-Eddington solar radiation -! thus adds extra surface scattering layers to both snow and sea ice. -! Note that in the following, we assume a fixed vertical layer structure -! for the radiation calculation. In other words, we always have the -! structure shown below for one snow and four sea ice layers, but for -! ponded ice the pond fills "snow" layer 1 over the sea ice, and for -! bare sea ice the top layers over sea ice are treated as transparent air. -! -! SSL = surface scattering layer for either snow or sea ice -! DL = drained layer for sea ice immediately under sea ice SSL -! INT = interior layers for sea ice below the drained layer. -! -! Notice that the radiation level starts with 0 at the top. Thus, -! the total number radiation layers is klev+1, where klev is the -! sum of nslyr, the number of CCSM snow layers, and nilyr, the -! number of CCSM sea ice layers, plus the sea ice SSL: -! klev = 1 + nslyr + nilyr -! -! For the standard case illustrated below, nslyr=1, nilyr=4, -! and klev=6, with the number of layer interfaces klevp=klev+1. -! Layer interfaces are the surfaces on which reflectivities, -! transmissivities and fluxes are evaluated. -! -! CCSM3 Sea Ice Model Delta-Eddington Solar Radiation -! Layers and Interfaces -! Layer Index Interface Index -! --------------------- --------------------- 0 -! 0 \\\ snow SSL \\\ -! snow layer 1 --------------------- 1 -! 1 rest of snow layer -! +++++++++++++++++++++ +++++++++++++++++++++ 2 -! 2 \\\ sea ice SSL \\\ -! sea ice layer 1 --------------------- 3 -! 3 sea ice DL -! --------------------- --------------------- 4 -! -! sea ice layer 2 4 sea ice INT -! -! --------------------- --------------------- 5 -! -! sea ice layer 3 5 sea ice INT -! -! --------------------- --------------------- 6 -! -! sea ice layer 4 6 sea ice INT -! -! --------------------- --------------------- 7 -! -! When snow lies over sea ice, the radiation absorbed in the -! snow SSL is used for surface heating, and that in the rest -! of the snow layer for its internal heating. For sea ice in -! this case, all of the radiant heat absorbed in both the -! sea ice SSL and the DL are used for sea ice layer 1 heating. -! -! When pond lies over sea ice, and for bare sea ice, all of the -! radiant heat absorbed within and above the sea ice SSL is used -! for surface heating, and that absorbed in the sea ice DL is -! used for sea ice layer 1 heating. -! -! Basically, vertical profiles of the layer extinction optical depth (tau), -! single scattering albedo (w0) and asymmetry parameter (g) are required over -! the klev+1 layers, where klev+1 = 2 + nslyr + nilyr. All of the surface type -! information and snow/ice iop properties are evaulated in this routine, so -! the tau,w0,g profiles can be passed to solution_dEdd for multiple scattering -! evaluation. Snow, bare ice and ponded ice iops are contained in data arrays -! in this routine. -! -!----------------------------------------------------------------------- - - ! local variables - - integer (kind=int_kind) :: & - k , & ! level index - ns , & ! spectral index - nr , & ! index for grain radius tables - ki , & ! index for internal absorption - km , & ! k starting index for snow, sea ice internal absorption - kp , & ! k+1 or k+2 index for snow, sea ice internal absorption - ksrf , & ! level index for surface absorption - ksnow , & ! level index for snow density and grain size - kii ! level starting index for sea ice (nslyr+1) - - integer (kind=int_kind), parameter :: & - nmbrad = 32 ! number of snow grain radii in tables - - real (kind=dbl_kind) :: & - avdr , & ! visible albedo, direct (fraction) - avdf , & ! visible albedo, diffuse (fraction) - aidr , & ! near-ir albedo, direct (fraction) - aidf ! near-ir albedo, diffuse (fraction) - - real (kind=dbl_kind) :: & - fsfc , & ! shortwave absorbed at snow/bare ice/ponded ice surface (W m-2) - fint , & ! shortwave absorbed in interior (W m-2) - fthru ! shortwave through snow/bare ice/ponded ice to ocean (W/m^2) - - real (kind=dbl_kind), dimension(nslyr) :: & - Sabs ! shortwave absorbed in snow layer (W m-2) - - real (kind=dbl_kind), dimension(nilyr) :: & - Iabs ! shortwave absorbed in ice layer (W m-2) - - real (kind=dbl_kind), dimension(nilyr+1) :: & - fthrul ! shortwave through to ice layers (W m-2) - - real (kind=dbl_kind), dimension (nspint) :: & - wghtns ! spectral weights - - real (kind=dbl_kind), parameter :: & - cp67 = 0.67_dbl_kind , & ! nir band weight parameter - cp33 = 0.33_dbl_kind , & ! nir band weight parameter - cp78 = 0.78_dbl_kind , & ! nir band weight parameter - cp22 = 0.22_dbl_kind , & ! nir band weight parameter - cp01 = 0.01_dbl_kind ! for ocean visible albedo - - real (kind=dbl_kind), dimension (0:klev) :: & - tau , & ! layer extinction optical depth - w0 , & ! layer single scattering albedo - g ! layer asymmetry parameter - - ! following arrays are defined at model interfaces; 0 is the top of the - ! layer above the sea ice; klevp is the sea ice/ocean interface. - real (kind=dbl_kind), dimension (0:klevp) :: & - trndir , & ! solar beam down transmission from top - trntdr , & ! total transmission to direct beam for layers above - trndif , & ! diffuse transmission to diffuse beam for layers above - rupdir , & ! reflectivity to direct radiation for layers below - rupdif , & ! reflectivity to diffuse radiation for layers below - rdndif ! reflectivity to diffuse radiation for layers above - - real (kind=dbl_kind), dimension (0:klevp) :: & - dfdir , & ! down-up flux at interface due to direct beam at top surface - dfdif ! down-up flux at interface due to diffuse beam at top surface - - real (kind=dbl_kind) :: & - refk , & ! interface k multiple scattering term - delr , & ! snow grain radius interpolation parameter - ! inherent optical properties (iop) for snow - Qs , & ! Snow extinction efficiency - ks , & ! Snow mass extinction coefficient (m^2/kg) - ws , & ! Snow single scattering albedo - gs ! Snow asymmetry parameter - - real (kind=dbl_kind), dimension(nslyr) :: & - frsnw ! snow grain radius in snow layer * adjustment factor (m) - - ! actual used ice and ponded ice IOPs, allowing for tuning - ! modifications of the above "_mn" value - real (kind=dbl_kind), dimension (nspint) :: & - ki_ssl , & ! Surface-scattering-layer ice extinction coefficient (/m) - wi_ssl , & ! Surface-scattering-layer ice single scattering albedo - gi_ssl , & ! Surface-scattering-layer ice asymmetry parameter - ki_dl , & ! Drained-layer ice extinction coefficient (/m) - wi_dl , & ! Drained-layer ice single scattering albedo - gi_dl , & ! Drained-layer ice asymmetry parameter - ki_int , & ! Interior-layer ice extinction coefficient (/m) - wi_int , & ! Interior-layer ice single scattering albedo - gi_int , & ! Interior-layer ice asymmetry parameter - ki_p_ssl , & ! Ice under pond srf scat layer extinction coefficient (/m) - wi_p_ssl , & ! Ice under pond srf scat layer single scattering albedo - gi_p_ssl , & ! Ice under pond srf scat layer asymmetry parameter - ki_p_int , & ! Ice under pond extinction coefficient (/m) - wi_p_int , & ! Ice under pond single scattering albedo - gi_p_int ! Ice under pond asymmetry parameter - - real (kind=dbl_kind), dimension(0:klev) :: & - dzk ! layer thickness - - real (kind=dbl_kind) :: & - dz , & ! snow, sea ice or pond water layer thickness - dz_ssl , & ! snow or sea ice surface scattering layer thickness - fs ! scaling factor to reduce (nilyr<4) or increase (nilyr>4) DL - ! extinction coefficient to maintain DL optical depth constant - ! with changing number of sea ice layers, to approximately - ! conserve computed albedo for constant physical depth of sea - ! ice when the number of sea ice layers vary - real (kind=dbl_kind) :: & - sig , & ! scattering coefficient for tuning - kabs , & ! absorption coefficient for tuning - sigp ! modified scattering coefficient for tuning - - - real (kind=dbl_kind) :: & - albodr , & ! spectral ocean albedo to direct rad - albodf ! spectral ocean albedo to diffuse rad - - ! for melt pond transition to bare sea ice for small pond depths - real (kind=dbl_kind) :: & - sig_i , & ! ice scattering coefficient (/m) - sig_p , & ! pond scattering coefficient (/m) - kext ! weighted extinction coefficient (/m) - - ! aerosol optical properties from Mark Flanner, 26 June 2008 - ! order assumed: hydrophobic black carbon, hydrophilic black carbon, - ! four dust aerosols by particle size range: - ! dust1(.05-0.5 micron), dust2(0.5-1.25 micron), - ! dust3(1.25-2.5 micron), dust4(2.5-5.0 micron) - ! spectral bands same as snow/sea ice: (0.3-0.7 micron, 0.7-1.19 micron - ! and 1.19-5.0 micron in wavelength) - - integer (kind=int_kind) :: & - na , n ! aerosol index - - real (kind=dbl_kind) :: & - taer , & ! total aerosol extinction optical depth - waer , & ! total aerosol single scatter albedo - gaer , & ! total aerosol asymmetry parameter - swdr , & ! shortwave down at surface, direct (W/m^2) - swdf , & ! shortwave down at surface, diffuse (W/m^2) - rnilyr , & ! real(nilyr) - rnslyr , & ! real(nslyr) - rns , & ! real(ns) - tmp_0, tmp_ks, tmp_kl ! temp variables - - integer(kind=int_kind), dimension(0:klev) :: & - k_bcini , & - k_bcins , & - k_bcexs - - real(kind=dbl_kind):: & - tmp_gs, tmp1 ! temp variables - - ! inherent optical property (iop) arrays for ice and ponded ice - ! mn = specified mean (or base) value - ! ki = extinction coefficient (/m) - ! wi = single scattering albedo - ! gi = asymmetry parameter - - ! ice surface scattering layer (ssl) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_ssl_mn = (/ 1000.1_dbl_kind, 1003.7_dbl_kind, 7042._dbl_kind/), & - wi_ssl_mn = (/ .9999_dbl_kind, .9963_dbl_kind, .9088_dbl_kind/), & - gi_ssl_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind/) - - ! ice drained layer (dl) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_dl_mn = (/ 100.2_dbl_kind, 107.7_dbl_kind, 1309._dbl_kind /), & - wi_dl_mn = (/ .9980_dbl_kind, .9287_dbl_kind, .0305_dbl_kind /), & - gi_dl_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! ice interior layer (int) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_int_mn = (/ 20.2_dbl_kind, 27.7_dbl_kind, 1445._dbl_kind /), & - wi_int_mn = (/ .9901_dbl_kind, .7223_dbl_kind, .0277_dbl_kind /), & - gi_int_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! ponded ice surface scattering layer (ssl) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_p_ssl_mn = (/ 70.2_dbl_kind, 77.7_dbl_kind, 1309._dbl_kind/), & - wi_p_ssl_mn = (/ .9972_dbl_kind, .9009_dbl_kind, .0305_dbl_kind/), & - gi_p_ssl_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! ponded ice interior layer (int) iops - real (kind=dbl_kind), dimension (nspint), parameter :: & - ki_p_int_mn = (/ 20.2_dbl_kind, 27.7_dbl_kind, 1445._dbl_kind/), & - wi_p_int_mn = (/ .9901_dbl_kind, .7223_dbl_kind, .0277_dbl_kind/), & - gi_p_int_mn = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind /) - - ! inherent optical property (iop) arrays for pond water and underlying ocean - ! kw = Pond water extinction coefficient (/m) - ! ww = Pond water single scattering albedo - ! gw = Pond water asymmetry parameter - real (kind=dbl_kind), dimension (nspint), parameter :: & - kw = (/ 0.20_dbl_kind, 12.0_dbl_kind, 729._dbl_kind /), & - ww = (/ 0.00_dbl_kind, 0.00_dbl_kind, 0.00_dbl_kind /), & - gw = (/ 0.00_dbl_kind, 0.00_dbl_kind, 0.00_dbl_kind /) - - real (kind=dbl_kind), parameter :: & - rhoi = 917.0_dbl_kind, & ! pure ice mass density (kg/m3) - fr_max = 1.00_dbl_kind, & ! snow grain adjustment factor max - fr_min = 0.80_dbl_kind, & ! snow grain adjustment factor min - ! tuning parameters - ! ice and pond scat coeff fractional change for +- one-sigma in albedo - fp_ice = 0.15_dbl_kind, & ! ice fraction of scat coeff for + stn dev in alb - fm_ice = 0.15_dbl_kind, & ! ice fraction of scat coeff for - stn dev in alb - fp_pnd = 2.00_dbl_kind, & ! ponded ice fraction of scat coeff for + stn dev in alb - fm_pnd = 0.50_dbl_kind ! ponded ice fraction of scat coeff for - stn dev in alb - - real (kind=dbl_kind), parameter :: & !chla-specific absorption coefficient - kchl_tab = 0.01 !0.0023-0.0029 Perovich 1993, also 0.0067 m^2 (mg Chl)^-1 - ! found values of 0.006 to 0.023 m^2/ mg (676 nm) Neukermans 2014 - ! and averages over the 300-700nm of 0.0075 m^2/mg in ice Fritsen (2011) - ! at 440nm values as high as 0.2 m^2/mg in under ice bloom (Balch 2014) - ! Grenfell 1991 uses 0.004 (m^2/mg) which is (0.0078 * spectral weighting) - !chlorophyll mass extinction cross section (m^2/mg chla) - - character(len=char_len_long) :: & - warning ! warning message - - ! SNICAR - ! new inputs - integer (kind=int_kind), parameter :: & - nmbrad_snicar = 1471 , &! number of snow grain radii in SNICAR - ! snow iops table - rsnw_snicar_max = 1500 , & - rsnw_snicar_min = 30 - - real (kind=dbl_kind), dimension (nspint_5bd) :: & - wghtns_5bd_dfs, & ! spectral weights for diffuse incident - wghtns_5bd_drc ! spectral weights for direct incident - - ! FUTURE-WORK: update 5-band sea ice iops when avalible - real (kind=dbl_kind), dimension (nspint_5bd) :: & ! for ice only - ki_ssl_5bd , & ! Surface-scattering-layer ice extinction coefficient (/m) - wi_ssl_5bd , & ! Surface-scattering-layer ice single scattering albedo - gi_ssl_5bd , & ! Surface-scattering-layer ice asymmetry parameter - ki_dl_5bd , & ! Drained-layer ice extinction coefficient (/m) - wi_dl_5bd , & ! Drained-layer ice single scattering albedo - gi_dl_5bd , & ! Drained-layer ice asymmetry parameter - ki_int_5bd , & ! Interior-layer ice extinction coefficient (/m) - wi_int_5bd , & ! Interior-layer ice single scattering albedo - gi_int_5bd ! Interior-layer ice asymmetry parameter - - ! 5-band aersol data - real (kind=dbl_kind), dimension(nspint_5bd, 0:klev) :: & - kabs_chl_5bd , & ! absorption coefficient for chlorophyll (/m) - tzaer_5bd , & ! total aerosol extinction optical depth - wzaer_5bd , & ! total aerosol single scatter albedo - gzaer_5bd ! total aerosol asymmetry parameter - - ! index - integer (kind=int_kind) :: & - nsky !sky = 1 (2) for direct (diffuse) downward SW incident - - ! temporary variables used to assign variables for direct/diffuse incident - ! based on snicar 5 band IOPs - real (kind=dbl_kind), dimension (0:klevp) :: & - dfdir_snicar , & ! down-up flux at interface due to direct beam at top surface - dfdif_snicar , & ! down-up flux at interface due to diffuse beam at top surface - rupdir_snicar , & ! reflectivity to direct radiation for layers below - rupdif_snicar ! reflectivity to diffuse radiation for layers above - - ! solar zenith angle parameterizations - real (kind=dbl_kind), parameter :: & - sza_a0 = 0.085730_dbl_kind , & - sza_a1 = -0.630883_dbl_kind , & - sza_a2 = 1.303723_dbl_kind , & - sza_b0 = 1.467291_dbl_kind , & - sza_b1 = -3.338043_dbl_kind , & - sza_b2 = 6.807489_dbl_kind , & - mu_75 = 0.2588_dbl_kind ! cosine of 75 degree - - real (kind=dbl_kind) :: & - sza_c1 , & ! parameter for high sza adjustment - sza_c0 , & ! parameter for high sza adjustment - sza_factor , & ! parameter for high sza adjustment - mu0 - - ! 5-bands ice surface scattering layer (ssl) iops to match SNICAR calculations - ! note by Cheng Dang: - ! for now these data are not needed since the sea ice layer IOPs can be directly - ! assigned based on the 3 bands data after adjustment based on tuning parameter R_ice - ! In the future, when 5-band sea ice IOPs are available, these data shall be updated - ! and the sea ice layer IOPs shall be calculated based on updated 5band iops* - ! - ! The 5band data given in this section are based on CICE and SNICAR band choice: - ! SNICAR band 1 = CICE band 1 - ! SNICAR band 2 = SNICAR band 3 = CICE band 2 - ! SNICAR band 4 = SNICAR band 5 = CICE band 3 - - ! ice surface scattering layer (ssl) iops - real (kind=dbl_kind), dimension (nspint_5bd), parameter :: & - ki_ssl_mn_5bd = (/ 1000.1_dbl_kind, 1003.7_dbl_kind, 1003.7_dbl_kind, & - 7042._dbl_kind, 7042._dbl_kind /), & - wi_ssl_mn_5bd = (/ .9999_dbl_kind, .9963_dbl_kind, .9963_dbl_kind, & - .9088_dbl_kind, .9088_dbl_kind /), & - gi_ssl_mn_5bd = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind, & - .94_dbl_kind, .94_dbl_kind /) - - ! ice drained layer (dl) iops - real (kind=dbl_kind), dimension (nspint_5bd), parameter :: & - ki_dl_mn_5bd = (/ 100.2_dbl_kind, 107.7_dbl_kind, 107.7_dbl_kind, & - 1309._dbl_kind, 1309._dbl_kind /), & - wi_dl_mn_5bd = (/ .9980_dbl_kind, .9287_dbl_kind, .9287_dbl_kind, & - .0305_dbl_kind, .0305_dbl_kind /), & - gi_dl_mn_5bd = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind, & - .94_dbl_kind, .94_dbl_kind /) - - ! ice interior layer (int) iops - real (kind=dbl_kind), dimension (nspint_5bd), parameter :: & - ki_int_mn_5bd = (/ 20.2_dbl_kind, 27.7_dbl_kind, 27.7_dbl_kind, & - 1445._dbl_kind, 1445._dbl_kind/), & - wi_int_mn_5bd = (/ .9901_dbl_kind, .7223_dbl_kind, .7223_dbl_kind, & - .0277_dbl_kind, .0277_dbl_kind /), & - gi_int_mn_5bd = (/ .94_dbl_kind, .94_dbl_kind, .94_dbl_kind, & - .94_dbl_kind, .94_dbl_kind /) - -!----------------------------------------------------------------------- -! Initialize and tune bare ice/ponded ice iops - - k_bcini(:) = c0 - k_bcins(:) = c0 - k_bcexs(:) = c0 - - rnilyr = c1/real(nilyr,kind=dbl_kind) - rnslyr = c1/real(nslyr,kind=dbl_kind) - kii = nslyr + 1 - - ! initialize albedos and fluxes to 0 - fthrul = c0 - Iabs = c0 - kabs_chl_5bd(:,:) = c0 - tzaer_5bd(:,:) = c0 - wzaer_5bd(:,:) = c0 - gzaer_5bd(:,:) = c0 - - avdr = c0 - avdf = c0 - aidr = c0 - aidf = c0 - fsfc = c0 - fint = c0 - fthru = c0 - - ! spectral weights - 3 bands - ! this section of code is kept for future mearge between 5band and 3 band - ! subroutines - ! weights 2 (0.7-1.19 micro-meters) and 3 (1.19-5.0 micro-meters) - ! are chosen based on 1D calculations using ratio of direct to total - ! near-infrared solar (0.7-5.0 micro-meter) which indicates clear/cloudy - ! conditions: more cloud, the less 1.19-5.0 relative to the - ! 0.7-1.19 micro-meter due to cloud absorption. - !wghtns(1) = c1 - !wghtns(2) = cp67 + (cp78-cp67)*(c1-fnidr) -! wghtns(3) = cp33 + (cp22-cp33)*(c1-fnidr) - !wghtns(3) = c1 - wghtns(2) - - ! spectral weights - 5 bands - ! direct beam incident - ! add-local-variable - wghtns_5bd_drc(1) = 1._dbl_kind - wghtns_5bd_drc(2) = 0.49352158521175_dbl_kind!0.49352_dbl_kind!0.50_dbl_kind - wghtns_5bd_drc(3) = 0.18099494230665_dbl_kind!0.18100_dbl_kind!0.18_dbl_kind - wghtns_5bd_drc(4) = 0.12094898498813_dbl_kind!0.12095_dbl_kind!0.12_dbl_kind ! - wghtns_5bd_drc(5) = c1-(wghtns_5bd_drc(2)+wghtns_5bd_drc(3)+wghtns_5bd_drc(4)) - !wghtns_5bd_drc(5) = 0.20453448749347_dbl_kind!0.20453_dbl_kind!0.20_dbl_kind ! - - ! diffuse incident - wghtns_5bd_dfs(1) = 1._dbl_kind - wghtns_5bd_dfs(2) = 0.58581507618433_dbl_kind!0.58582_dbl_kind!0.59_dbl_kind ! - wghtns_5bd_dfs(3) = 0.20156903770812_dbl_kind!0.20157_dbl_kind!0.20_dbl_kind ! - wghtns_5bd_dfs(4) = 0.10917889346386_dbl_kind!0.10918_dbl_kind!0.11_dbl_kind ! - wghtns_5bd_dfs(5) = c1-(wghtns_5bd_dfs(2)+wghtns_5bd_dfs(3)+wghtns_5bd_dfs(4)) - !wghtns_5bd_dfs(5) = 0.10343699264369_dbl_kind!0.10343_dbl_kind!0.10_dbl_kind ! - - - do k = 1, nslyr - !frsnw(k) = (fr_max*fnidr + fr_min*(c1-fnidr))*rsnw(k) - Sabs(k) = c0 - enddo - - ! layer thicknesses - ! snow - dz = hs*rnslyr - ! for small enough snow thickness, ssl thickness half of top snow layer -!ech: note this is highly resolution dependent! - dzk(0) = min(hs_ssl, dz/c2) - dzk(1) = dz - dzk(0) - if (nslyr > 1) then - do k = 2, nslyr - dzk(k) = dz - enddo - endif - - ! ice - dz = hi*rnilyr - ! empirical reduction in sea ice ssl thickness for ice thinner than 1.5m; - ! factor of 30 gives best albedo comparison with limited observations - dz_ssl = hi_ssl -!ech: note hardwired parameters -! if( hi < 1.5_dbl_kind ) dz_ssl = hi/30._dbl_kind - dz_ssl = min(hi_ssl, hi/30._dbl_kind) - ! set sea ice ssl thickness to half top layer if sea ice thin enough -!ech: note this is highly resolution dependent! - dz_ssl = min(dz_ssl, dz/c2) - - dzk(kii) = dz_ssl - dzk(kii+1) = dz - dz_ssl - if (kii+2 <= klev) then - do k = kii+2, klev - dzk(k) = dz - enddo - endif - - ! adjust sea ice iops with tuning parameters; tune only the - ! scattering coefficient by factors of R_ice, R_pnd, where - ! R values of +1 correspond approximately to +1 sigma changes in albedo, and - ! R values of -1 correspond approximately to -1 sigma changes in albedo - ! Note: the albedo change becomes non-linear for R values > +1 or < -1 - if( R_ice >= c0 ) then - do ns = 1, nspint_5bd - sigp = ki_ssl_mn_5bd(ns)*wi_ssl_mn_5bd(ns)*(c1+fp_ice*R_ice) - ki_ssl_5bd(ns) = sigp+ki_ssl_mn_5bd(ns)*(c1-wi_ssl_mn_5bd(ns)) - wi_ssl_5bd(ns) = sigp/ki_ssl_5bd(ns) - gi_ssl_5bd(ns) = gi_ssl_mn_5bd(ns) - - sigp = ki_dl_mn_5bd(ns)*wi_dl_mn_5bd(ns)*(c1+fp_ice*R_ice) - ki_dl_5bd(ns) = sigp+ki_dl_mn_5bd(ns)*(c1-wi_dl_mn_5bd(ns)) - wi_dl_5bd(ns) = sigp/ki_dl_5bd(ns) - gi_dl_5bd(ns) = gi_dl_mn_5bd(ns) - - sigp = ki_int_mn_5bd(ns)*wi_int_mn_5bd(ns)*(c1+fp_ice*R_ice) - ki_int_5bd(ns) = sigp+ki_int_mn_5bd(ns)*(c1-wi_int_mn_5bd(ns)) - wi_int_5bd(ns) = sigp/ki_int_5bd(ns) - gi_int_5bd(ns) = gi_int_mn_5bd(ns) - enddo - else !if( R_ice < c0 ) then - do ns = 1, nspint_5bd - sigp = ki_ssl_mn_5bd(ns)*wi_ssl_mn_5bd(ns)*(c1+fm_ice*R_ice) - sigp = max(sigp, c0) - ki_ssl_5bd(ns) = sigp+ki_ssl_mn_5bd(ns)*(c1-wi_ssl_mn_5bd(ns)) - wi_ssl_5bd(ns) = sigp/ki_ssl_5bd(ns) - gi_ssl_5bd(ns) = gi_ssl_mn_5bd(ns) - - sigp = ki_dl_mn_5bd(ns)*wi_dl_mn_5bd(ns)*(c1+fm_ice*R_ice) - sigp = max(sigp, c0) - ki_dl_5bd(ns) = sigp+ki_dl_mn_5bd(ns)*(c1-wi_dl_mn_5bd(ns)) - wi_dl_5bd(ns) = sigp/ki_dl_5bd(ns) - gi_dl_5bd(ns) = gi_dl_mn_5bd(ns) - - sigp = ki_int_mn_5bd(ns)*wi_int_mn_5bd(ns)*(c1+fm_ice*R_ice) - sigp = max(sigp, c0) - ki_int_5bd(ns) = sigp+ki_int_mn_5bd(ns)*(c1-wi_int_mn_5bd(ns)) - wi_int_5bd(ns) = sigp/ki_int_5bd(ns) - gi_int_5bd(ns) = gi_int_mn_5bd(ns) - enddo - endif ! adjust ice iops - - ! use srftyp to determine interface index of surface absorption - ksrf = 1 ! snow covered sea ice - - if (tr_bgc_N .and. dEdd_algae) then ! compute kabs_chl for chlorophyll - do k = 0, klev - kabs_chl_5bd(1,k) = kchl_tab*zbio(nlt_chl_sw+k) - enddo - else - k = klev - kabs_chl_5bd(1,k) = kalg*(0.50_dbl_kind/dzk(k)) - !print *, 'aerosol, k, kabs_chl_5bd(1,k)', k, kabs_chl_5bd(1,k) - endif - -!mgf++ - if (modal_aero) then - do k=0,klev - if (k < nslyr+1) then ! define indices for snow layer - ! use top rsnw, rhosnw for snow ssl and rest of top layer - ! Cheng: note that aerosol IOPs are related to snow grain radius. - ! CICE adjusted snow grain radius rsnw to frsnw, while for - ! SNICAR there is no need, the tmp_gs is therefore calculated - ! differently from code in subroutine compute_dEdd - ksnow = k - min(k-1,0) - tmp_gs = rsnw(ksnow) ! use rsnw not frsnw - - ! get grain size index: - ! works for 25 < snw_rds < 1625 um: - if (tmp_gs < 125._dbl_kind) then - tmp1 = tmp_gs/50._dbl_kind - k_bcini(k) = nint(tmp1) - elseif (tmp_gs < 175._dbl_kind) then - k_bcini(k) = 2 - else - tmp1 = (tmp_gs/250._dbl_kind) + c2 - k_bcini(k) = nint(tmp1) - endif - else ! use the largest snow grain size for ice - k_bcini(k) = 8 - endif - ! Set index corresponding to BC effective radius. Here, - ! asssume constant BC effective radius of 100nm - ! (corresponding to index 2) - k_bcins(k) = 2 - k_bcexs(k) = 2 - - ! check bounds: - if (k_bcini(k) < 1) k_bcini(k) = 1 - if (k_bcini(k) > 8) k_bcini(k) = 8 - if (k_bcins(k) < 1) k_bcins(k) = 1 - if (k_bcins(k) > 10) k_bcins(k) = 10 - if (k_bcexs(k) < 1) k_bcexs(k) = 1 - if (k_bcexs(k) > 10) k_bcexs(k) = 10 - - ! print ice radius index: - ! write(warning,*) "MGFICE2:k, ice index= ",k, k_bcini(k) - ! call add_warning(warning) - enddo ! k - ! assign the aerosol index - - if (tr_zaero .and. dEdd_algae) then ! compute kzaero for chlorophyll - do n = 1,n_zaero - if (n == 1) then ! interstitial BC - do k = 0, klev - do ns = 1,nspint_5bd ! not weighted by aice - tzaer_5bd(ns,k) = tzaer_5bd(ns,k)+kaer_bc_tab_5bd(ns,k_bcexs(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer_5bd(ns,k) = wzaer_5bd(ns,k)+kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer_5bd(ns,k) = gzaer_5bd(ns,k)+kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k))* & - gaer_bc_tab_5bd(ns,k_bcexs(k))*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - elseif (n==2) then ! within-ice BC - do k = 0, klev - do ns = 1,nspint_5bd - tzaer_5bd(ns,k) = tzaer_5bd(ns,k)+kaer_bc_tab_5bd(ns,k_bcins(k)) * & - bcenh_5bd(ns,k_bcins(k),k_bcini(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer_5bd(ns,k) = wzaer_5bd(ns,k)+kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k))* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer_5bd(ns,k) = gzaer_5bd(ns,k)+kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k))* & - gaer_bc_tab_5bd(ns,k_bcins(k))*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - else ! dust - do k = 0, klev - do ns = 1,nspint_5bd ! not weighted by aice - tzaer_5bd(ns,k) = tzaer_5bd(ns,k)+kaer_tab_5bd(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer_5bd(ns,k) = wzaer_5bd(ns,k)+kaer_tab_5bd(ns,n)*waer_tab_5bd(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer_5bd(ns,k) = gzaer_5bd(ns,k)+kaer_tab_5bd(ns,n)*waer_tab_5bd(ns,n)* & - gaer_tab_5bd(ns,n)*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - endif !(n=1) - enddo ! n_zaero - endif ! tr_zaero and dEdd_algae - - else ! Bulk aerosol treatment - if (tr_zaero .and. dEdd_algae) then ! compute kzaero for chlorophyll - do n = 1,n_zaero ! multiply by aice? - do k = 0, klev - do ns = 1,nspint_5bd ! not weighted by aice - tzaer_5bd(ns,k) = tzaer_5bd(ns,k)+kaer_tab_5bd(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - wzaer_5bd(ns,k) = wzaer_5bd(ns,k)+kaer_tab_5bd(ns,n)*waer_tab_5bd(ns,n)* & - zbio(nlt_zaero_sw(n)+k)*dzk(k) - gzaer_5bd(ns,k) = gzaer_5bd(ns,k)+kaer_tab_5bd(ns,n)*waer_tab_5bd(ns,n)* & - gaer_tab_5bd(ns,n)*zbio(nlt_zaero_sw(n)+k)*dzk(k) - enddo ! nspint - enddo - enddo - endif !tr_zaero - - endif ! modal_aero - - -!----------------------------------------------------------------------- - ! begin spectral loop - do ns = 1, nspint_5bd - ! for snow-covered sea ice, comput 5 bands - !if( srftyp == 1 ) then - ! SNICAR-AD major changes - ! 1. loop through 5bands: do ns = 1, nspint_5bd based on nsky - ! 2. use snow grain size rsnow, not scaled frsnw - ! 3. replace $IOPs_tab with $IOPs_snicar - ! 4. replace wghtns with wghtns_5bd - do nsky = 1,2 ! loop for both direct beam and diffuse beam - if (nsky == 1) then ! direc incident - do k=0,nslyr - ! use top rsnw, rhosnw for snow ssl and rest of top layer - ksnow = k - min(k-1,0) - if (rsnw(ksnow) <= rsnw_snicar_min) then - ks = ext_cff_mss_ice_drc(ns,1) - ws = ss_alb_ice_drc(ns,1) - gs = asm_prm_ice_drc(ns,1) - elseif (rsnw(ksnow) >= rsnw_snicar_max) then - ks = ext_cff_mss_ice_drc(ns,nmbrad_snicar) - ws = ss_alb_ice_drc(ns,nmbrad_snicar) - gs = asm_prm_ice_drc(ns,nmbrad_snicar) - elseif (ceiling(rsnw(ksnow)) - rsnw(ksnow) < 1.0e-3_dbl_kind) then - nr = ceiling(rsnw(ksnow)) - 30 + 1 - ks = ext_cff_mss_ice_drc(ns,nr) - ws = ss_alb_ice_drc(ns,nr) - gs = asm_prm_ice_drc(ns,nr) - else ! linear interpolation in rsnw - ! radius = 30 --> nr = 1 in SNICAR table - nr = ceiling(rsnw(ksnow)) - 30 + 1 - delr = (rsnw(ksnow) - floor(rsnw(ksnow))) / & - (ceiling(rsnw(ksnow)) - floor(rsnw(ksnow))) - ks = ext_cff_mss_ice_drc(ns,nr-1)*(c1-delr) + & - ext_cff_mss_ice_drc(ns,nr)*delr - ws = ss_alb_ice_drc(ns,nr-1)*(c1-delr) + & - ss_alb_ice_drc(ns,nr)* delr - gs = asm_prm_ice_drc(ns,nr-1)*(c1-delr) + & - asm_prm_ice_drc(ns,nr)*delr - endif - ! ks = Qs*((rhosnw(ksnow)/rhoi)*3._dbl_kind / & - ! (4._dbl_kind*rsnw(ksnow)*1.0e-6_dbl_kind)) - tau(k) = (ks*rhosnw(ksnow) + kabs_chl_5bd(ns,k))*dzk(k) - !w0(k) = ks/(ks + kabs_chl_5bd(ns,k))*ws - w0(k) = (ks*rhosnw(ksnow))/(ks*rhosnw(ksnow) + kabs_chl_5bd(ns,k)) * ws - g(k) = gs - - !write(warning, *) "sky, k, tau, w0, g =", nsky, k, tau(k), w0(k), g(k) - !write(warning, *) "ns, ks, kabs_chl_5bd(ns,k), ", ns, ks, kabs_chl_5bd(ns,k) - !call add_warning(warning) - !print *, "rsnw(ksnow)", rsnw(ksnow) - !print *, "sky, k, tau, w0, g =", nsky, k, tau(k), w0(k), g(k) - !print *, "ns, ks, kabs_chl_5bd(ns,k), ",ns, ks, kabs_chl_5bd(ns,k) - - enddo ! k - elseif (nsky == 2) then ! diffuse incident - do k=0,nslyr - ! use top rsnw, rhosnw for snow ssl and rest of top layer - ksnow = k - min(k-1,0) - if (rsnw(ksnow) < rsnw_snicar_min) then - ks = ext_cff_mss_ice_dfs(ns,1) - ws = ss_alb_ice_dfs(ns,1) - gs = asm_prm_ice_dfs(ns,1) - elseif (rsnw(ksnow) > rsnw_snicar_max) then - ks = ext_cff_mss_ice_dfs(ns,nmbrad_snicar) - ws = ss_alb_ice_dfs(ns,nmbrad_snicar) - gs = asm_prm_ice_dfs(ns,nmbrad_snicar) - elseif (ceiling(rsnw(ksnow)) - rsnw(ksnow) < 1.0e-3_dbl_kind) then - nr = ceiling(rsnw(ksnow)) - 30 + 1 - ks = ext_cff_mss_ice_dfs(ns,nr) - ws = ss_alb_ice_dfs(ns,nr) - gs = asm_prm_ice_dfs(ns,nr) - else ! linear interpolation in rsnw - ! radius = 30 --> nr = 1 in SNICAR table - nr = ceiling(rsnw(ksnow)) - 30 + 1 - delr = (rsnw(ksnow) - floor(rsnw(ksnow))) / & - (ceiling(rsnw(ksnow)) - floor(rsnw(ksnow))) - ks = ext_cff_mss_ice_dfs(ns,nr-1)*(c1-delr) + & - ext_cff_mss_ice_dfs(ns,nr)*delr - ws = ss_alb_ice_dfs(ns,nr-1)*(c1-delr) + & - ss_alb_ice_dfs(ns,nr)*delr - gs = asm_prm_ice_dfs(ns,nr-1)*(c1-delr) + & - asm_prm_ice_dfs(ns,nr)*delr - endif - ! ks = Qs*((rhosnw(ksnow)/rhoi)*3._dbl_kind / & - ! (4._dbl_kind*rsnw(ksnow)*1.0e-6_dbl_kind)) - tau(k) = (ks*rhosnw(ksnow) + kabs_chl_5bd(ns,k))*dzk(k) - !w0(k) = ks/(ks + kabs_chl_5bd(ns,k)) *ws - w0(k) = (ks*rhosnw(ksnow))/(ks*rhosnw(ksnow) + kabs_chl_5bd(ns,k)) * ws - g(k) = gs - - !write(warning, *) "sky, k, tau, w0, g =", nsky, k, tau(k), w0(k), g(k) - !write(warning, *) "ns, ks, kabs_chl_5bd(ns,k), ", ns, ks, kabs_chl_5bd(ns,k) - !call add_warning(warning) - enddo ! k - endif ! end if nsky for snow IOPs assignment - !------------------------------------------------------------------------------ - - !aerosol in snow - if (tr_zaero .and. dEdd_algae) then - do k = 0,nslyr - g(k) = (g(k)*w0(k)*tau(k) + gzaer_5bd(ns,k)) / & - (w0(k)*tau(k) + wzaer_5bd(ns,k)) - w0(k) = (w0(k)*tau(k) + wzaer_5bd(ns,k)) / & - (tau(k) + tzaer_5bd(ns,k)) - tau(k) = tau(k) + tzaer_5bd(ns,k) - enddo - elseif (tr_aero) then - k = 0 ! snow SSL - taer = c0 - waer = c0 - gaer = c0 - - do na=1,4*n_aero,4 -! mgf++ - if (modal_aero) then - if (na == 1) then - !interstitial BC - taer = taer + & - aero_mp(na)*kaer_bc_tab_5bd(ns,k_bcexs(k)) - waer = waer + & - aero_mp(na)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k)) - gaer = gaer + & - aero_mp(na)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k))*gaer_bc_tab_5bd(ns,k_bcexs(k)) - elseif (na == 5)then - !within-ice BC - taer = taer + & - aero_mp(na)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - bcenh_5bd(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - aero_mp(na)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k)) - gaer = gaer + & - aero_mp(na)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k))*gaer_bc_tab_5bd(ns,k_bcins(k)) - else - ! other species (dust) - taer = taer + & - aero_mp(na)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif - else - taer = taer + & - aero_mp(na)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif !modal_aero -!mgf-- - enddo ! na - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - - do k=1,nslyr - taer = c0 - waer = c0 - gaer = c0 - do na=1,4*n_aero,4 - if (modal_aero) then -!mgf++ - if (na==1) then - ! interstitial BC - taer = taer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab_5bd(ns,k_bcexs(k)) - waer = waer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k)) - gaer = gaer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k))*gaer_bc_tab_5bd(ns,k_bcexs(k)) - elseif (na==5) then - ! within-ice BC - taer = taer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab_5bd(ns,k_bcins(k))*& - bcenh_5bd(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k)) - gaer = gaer + & - (aero_mp(na+1)/rnslyr)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k))*gaer_bc_tab_5bd(ns,k_bcins(k)) - - else - ! other species (dust) - taer = taer + & - (aero_mp(na+1)/rnslyr)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+1)/rnslyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+1)/rnslyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif !(na==1) - - else - taer = taer + & - (aero_mp(na+1)*rnslyr)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+1)*rnslyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+1)*rnslyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif ! modal_aero -!mgf-- - enddo ! na - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - g(k) = (g(k)*w0(k)*tau(k) + gaer*waer*taer) / & - (w0(k)*tau(k) + waer*taer) - w0(k) = (w0(k)*tau(k) + waer*taer) / & - (tau(k) + taer) - tau(k) = tau(k) + taer - enddo ! k - endif ! tr_aero - - ! set optical properties of sea ice - - ! bare or snow-covered sea ice layers - !if( srftyp <= 1 ) then - ! ssl - k = kii - tau(k) = (ki_ssl_5bd(ns)+kabs_chl_5bd(ns,k))*dzk(k) - w0(k) = ki_ssl_5bd(ns)/(ki_ssl_5bd(ns) + kabs_chl_5bd(ns,k))*wi_ssl_5bd(ns) - g(k) = gi_ssl_5bd(ns) - ! dl - k = kii + 1 - ! scale dz for dl relative to 4 even-layer-thickness 1.5m case - fs = p25/rnilyr - tau(k) = (ki_dl_5bd(ns) + kabs_chl_5bd(ns,k)) *dzk(k)*fs - w0(k) = ki_dl_5bd(ns)/(ki_dl_5bd(ns) + kabs_chl_5bd(ns,k)) *wi_dl_5bd(ns) - g(k) = gi_dl_5bd(ns) - ! int above lowest layer - if (kii+2 <= klev-1) then - do k = kii+2, klev-1 - tau(k) = (ki_int_5bd(ns) + kabs_chl_5bd(ns,k))*dzk(k) - w0(k) = ki_int_5bd(ns)/(ki_int_5bd(ns) + kabs_chl_5bd(ns,k)) *wi_int_5bd(ns) - g(k) = gi_int_5bd(ns) - enddo - endif - ! lowest layer - k = klev - ! add algae to lowest sea ice layer, visible only: - kabs = ki_int_5bd(ns)*(c1-wi_int_5bd(ns)) - if( ns == 1 ) then - ! total layer absorption optical depth fixed at value - ! of kalg*0.50m, independent of actual layer thickness - kabs = kabs + kabs_chl_5bd(ns,k) - endif - sig = ki_int_5bd(ns)*wi_int_5bd(ns) - tau(k) = (kabs+sig)*dzk(k) - w0(k) = (sig/(sig+kabs)) - g(k) = gi_int_5bd(ns) - ! aerosol in sea ice - if (tr_zaero .and. dEdd_algae) then - do k = kii, klev - g(k) = (g(k)*w0(k)*tau(k) + gzaer_5bd(ns,k)) / & - (w0(k)*tau(k) + wzaer_5bd(ns,k)) - w0(k) = (w0(k)*tau(k) + wzaer_5bd(ns,k)) / & - (tau(k) + tzaer_5bd(ns,k)) - tau(k) = tau(k) + tzaer_5bd(ns,k) - enddo - elseif (tr_aero) then - k = kii ! sea ice SSL - taer = c0 - waer = c0 - gaer = c0 - do na=1,4*n_aero,4 - !mgf++ - if (modal_aero) then - if (na==1) then - ! interstitial BC - taer = taer + & - aero_mp(na+2)*kaer_bc_tab_5bd(ns,k_bcexs(k)) - waer = waer + & - aero_mp(na+2)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k)) - gaer = gaer + & - aero_mp(na+2)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k))*gaer_bc_tab_5bd(ns,k_bcexs(k)) - elseif (na==5) then - ! within-ice BC - taer = taer + & - aero_mp(na+2)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - bcenh_5bd(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - aero_mp(na+2)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k)) - gaer = gaer + & - aero_mp(na+2)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k))*gaer_bc_tab_5bd(ns,k_bcins(k)) - else - ! other species (dust) - taer = taer + & - aero_mp(na+2)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na+2)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na+2)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif - else !bulk - taer = taer + & - aero_mp(na+2)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - aero_mp(na+2)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - aero_mp(na+2)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif ! modal_aero - !mgf-- - enddo ! na - - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - g(k) = (g(k)*w0(k)*tau(k) + gaer*waer*taer) / & - (w0(k)*tau(k) + waer*taer) - w0(k) = (w0(k)*tau(k) + waer*taer) / & - (tau(k) + taer) - tau(k) = tau(k) + taer - do k = kii+1, klev - taer = c0 - waer = c0 - gaer = c0 - do na=1,4*n_aero,4 - !mgf++ - if (modal_aero) then - if (na==1) then - ! interstitial BC - taer = taer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab_5bd(ns,k_bcexs(k)) - waer = waer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k)) - gaer = gaer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab_5bd(ns,k_bcexs(k))* & - waer_bc_tab_5bd(ns,k_bcexs(k))*gaer_bc_tab_5bd(ns,k_bcexs(k)) - elseif (na==5) then - ! within-ice BC - taer = taer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - bcenh_5bd(ns,k_bcins(k),k_bcini(k)) - waer = waer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k)) - gaer = gaer + & - (aero_mp(na+3)/rnilyr)*kaer_bc_tab_5bd(ns,k_bcins(k))* & - waer_bc_tab_5bd(ns,k_bcins(k))*gaer_bc_tab_5bd(ns,k_bcins(k)) - - else - ! other species (dust) - taer = taer + & - (aero_mp(na+3)/rnilyr)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+3)/rnilyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+3)/rnilyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif - else !bulk - - taer = taer + & - (aero_mp(na+3)*rnilyr)*kaer_tab_5bd(ns,(1+(na-1)/4)) - waer = waer + & - (aero_mp(na+3)*rnilyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4)) - gaer = gaer + & - (aero_mp(na+3)*rnilyr)*kaer_tab_5bd(ns,(1+(na-1)/4))* & - waer_tab_5bd(ns,(1+(na-1)/4))*gaer_tab_5bd(ns,(1+(na-1)/4)) - endif ! modal_aero - !mgf-- - enddo ! na - gaer = gaer/(waer+puny) - waer = waer/(taer+puny) - g(k) = (g(k)*w0(k)*tau(k) + gaer*waer*taer) / & - (w0(k)*tau(k) + waer*taer) - w0(k) = (w0(k)*tau(k) + waer*taer) / & - (tau(k) + taer) - tau(k) = tau(k) + taer - enddo ! k - endif ! tr_aero -! --------------------------------------------------------------------------- - - ! set reflectivities for ocean underlying sea ice - ! if ns == 1 (visible), albedo is 0.1, else, albedo is zero - rns = real(ns-1, kind=dbl_kind) - albodr = cp01 * (c1 - min(rns, c1)) - albodf = cp01 * (c1 - min(rns, c1)) - - ! layer input properties now completely specified: tau, w0, g, - ! albodr, albodf; now compute the Delta-Eddington solution - ! reflectivities and transmissivities for each layer; then, - ! combine the layers going downwards accounting for multiple - ! scattering between layers, and finally start from the - ! underlying ocean and combine successive layers upwards to - ! the surface; see comments in solution_dEdd for more details. - call solution_dEdd & - (coszen, srftyp, klev, klevp, nslyr, & - tau, w0, g, albodr, albodf, & - trndir, trntdr, trndif, rupdir, rupdif, & - rdndif) - ! the interface reflectivities and transmissivities required - ! to evaluate interface fluxes are returned from solution_dEdd; - ! now compute up and down fluxes for each interface, using the - ! combined layer properties at each interface: - ! - ! layers interface - ! - ! --------------------- k - ! k - ! --------------------- - - do k = 0, klevp - ! interface scattering - refk = c1/(c1 - rdndif(k)*rupdif(k)) - ! dir tran ref from below times interface scattering, plus diff - ! tran and ref from below times interface scattering - ! fdirup(k) = (trndir(k)*rupdir(k) + & - ! (trntdr(k)-trndir(k)) & - ! *rupdif(k))*refk - ! dir tran plus total diff trans times interface scattering plus - ! dir tran with up dir ref and down dif ref times interface scattering - ! fdirdn(k) = trndir(k) + (trntdr(k) & - ! - trndir(k) + trndir(k) & - ! *rupdir(k)*rdndif(k))*refk - ! diffuse tran ref from below times interface scattering - ! fdifup(k) = trndif(k)*rupdif(k)*refk - ! diffuse tran times interface scattering - ! fdifdn(k) = trndif(k)*refk - - ! dfdir = fdirdn - fdirup - dfdir(k) = trndir(k) & - + (trntdr(k)-trndir(k)) * (c1 - rupdif(k)) * refk & - - trndir(k)*rupdir(k) * (c1 - rdndif(k)) * refk - if (dfdir(k) < puny) dfdir(k) = c0 !echmod necessary? - ! dfdif = fdifdn - fdifup - dfdif(k) = trndif(k) * (c1 - rupdif(k)) * refk - if (dfdif(k) < puny) dfdif(k) = c0 !echmod necessary? - enddo ! k - - ! note that because the snow IOPs for diffuse and direct incidents - ! are different, the snow albedo needs to be calculated twice for - ! direct incident and diffuse incident respectively - if (nsky == 1) then ! direc beam (keep the direct beam results) - do k = 0, klevp - dfdir_snicar(k) = dfdir(k) - rupdir_snicar(k) = rupdir(k) - enddo - elseif (nsky == 2) then ! diffuse (keep the diffuse incident results) - do k = 0, klevp - dfdif_snicar(k) = dfdif(k) - rupdif_snicar(k) = rupdif(k) - enddo - endif - enddo ! end direct/diffuse incident nsky - - ! calculate final surface albedos and fluxes- - ! all absorbed flux above ksrf is included in surface absorption - if( ns == 1) then ! visible - swdr = swvdr - swdf = swvdf - avdr = rupdir_snicar(0) - avdf = rupdif_snicar(0) - tmp_0 = dfdir_snicar(0 )*swdr + dfdif_snicar(0 )*swdf - tmp_ks = dfdir_snicar(ksrf )*swdr + dfdif_snicar(ksrf )*swdf - tmp_kl = dfdir_snicar(klevp)*swdr + dfdif_snicar(klevp)*swdf - - ! for layer biology: save visible only - do k = nslyr+2, klevp ! Start at DL layer of ice after SSL scattering - fthrul(k-nslyr-1) = dfdir_snicar(k)*swdr + dfdif_snicar(k)*swdf - enddo - - fsfc = fsfc + tmp_0 - tmp_ks - fint = fint + tmp_ks - tmp_kl - fthru = fthru + tmp_kl - - ! if snow covered ice, set snow internal absorption; else, Sabs=0 - if( srftyp == 1 ) then - ki = 0 - do k=1,nslyr - ! skip snow SSL, since SSL absorption included in the surface - ! absorption fsfc above - km = k - kp = km + 1 - ki = ki + 1 - Sabs(ki) = Sabs(ki) & - + dfdir_snicar(km)*swdr + dfdif_snicar(km)*swdf & - - (dfdir_snicar(kp)*swdr + dfdif_snicar(kp)*swdf) - enddo ! k - endif - - ! complex indexing to insure proper absorptions for sea ice - ki = 0 - do k=nslyr+2,nslyr+1+nilyr - ! for bare ice, DL absorption for sea ice layer 1 - km = k - kp = km + 1 - ! modify for top sea ice layer for snow over sea ice - if( srftyp == 1 ) then - ! must add SSL and DL absorption for sea ice layer 1 - if( k == nslyr+2 ) then - km = k - 1 - kp = km + 2 - endif - endif - ki = ki + 1 - Iabs(ki) = Iabs(ki) & - + dfdir_snicar(km)*swdr + dfdif_snicar(km)*swdf & - - (dfdir_snicar(kp)*swdr + dfdif_snicar(kp)*swdf) - enddo ! k - - else !if(ns > 1) then ! near IR - - swdr = swidr - swdf = swidf - - ! let fr2(3,4,5) = alb_2(3,4,5)*swd*wght2(3,4,5) - ! the ns=2(3,4,5) reflected fluxes respectively, - ! where alb_2(3,4,5) are the band - ! albedos, swd = nir incident shortwave flux, and wght2(3,4,5) are - ! the 2(3,4,5) band weights. thus, the total reflected flux is: - ! fr = fr2 + fr3 + fr4 + fr5 - ! = alb_2*swd*wght2 + alb_3*swd*wght3 + alb_4*swd*wght4 + alb_5*swd*wght5 - ! hence, the 2,3,4,5 nir band albedo is - ! alb = fr/swd = alb_2*wght2 + alb_3*wght3 + alb_4*wght4 + alb_5*wght5 - - aidr = aidr + rupdir_snicar(0)*wghtns_5bd_drc(ns) - aidf = aidf + rupdif_snicar(0)*wghtns_5bd_dfs(ns) - - tmp_0 = dfdir_snicar(0 )*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(0 )*swdf*wghtns_5bd_dfs(ns) - tmp_ks = dfdir_snicar(ksrf )*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(ksrf )*swdf*wghtns_5bd_dfs(ns) - tmp_kl = dfdir_snicar(klevp)*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(klevp)*swdf*wghtns_5bd_dfs(ns) - - fsfc = fsfc + tmp_0 - tmp_ks - fint = fint + tmp_ks - tmp_kl - fthru = fthru + tmp_kl - - ! if snow covered ice, set snow internal absorption; else, Sabs=0 - if( srftyp == 1 ) then - ki = 0 - do k=1,nslyr - ! skip snow SSL, since SSL absorption included in the surface - ! absorption fsfc above - km = k - kp = km + 1 - ki = ki + 1 - Sabs(ki) = Sabs(ki) & - + dfdir_snicar(km)*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(km)*swdf*wghtns_5bd_dfs(ns) & - -(dfdir_snicar(kp)*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(kp)*swdf*wghtns_5bd_dfs(ns)) - - enddo ! k - endif - - ! complex indexing to insure proper absorptions for sea ice - ki = 0 - do k=nslyr+2,nslyr+1+nilyr - ! for bare ice, DL absorption for sea ice layer 1 - km = k - kp = km + 1 - ! modify for top sea ice layer for snow over sea ice - if( srftyp == 1 ) then - ! must add SSL and DL absorption for sea ice layer 1 - if( k == nslyr+2 ) then - km = k - 1 - kp = km + 2 - endif - endif - ki = ki + 1 - Iabs(ki) = Iabs(ki) & - + dfdir_snicar(km)*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(km)*swdf*wghtns_5bd_dfs(ns) & - -(dfdir_snicar(kp)*swdr*wghtns_5bd_drc(ns) & - + dfdif_snicar(kp)*swdf*wghtns_5bd_dfs(ns)) - enddo ! k - endif ! ns = 1, ns > 1 - enddo ! end spectral loop ns - - - ! accumulate fluxes over bare sea ice - - ! solar zenith angle parameterization - ! calculate the scaling factor for NIR direct albedo if SZA>75 degree - sza_factor = c1 - if( srftyp == 1 ) then - mu0 = max(coszen,p01) - if (mu0 < mu_75) then - sza_c1 = sza_a0 + sza_a1 * mu0 + sza_a2 * mu0**2 - sza_c0 = sza_b0 + sza_b1 * mu0 + sza_b2 * mu0**2 - sza_factor = sza_c1 * (log10(rsnw(1)) - 6.0) + sza_c0 - endif - endif - - alvdr = avdr - alvdf = avdf - alidr = aidr * sza_factor !sza factor is always larger than or equal to 1 - alidf = aidf - - ! note that we assume the reduced NIR energy absorption by snow - ! due to corrected snow albedo is absorbed by the snow single - ! scattering layer only - this is generally true if snow SSL >= 2 cm - ! by the default model set up: - ! if snow_depth >= 8 cm, SSL = 4 cm, satisfy - ! esle if snow_depth >= 4 cm, SSL = snow_depth/2 >= 2 cm, satisfy - ! esle snow_depth < 4 cm, SSL = snow_depth/2, may overcool SSL layer - fswsfc = fswsfc + (fsfc- (sza_factor-c1)*aidr*swidr)*fi - fswint = fswint + fint *fi - fswthru = fswthru + fthru*fi - - - do k = 1, nslyr - Sswabs(k) = Sswabs(k) + Sabs(k)*fi - enddo ! k - - do k = 1, nilyr - Iswabs(k) = Iswabs(k) + Iabs(k)*fi - - ! bgc layer - fswpenl(k) = fswpenl(k) + fthrul(k)* fi - - if (k == nilyr) then - fswpenl(k+1) = fswpenl(k+1) + fthrul(k+1)*fi - endif - enddo ! k - - !---------------------------------------------------------------- - ! if ice has zero heat capacity, no SW can be absorbed - ! in the ice/snow interior, so add to surface absorption. - ! Note: nilyr = nslyr = 1 for this case - !---------------------------------------------------------------- - - if (.not. heat_capacity) then - - ! SW absorbed at snow/ice surface - fswsfc = fswsfc + Iswabs(1) + Sswabs(1) - - ! SW absorbed in ice interior - fswint = c0 - Iswabs(1) = c0 - Sswabs(1) = c0 - - endif ! heat_capacity - - end subroutine compute_dEdd_5bd - -!======================================================================= - - end module ice_shortwave - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_snow.F90 b/components/mpas-seaice/src/column/ice_snow.F90 deleted file mode 100644 index d88040f1be96..000000000000 --- a/components/mpas-seaice/src/column/ice_snow.F90 +++ /dev/null @@ -1,951 +0,0 @@ -! SVN:$Id: ice_snow.F90 972 2015-04-15 19:44:20Z njeffery $ -!======================================================================= -! -! authors Elizabeth Hunke, LANL -! Nicole Jeffery, LANL - - module ice_snow - - use ice_kinds_mod - use ice_constants_colpkg, only: puny, c0, c1, c10, rhos, Lfresh, & - rhow, rhoi, rhofresh, rhosmin - use ice_warnings, only: add_warning - - implicit none - save - - private - public :: snow_effective_density, update_snow_radius, snow_redist,& - drain_snow - - real (kind=dbl_kind), parameter, public :: & - S_r = 0.033_dbl_kind, & ! irreducible saturation (Anderson 1976) - S_wet= 0.422_dbl_kind ! (um^3/s) wet metamorphism parameters - -!======================================================================= - - contains - -!======================================================================= - -! Compute effective density of snow layers from ice, liquid water mass - - subroutine snow_effective_density(nslyr, ncat, & - vsnon, vsno, & - rhosnew, & - rhos_cmpn, rhos_cmp) - - integer (kind=int_kind), intent(in) :: & - nslyr, & ! number of snow layers - ncat ! number of thickness categories - - real (kind=dbl_kind), dimension(:), intent(in) :: & - vsnon ! snow volume (m) - - real (kind=dbl_kind), intent(in) :: & - vsno , & ! total snow volume (m) - rhosnew ! new snow density (kg/m^3) - - real (kind=dbl_kind), dimension(:,:), & - intent(inout) :: & - rhos_cmpn ! effective snow density: compaction (kg/m^3) - - real (kind=dbl_kind), intent(inout) :: & - rhos_cmp ! mean effective snow density: compaction (kg/m^3) - - integer (kind=int_kind) :: & - k , & ! snow layer index - n , & ! ice thickness category index - cnt ! counter for snow presence - - rhos_cmp = c0 - - !----------------------------------------------------------------- - ! Initialize effective snow density (compaction) for new snow - !----------------------------------------------------------------- - - do n = 1, ncat - do k = 1, nslyr - if (rhos_cmpn(k,n) < rhosmin) rhos_cmpn(k,n) = rhosnew - enddo - enddo - - !----------------------------------------------------------------- - ! Compute average effective density of snow - !----------------------------------------------------------------- - - if (vsno > puny) then - - do n = 1, ncat - if (vsnon(n) > c0) then - do k = 1, nslyr - rhos_cmp = rhos_cmp + vsnon(n)*rhos_cmpn(k,n) - enddo - endif - enddo - rhos_cmp = rhos_cmp/(vsno*real(nslyr,kind=dbl_kind)) - - endif ! vsno - - end subroutine snow_effective_density - -!======================================================================= - -! Snow redistribution by wind, based on O. Lecomte Ph.D. (2014). -! Namelist option snwredist = 'ITDsd': -! Snow in suspension depends on wind speed, density and the standard -! deviation of the ice thickness distribution. Snow is redistributed -! among ice categories proportionally to the category areas. -! Namelist option snwredist = 'ITDrdg': -! As above, but use the standard deviation of the level and ridged -! ice thickness distribution for snow in suspension, and redistribute -! based on ridged ice area. - -! convention: -! volume, mass and energy include factor of ain -! thickness does not - - subroutine snow_redist(dt, nslyr, ncat, wind, ain, vin, vsn, zqsn, & - snwredist, alvl, vlvl, fresh, fhocn, fsloss, rhos_cmpn, & - fsnow, rhosmax, windmin, drhosdwind, snwlvlfac, l_stop, stop_label) - - use ice_therm_vertical, only: adjust_enthalpy - - integer (kind=int_kind), intent(in) :: & - nslyr , & ! number of snow layers - ncat ! number of thickness categories - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - wind , & ! wind speed (m/s) - fsnow , & ! snowfall rate (kg m-2 s-1) - rhosmax , & ! maximum snow density (kg/m^3) - windmin , & ! minimum wind speed to compact snow (m/s) - drhosdwind, & ! wind compaction factor (kg s/m^4) - snwlvlfac ! snow loss factor for wind redistribution - - real (kind=dbl_kind), dimension(:), intent(in) :: & - ain , & ! ice area fraction - vin , & ! ice volume (m) - alvl , & ! level ice area tracer - vlvl ! level ice volume tracer - - real (kind=dbl_kind), intent(inout) :: & - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fsloss ! snow loss to leads (kg/m^2/s) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - vsn ! snow volume (m) - - real (kind=dbl_kind), dimension(:,:), intent(inout) :: & - zqsn , & ! snow enthalpy (J/m^3) - rhos_cmpn ! effective snow density: compaction (kg/m^3) - - character(len=char_len), intent(in) :: & - snwredist ! type of snow redistribution - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - n , & ! category index - k ! layer index - - integer (kind=int_kind), dimension(ncat) :: & - klyr ! layer index - - real (kind=dbl_kind), parameter :: & - refsd = c1 , & ! standard deviation reference - gamma = 1.e-5_dbl_kind ! tuning coefficient - - real (kind=dbl_kind) :: & - Vseas , & ! critical seasonal wind speed (m/s) - ITDsd , & ! standard deviation of ITD - flost , & ! fraction of snow lost in leads - alost , & ! effective lead area for snow lost in leads - suma , & ! sum of ice area over categories - sumv , & ! sum of ice volume over categories (m) - summ , & ! sum of snow mass over categories (kg/m^2) - sumq , & ! sum of snow enthalpy over categories (kg/m^2) - msusp , & ! potential mass of snow in suspension (kg/m^2) - msnw_susp , & ! mass of snow in suspension (kg/m^2) - esnw_susp , & ! energy of snow in suspension (J/m^2) - asnw_lvl , & ! mass of snow redeposited on level ice (kg/m^2) - e_redeptmp, & ! redeposited energy (J/m^2) - dhsn , & ! change in snow depth (m) - dmp , & ! mass difference in previous layer (kg/m^2) - hslyr , & ! snow layer thickness (m) - hslab , & ! new snow thickness (m) - drhos , & ! change in snow density due to compaction (kg/m^3) - mlost , & ! mass of suspended snow lost in leads (kg/m^2) - elost , & ! energy of suspended snow lost in leads (J/m^2) - de , & ! change in energy (J/m^2) - al, ar , & ! areas of level and ridged ice - hlvl, hrdg, & ! thicknesses of level and ridged ice - tmp1, tmp2, & ! temporary values - tmp3, tmp4, & ! temporary values - tmp5 , & ! temporary values - work ! temporary value - - real (kind=dbl_kind), dimension(ncat) :: & - sfac , & ! temporary for snwlvlfac - ardg , & ! ridged ice area tracer - m_erosion , & ! eroded mass (kg/m^2) - e_erosion , & ! eroded energy (J/m^2) - m_redep , & ! redeposited mass (kg/m^2) - e_redep , & ! redeposited energy (J/m^2) - vsn_init , & ! initial volume (m) - esn_init , & ! initial energy (J/m^2) - esn_final , & ! final energy (J/m^2) - atmp , & ! temporary variable for ain, for debugging convenience - hin , & ! ice thickness (m) - hsn , & ! snow depth (m) - hsn_new ! new snow depth (m) - - real (kind=dbl_kind), dimension (nslyr) :: & - dzs ! snow layer thickness after redistribution (m) - - real (kind=dbl_kind), dimension (nslyr+1) :: & - zs1 , & ! depth of snow layer boundaries (m) - zs2 ! adjusted depths, with equal hslyr (m) - - character(len=char_len_long) :: & - warning - - !----------------------------------------------------------------- - ! Conservation checks - !----------------------------------------------------------------- - - l_stop = .false. - stop_label = '' - tmp1 = c0 - tmp3 = c0 - do n = 1, ncat - ! mass conservation check - tmp1 = tmp1 + vsn(n) - vsn_init(n) = vsn(n) - esn_init(n) = c0 - ! energy conservation check - do k = 1, nslyr - tmp3 = tmp3 + vsn(n)*zqsn(k,n)/nslyr - esn_init(n) = esn_init(n) + vsn(n)*zqsn(k,n)/nslyr - enddo - enddo - - !----------------------------------------------------------------- - ! category thickness and sums - !----------------------------------------------------------------- - - hin(:) = c0 - hsn(:) = c0 - suma = c0 - sumv = c0 - do n = 1, ncat - atmp(n) = ain(n) - if (atmp(n) > puny) then - hin(n) = vin(n)/atmp(n) - hsn(n) = vsn(n)/atmp(n) - endif - hsn_new(n) = hsn(n) - suma = suma + atmp(n) - sumv = sumv + vin(n) - ! maintain positive definite enthalpy - do k = 1, nslyr - zqsn(k,n) = min(zqsn(k,n) + Lfresh*rhos, c0) - enddo - enddo ! ncat - - !----------------------------------------------------------------- - ! standard deviation of ice thickness distribution - !----------------------------------------------------------------- - - work = c0 - asnw_lvl = c0 - if (trim(snwredist) == 'ITDrdg') then ! use level and ridged ice - do n = 1, ncat - ardg(n) = c1 - alvl(n) ! ridged ice tracer - al = alvl(n) * atmp(n) ! level - ar = ardg(n) * atmp(n) ! ridged - hlvl = c0 - hrdg = c0 - if (al > puny) hlvl = vin(n)*vlvl(n)/al - if (ar > puny) hrdg = vin(n)*(c1-vlvl(n))/ar - work = work + al*(hlvl - sumv)**2 + ar*(hrdg - sumv)**2 - - ! for redeposition of snow on level ice - sfac(n) = snwlvlfac - if (ardg(n) > c0) sfac(n) = min(snwlvlfac, alvl(n)/ardg(n)) - asnw_lvl = asnw_lvl + al - sfac(n)*ar - enddo - asnw_lvl = asnw_lvl/suma - else ! snwredist = 'ITDsd' ! use standard ITD - do n = 1, ncat - work = work + atmp(n)*(hin(n) - sumv)**2 - enddo - endif - ITDsd = sqrt(work) - - !----------------------------------------------------------------- - ! fraction of suspended snow lost in leads - !----------------------------------------------------------------- - - flost = (c1 - suma) * exp(-ITDsd/refsd) -!echmod flost = c0 - alost = c1 - suma * (c1-flost) - - !----------------------------------------------------------------- - ! suspended snow - !----------------------------------------------------------------- - - msusp = c0 - do n = 1, ncat - ! critical seasonal wind speed needed to compact snow to density rhos - Vseas = (rhos_cmpn(1,n) - 44.6_dbl_kind)/174.0_dbl_kind ! use top layer - Vseas = max(Vseas, c0) - ! maximum mass per unit area of snow in suspension (kg/m^2) - if (ITDsd > puny) & - msusp = msusp + atmp(n)*gamma*dt*max(wind-Vseas,c0) & - * (rhosmax-rhos_cmpn(1,n))/(rhosmax*ITDsd) - enddo - - !----------------------------------------------------------------- - ! erosion - !----------------------------------------------------------------- - - msnw_susp = c0 - esnw_susp = c0 - klyr(:) = 1 - do n = 1, ncat - m_erosion(n) = c0 ! mass - e_erosion(n) = c0 ! energy - if (atmp(n) > puny) then - m_erosion(n) = min(msusp, rhos*vsn(n)) - if (m_erosion(n) > puny) then - summ = c0 - dmp = m_erosion(n) - do k = 1, nslyr - if (dmp > c0) then - dhsn = min(hsn(n)/nslyr, dmp/(rhos*atmp(n))) - msnw_susp = msnw_susp + dhsn*rhos*atmp(n) ! total mass in suspension - hsn_new(n) = hsn_new(n) - dhsn - e_erosion(n) = e_erosion(n) + dhsn*zqsn(k,n)*atmp(n) - klyr(n) = k ! number of affected layers - summ = summ + rhos*vsn(n)/nslyr ! mass, partial sum - dmp = max(m_erosion(n) - summ, c0) - endif ! dmp - enddo - esnw_susp = esnw_susp + e_erosion(n) ! total energy in suspension - endif - endif - enddo - - !----------------------------------------------------------------- - ! redeposition - !----------------------------------------------------------------- - - do n = 1, ncat - if (trim(snwredist) == 'ITDrdg') then ! use level and ridged ice - work = atmp(n)*(c1-flost)*(ardg(n)*(c1+sfac(n)) + asnw_lvl) - else ! use standard ITD - work = atmp(n)*(c1-flost) - endif - m_redep(n) = msnw_susp*work ! mass - e_redep(n) = c0 - e_redeptmp = esnw_susp*work ! energy - - ! change in snow depth - dhsn = c0 - if (atmp(n) > puny) then - dhsn = m_redep(n) / (rhos*atmp(n)) - - if (abs(dhsn) > c0) then - - e_redep(n) = e_redeptmp - vsn(n) = (hsn_new(n)+dhsn)*atmp(n) - - ! change in snow energy - de = e_redeptmp / klyr(n) - ! spread among affected layers - sumq = c0 - do k = 1, klyr(n) - zqsn(k,n) = (atmp(n)*hsn_new(n)*zqsn(k,n) + de) & - / (vsn(n)) ! factor of nslyr cancels out - - if (zqsn(k,n) > c0) then - sumq = sumq + zqsn(k,n) - zqsn(k,n) = c0 - endif - - enddo ! klyr - zqsn(klyr(n),n) = min(zqsn(klyr(n),n) + sumq, c0) ! may lose energy here - - !----------------------------------------------------------------- - ! Conserving energy, compute the enthalpy of the new equal layers - !----------------------------------------------------------------- - - if (nslyr > 1) then - - dzs(:) = hsn(n) / real(nslyr,kind=dbl_kind) ! old layer thickness - do k = 1, klyr(n) - dzs(k) = dzs(k) + dhsn / klyr(n) ! old layer thickness (updated) - enddo - hsn_new(n) = hsn_new(n) + dhsn - hslyr = hsn_new(n) / real(nslyr,kind=dbl_kind) ! new layer thickness - - zs1(1) = c0 - zs1(1+nslyr) = hsn_new(n) - - zs2(1) = c0 - zs2(1+nslyr) = hsn_new(n) - - do k = 1, nslyr-1 - zs1(k+1) = zs1(k) + dzs(k) ! old layer depths (unequal thickness) - zs2(k+1) = zs2(k) + hslyr ! new layer depths (equal thickness) - enddo - - call adjust_enthalpy (nslyr, & - zs1(:), zs2(:), & - hslyr, hsn_new(n), & - zqsn(:,n)) - else - hsn_new(1) = hsn_new(1) + dhsn - endif ! nslyr > 1 - endif ! |dhsn| > puny - endif ! ain > puny - - ! maintain positive definite enthalpy - do k = 1, nslyr - zqsn(k,n) = zqsn(k,n) - Lfresh*rhos - enddo - enddo ! ncat - - !----------------------------------------------------------------- - ! mass of suspended snow lost in leads - !----------------------------------------------------------------- - mlost = msnw_susp*alost - fsloss = fsloss + mlost / dt - - !----------------------------------------------------------------- - ! mass conservation check - !----------------------------------------------------------------- - - tmp2 = c0 - do n = 1, ncat - tmp2 = tmp2 + vsn(n) - enddo - - if (tmp2 > tmp1) then ! correct roundoff error - vsn(:) = vsn(:) * tmp1/tmp2 - tmp2 = c0 - do n = 1, ncat - tmp2 = tmp2 + vsn(n) - enddo - endif - - if (tmp2 < tmp1) fresh = fresh + rhos*(tmp1-tmp2)/dt - - tmp2 = tmp2 + (mlost/rhos) - - if (abs(tmp1-tmp2) > puny) then - write(warning,*)'mass conservation error in snow_redist', tmp1, tmp2 - call add_warning(warning) - write(warning,*)'klyr',klyr - call add_warning(warning) - write(warning,*)'ain',atmp(:) - call add_warning(warning) - write(warning,*)'vsn final',vsn(:) - call add_warning(warning) - write(warning,*)'vsn init',vsn_init(:) - call add_warning(warning) - write(warning,*)'rhos*vsn init',rhos*vsn_init(:) - call add_warning(warning) - write(warning,*)'m_erosion',m_erosion(:) - call add_warning(warning) - write(warning,*)'m_redep',m_redep(:) - call add_warning(warning) - write(warning,*)'mlost',mlost - call add_warning(warning) - write(warning,*)'v_erosion',m_erosion(:)/rhos - call add_warning(warning) - write(warning,*)'v_redep',m_redep(:)/rhos - call add_warning(warning) - write(warning,*)'v lost',mlost/rhos - call add_warning(warning) - write(warning,*)'hsn',hsn(:) - call add_warning(warning) - write(warning,*)'hsn_new',hsn_new(:) - call add_warning(warning) - write(warning,*)'vsn_new',hsn_new(:)*atmp(:) - call add_warning(warning) - write(warning,*)'lost',suma,flost,alost,msnw_susp - call add_warning(warning) - stop_label = 'snow redistribution mass conservation error' - l_stop = .true. - endif - - !----------------------------------------------------------------- - ! energy conservation check - !----------------------------------------------------------------- - - tmp4 = c0 - tmp5 = c0 - esn_final(:) = c0 - do n = 1, ncat - do k = 1, nslyr - tmp4 = tmp4 + vsn(n)*zqsn(k,n)/nslyr - esn_final(n) = esn_final(n) + vsn(n)*zqsn(k,n)/nslyr - enddo - tmp5 = tmp5 - e_erosion(n) + e_redep(n) - enddo - tmp5 = tmp5 + esnw_susp*alost - - !----------------------------------------------------------------- - ! energy of suspended snow lost in leads - !----------------------------------------------------------------- - elost = tmp3 - tmp4 - fhocn = fhocn + elost / dt - - if (abs(tmp5) > nslyr*Lfresh*puny) then - write(warning,*)'energy conservation error in snow_redist', tmp3, tmp4, tmp5 - call add_warning(warning) - write(warning,*)'klyr',klyr - call add_warning(warning) - write(warning,*)'ain',atmp(:) - call add_warning(warning) - write(warning,*)'vsn final',vsn(:) - call add_warning(warning) - write(warning,*)'vsn init',vsn_init(:) - call add_warning(warning) - write(warning,*)'rhos*vsn init',rhos*vsn_init(:) - call add_warning(warning) - write(warning,*)'m_erosion',m_erosion(:) - call add_warning(warning) - write(warning,*)'m_redep',m_redep(:) - call add_warning(warning) - write(warning,*)'mlost',mlost - call add_warning(warning) - write(warning,*)'v_erosion',m_erosion(:)/rhos - call add_warning(warning) - write(warning,*)'v_redep',m_redep(:)/rhos - call add_warning(warning) - write(warning,*)'v lost',mlost/rhos - call add_warning(warning) - write(warning,*)'hsn',hsn(:) - call add_warning(warning) - write(warning,*)'hsn_new',hsn_new(:) - call add_warning(warning) - write(warning,*)'vsn_new',hsn_new(:)*atmp(:) - call add_warning(warning) - write(warning,*)'lost',suma,flost,alost,msnw_susp - call add_warning(warning) - write(warning,*)'tmp3(1)', (vsn(1)*zqsn(k,1)/nslyr,k=1,nslyr) - call add_warning(warning) - write(warning,*)'esn init',esn_init(:) - call add_warning(warning) - write(warning,*)'esn final',esn_final(:) - call add_warning(warning) - write(warning,*)'e_erosion',e_erosion(:) - call add_warning(warning) - write(warning,*)'e_redep',e_redep(:) - call add_warning(warning) - write(warning,*)'elost',elost,esnw_susp*alost,Lfresh*mlost - call add_warning(warning) - write(warning,*)'esnw_susp',esnw_susp - call add_warning(warning) - stop_label = 'snow redistribution energy conservation error' - l_stop = .true. - endif - - !----------------------------------------------------------------- - ! wind compaction - !----------------------------------------------------------------- - - do n = 1, ncat - if (vsn(n) > puny) then - ! compact freshly fallen or redistributed snow - drhos = drhosdwind * max(wind - windmin, c0) - hslab = c0 - if (fsnow > c0) & - hslab = max(min(fsnow*dt/(rhos+drhos), hsn_new(n)-hsn(n)), c0) - hslyr = hsn_new(n) / real(nslyr,kind=dbl_kind) - do k = 1, nslyr - work = hslab - hslyr * real(k-1,kind=dbl_kind) - work = max(c0, min(hslyr, work)) - rhos_cmpn(k,n) = rhos_cmpn(k,n) + drhos*work/hslyr - rhos_cmpn(k,n) = min(rhos_cmpn(k,n), rhosmax) - enddo - endif - enddo - - end subroutine snow_redist - -!======================================================================= - -! Snow grain metamorphism driver - - subroutine update_snow_radius (dt, ncat, nslyr, nilyr, rsnw, hin, & - Tsfc, zTin, & - hsn, zqsn, smice, smliq, & - rsnw_fall, rsnw_tmax, & - snowage_tau, & - snowage_kappa, & - snowage_drdt0, & - idx_T_max, & - idx_Tgrd_max, & - idx_rhos_max) - - integer (kind=int_kind), intent(in) :: & - ncat, & ! number of categories - nslyr, & ! number of snow layers - nilyr, & ! number of ice layers - idx_T_max, & ! dimensions of snow parameter matrix - idx_Tgrd_max, & - idx_rhos_max - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), dimension(ncat), intent(in) :: & - zTin , & ! surface ice temperature (oC) - Tsfc , & ! surface temperature (oC) - hin , & ! ice thickness (m) - hsn ! snow thickness (m) - - real (kind=dbl_kind), dimension(nslyr,ncat), intent(in) :: & - zqsn ! enthalpy of snow (J m-3) - - real (kind=dbl_kind), dimension(nslyr,ncat), intent(inout) :: & - rsnw - - real (kind=dbl_kind), dimension(nslyr,ncat), & - intent(inout) :: & - smice, & ! mass of ice in snow (kg/m^2) - smliq ! mass of liquid in snow (kg/m^2) - - real (kind=dbl_kind), intent(in) :: & - rsnw_fall, & ! radius of newly fallen snow (10^-6 m) - rsnw_tmax ! maximum grain radius from dry metamorphism (10^-6 m) - - ! dry snow aging parameters - real (kind=dbl_kind), dimension(idx_rhos_max,idx_Tgrd_max,idx_T_max), intent(in) :: & - snowage_tau, & ! (10^-6 m) - snowage_kappa, & ! - snowage_drdt0 ! (10^-6 m/hr) - - ! local temporary variables - - integer (kind=int_kind) :: k, n - - real (kind=dbl_kind), dimension(nslyr) :: & - drsnw_wet, & ! wet metamorphism (10^-6 m) - drsnw_dry ! dry (temperature gradient) metamorphism (10^-6 m) - - !----------------------------------------------------------------- - ! dry metamorphism - !----------------------------------------------------------------- - do n = 1, ncat - - if (hsn(n) > puny .and. hin(n) > puny) then - - drsnw_dry(:) = c0 - drsnw_wet(:) = c0 - - call snow_dry_metamorph (nslyr, nilyr, dt, rsnw(:,n), drsnw_dry, zqsn(:,n), Tsfc(n), & - zTin(n), hsn(n), hin(n), smice(:,n),smliq(:,n), rsnw_fall, & - snowage_tau, snowage_kappa, snowage_drdt0, & - idx_T_max, idx_Tgrd_max, idx_rhos_max) - - !----------------------------------------------------------------- - ! wet metamorphism - !----------------------------------------------------------------- - - - do k = 1,nslyr - call snow_wet_metamorph (dt, drsnw_wet(k), rsnw(k,n), smice(k,n),smliq(k,n)) - rsnw(k,n) = min(rsnw_tmax, rsnw(k,n) + drsnw_dry(k) + drsnw_wet(k)) - enddo - else - do k = 1,nslyr - rsnw(k,n) = max(rsnw_fall,min(rsnw_tmax, rsnw(k,n))) - smice(k,n) = rhos - smliq(k,n) = c0 - enddo - - endif - enddo - - end subroutine update_snow_radius - -!======================================================================= - -! Snow grain metamorphism - - subroutine snow_dry_metamorph (nslyr,nilyr, dt, rsnw, drsnw_dry, zqsn, & - Tsfc, zTin1, hsn, hin, smice, smliq, rsnw_fall, & - snowage_tau, snowage_kappa, snowage_drdt0, & - idx_T_max, idx_Tgrd_max, idx_rhos_max) - - use ice_constants_colpkg, only: c0, rhos, Tffresh, Lfresh, cp_ice, p5, puny, c10 - use ice_colpkg_shared, only: idx_T_min, idx_Tgrd_min, idx_rhos_min - - ! Vapor redistribution: Method is to retrieve 3 best-bit parameters that - ! depend on snow temperature, temperature gradient, and density, - ! that are derived from the microphysical model described in: - ! Flanner and Zender (2006), Linking snowpack microphysics and albedo - ! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. - ! The parametric equation has the form: - ! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), where: - ! r is the effective radius, - ! tau and kappa are best-fit parameters, - ! drdt_0 is the initial rate of change of effective radius, and - ! dr_fresh is the difference between the current and fresh snow states - ! (r_current - r_fresh). - - integer (kind=int_kind), intent(in) :: & - nslyr, & ! number of snow layers - nilyr, & ! number of ice layers - idx_T_max, & ! dimensions of snow parameter matrix - idx_Tgrd_max, & - idx_rhos_max - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), dimension(nslyr), & - intent(in) :: & - smice , & ! mass of ice in snow (kg/m^3) - smliq , & ! mass of liquid in snow (kg/m^3) - rsnw, & ! snow grain radius (10^-6 m) - zqsn ! snow enthalpy (J m-3) - - real (kind=dbl_kind), dimension(nslyr), & - intent(inout) :: & - drsnw_dry ! change due to snow aging (10^-6 m) - - real (kind=dbl_kind), intent(in) :: & - Tsfc, & ! surface temperature (oC) - zTin1, & ! top ice layer temperature (oC) - hsn, & ! snow thickness (m) - hin, & ! ice thickness (m) - rsnw_fall - - ! dry snow aging parameters - real (kind=dbl_kind), dimension(idx_rhos_max,idx_Tgrd_max,idx_T_max), intent(in) :: & - snowage_tau, & ! (10^-6 m) - snowage_kappa, & ! - snowage_drdt0 ! (10^-6 m/hr) - - ! local temporary variables - - integer (kind=int_kind) :: k - - integer (kind=int_kind) :: & - T_idx, & ! temperature index - Tgrd_idx, & ! temperature gradient index - rhos_idx ! density index - - real (kind=dbl_kind), dimension(nslyr):: & - zrhos, & ! snow density (kg/m^3) ! for variable snow density - zdTdz, & ! temperature gradient (K/s) - zTsn ! snow temperature (oC) - - real (kind=dbl_kind) :: & - bst_tau, & ! snow aging parameter retrieved from lookup table [hour] - bst_kappa, & ! snow aging parameter retrieved from lookup table [unitless] - bst_drdt0, & ! snow aging parameter retrieved from lookup table [um hr-1] - dr_fresh, & ! change in snow radius from fresh (10^-6 m) - dzs, & ! snow layer thickness (m) - dzi ! ice layer thickness (m) - - character(len=char_len_long) :: & - warning ! warning message - -! Needed for variable snow density not currently modeled -! calculate density based on liquid and ice content of snow - - drsnw_dry(:) = c0 - zTsn(:) = c0 - zdTdz(:) = c0 - zrhos(:) = rhos - - dzs = hsn/real(nslyr,kind=dbl_kind) - dzi = hin/real(nilyr,kind=dbl_kind) - - if (nslyr == 1) then - zTsn(1) =(Lfresh + zqsn(1)/rhos)/cp_ice - zdTdz(1) = min(c10*idx_Tgrd_max,abs((zTsn(1)*dzi + zTin1*dzs)/(dzs + dzi+puny)- Tsfc)/(hsn+puny)) - else - zTsn(1) =(Lfresh + zqsn(1)/rhos)/cp_ice - do k = 2, nslyr - zTsn(k) = (Lfresh + zqsn(k)/rhos)/cp_ice - if (k == 2) then - zdTdz(k-1) = abs((zTsn(k-1)+zTsn(k))*p5 - Tsfc)/(dzs+puny) - zdTdz(k-1) = min(c10*idx_Tgrd_max,zdTdz(k-1)) - else - zdTdz(k-1) = abs(zTsn(k-2)-zTsn(k))*p5/(dzs+puny) - zdTdz(k-1) = min(c10*idx_Tgrd_max,zdTdz(k-1)) - endif - enddo - - zdTdz(nslyr) = abs((zTsn(nslyr)*dzi + zTin1*dzs)/(dzs + dzi+puny)- & - (zTsn(nslyr) + zTsn(nslyr-1))*p5)/(dzs+puny) - zdTdz(nslyr) = min(c10*idx_Tgrd_max,zdTdz(nslyr)) - endif - - ! best-fit parameters are read from a table - ! 11 temperatures from 225 to 273 K - ! 31 temperature gradients from 0 to 300 K/m - ! 8 snow densities from 0 to 350 kg/m3 - ! pointer snowage_tau, snowage_kappa, snowage_drdt0 - - do k = 1, nslyr - zrhos(k) = smice(k) + smliq(k) - - ! best-fit table indecies: - T_idx = nint(abs(zTsn(k)+ Tffresh - 223.15_dbl_kind) / 5.0_dbl_kind, kind=int_kind) - Tgrd_idx = nint(zdTdz(k) / 10.0_dbl_kind, kind=int_kind) - !rhos_idx = nint(zrhos(k)-50.0_dbl_kind) / 50.0_dbl_kind, kind=int_kind) ! variable density - rhos_idx = nint((rhos-50.0_dbl_kind) / 50.0_dbl_kind, kind=int_kind) ! fixed density - - ! boundary check: - T_idx = min(idx_T_max, max(1,T_idx+1))!min(idx_T_max, max(idx_T_min,T_idx)) - Tgrd_idx = min(idx_Tgrd_max, max(1,Tgrd_idx+1))!min(idx_Tgrd_max, max(idx_Tgrd_min,Tgrd_idx)) - rhos_idx = min(idx_rhos_max, max(1,rhos_idx+1)) !min(idx_rhos_max, max(idx_rhos_min,rhos_idx)) - - bst_tau = snowage_tau(rhos_idx,Tgrd_idx,T_idx) - bst_kappa = snowage_kappa(rhos_idx,Tgrd_idx,T_idx) - bst_drdt0 = snowage_drdt0(rhos_idx,Tgrd_idx,T_idx) - - ! change in snow effective radius, using best-fit parameters - dr_fresh = max(c0,rsnw(k)-rsnw_fall) - drsnw_dry(k) = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1/bst_kappa))& - * (dt/3600.0_dbl_kind) - enddo - - end subroutine snow_dry_metamorph - -!======================================================================= - -! Snow grain metamorphism - - subroutine snow_wet_metamorph (dt, dr_wet, rsnw, smice, smliq) - - use ice_constants_colpkg, only: c0, c1, c4, pi, p1, c100 - ! - ! Liquid water redistribution: Apply the grain growth function from: - ! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of - ! liquid-water content, Annals of Glaciology, 13, 22-26. - ! There are two parameters that describe the grain growth rate as - ! a function of snow liquid water content (LWC). The "LWC=0" parameter - ! is zeroed here because we are accounting for dry snowing with a - ! different representation - ! - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), & - intent(in) :: & - rsnw , & ! snow grain radius (10^-6 m) - smice, & ! snow ice density (kg/m^3) - smliq ! snow liquid density (kg/m^3) - - real (kind=dbl_kind), & - intent(inout) :: & - dr_wet - - real (kind=dbl_kind) :: & - fliq ! liquid mass fraction - - dr_wet = c0 - fliq = c1 - if (smice + smliq > c0 .and. rsnw > c0) then - fliq = min(smliq/(smice + smliq),p1)*c100 - dr_wet = S_wet * fliq**3*dt/(c4*pi*rsnw**2) - endif - - end subroutine snow_wet_metamorph - -!======================================================================= - -! Conversions between ice mass, liquid water mass in snow - - subroutine drain_snow (dt, nslyr, vsnon, aicen, & - smice, smliq, meltsliq, use_smliq_pnd) - - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt, & ! time step - vsnon, & ! snow volume (m) - aicen ! aice area - - real (kind=dbl_kind), intent(inout) :: & - meltsliq ! total liquid content - - real (kind=dbl_kind), dimension(nslyr), & - intent(in) :: & - smice ! mass of ice in snow (kg/m^2) - - real (kind=dbl_kind), dimension(nslyr), & - intent(inout) :: & - smliq ! mass of liquid in snow (kg/m^2) - - logical (kind=log_kind), intent(in) :: & - use_smliq_pnd ! if true, use snow liquid tracer for ponds - - ! local temporary variables - - integer (kind=int_kind) :: k - - real (kind=dbl_kind) :: & - hslyr, & ! snow layer thickness (m) - hsn, & ! snow thickness (m) - meltsliq_tmp ! temperary snow liquid content - - real (kind=dbl_kind), dimension(nslyr) :: & - dlin , & ! liquid into the layer from above (kg/m^2) - dlout , & ! liquid out of the layer (kg/m^2) - phi_liq , & ! volumetric liquid fraction - phi_ice , & ! volumetric ice fraction - w_drain ! flow between layers - - hsn = c0 - meltsliq_tmp = c0 - if (aicen > c0) hsn = vsnon/aicen - if (hsn > puny) then - dlin(:) = c0 - dlout(:) = c0 - hslyr = hsn / real(nslyr,kind=dbl_kind) - do k = 1,nslyr - smliq(k) = smliq(k) + dlin(k) / hslyr ! liquid in from above layer - phi_ice(k) = min(c1, smice(k) / rhoi) - phi_liq(k) = smliq(k)/rhofresh - w_drain(k) = max(c0, (phi_liq(k) - S_r*(c1-phi_ice(k))) / dt * rhofresh * hslyr) - dlout(k) = w_drain(k) * dt - smliq(k) = smliq(k) - dlout(k)/ hslyr - if (k < nslyr) then - dlin(k+1) = dlout(k) - else - meltsliq_tmp = dlout(nslyr) - endif - enddo - else - meltsliq_tmp = meltsliq ! computed in thickness_changes - endif - - meltsliq = meltsliq - if (use_smliq_pnd) meltsliq = meltsliq_tmp - - end subroutine drain_snow - -!======================================================================= - - end module ice_snow - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_therm_0layer.F90 b/components/mpas-seaice/src/column/ice_therm_0layer.F90 deleted file mode 100644 index a068d6eec146..000000000000 --- a/components/mpas-seaice/src/column/ice_therm_0layer.F90 +++ /dev/null @@ -1,352 +0,0 @@ -! SVN:$Id: ice_therm_0layer.F90 1196 2017-04-18 13:32:23Z eclare $ -!========================================================================= -! -! Update ice and snow internal temperatures -! using zero-layer thermodynamics -! -! authors: Alison McLaren, UK MetOffice -! Elizabeth C. Hunke, LANL -! -! 2012: Split from ice_therm_vertical.F90 - - module ice_therm_0layer - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, p5, puny, kseaice - use ice_therm_bl99, only: surface_fluxes - use ice_warnings, only: add_warning - Use ice_colpkg_shared, only: ksno - - implicit none - - private - public :: zerolayer_temperature - -!======================================================================= - - contains - -!======================================================================= -! -! Compute new surface temperature using zero layer model of Semtner -! (1976). -! -! New temperatures are computed iteratively by solving a -! surface flux balance equation (i.e. net surface flux from atmos -! equals conductive flux from the top to the bottom surface). -! -! author: Alison McLaren, Met Office -! (but largely taken from temperature_changes) - - subroutine zerolayer_temperature(dt, & - nilyr, nslyr, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fswsfc, & - hilyr, hslyr, & - Tsf, Tbot, & - fsensn, flatn, & - flwoutn, fsurfn, & - fcondtopn,fcondbot, & - l_stop, stop_label) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), intent(in) :: & - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - Tbot , & ! ice bottom surface temperature (deg C) - fswsfc ! SW absorbed at ice/snow surface (W m-2) - - real (kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hslyr ! snow layer thickness (m) - - real (kind=dbl_kind), intent(inout):: & - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - flwoutn , & ! upward LW at surface (W m-2) - fsurfn , & ! net flux to top surface, excluding fcondtopn - fcondtopn ! downward cond flux at top surface (W m-2) - - real (kind=dbl_kind), intent(out):: & - fcondbot ! downward cond flux at bottom surface (W m-2) - - real (kind=dbl_kind), & - intent(inout) :: & - Tsf ! ice/snow surface temperature, Tsfcn - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - - logical (kind=log_kind), parameter :: & - l_zerolayerchecks = .true. - - integer (kind=int_kind), parameter :: & - nitermax = 50 ! max number of iterations in temperature solver - - real (kind=dbl_kind), parameter :: & - Tsf_errmax = 5.e-4_dbl_kind ! max allowed error in Tsf - ! recommend Tsf_errmax < 0.01 K - - integer (kind=int_kind) :: & - niter ! iteration counter in temperature solver - - real (kind=dbl_kind) :: & - Tsf_start , & ! Tsf at start of iteration - dTsf , & ! Tsf - Tsf_start - dfsurf_dT ! derivative of fsurfn wrt Tsf - - real (kind=dbl_kind) :: & - dTsf_prev , & ! dTsf from previous iteration - dfsens_dT , & ! deriv of fsens wrt Tsf (W m-2 deg-1) - dflat_dT , & ! deriv of flat wrt Tsf (W m-2 deg-1) - dflwout_dT ! deriv of flwout wrt Tsf (W m-2 deg-1) - - real (kind=dbl_kind) :: & - kh , & ! effective conductivity - diag , & ! diagonal matrix elements - rhs ! rhs of tri-diagonal matrix equation - - real (kind=dbl_kind) :: & - heff , & ! effective ice thickness (m) - ! ( hice + hsno*kseaice/ksno) - kratio , & ! ratio of ice and snow conductivies - avg_Tsf ! = 1. if Tsf averaged w/Tsf_start, else = 0. - - logical (kind=log_kind) :: & - converged ! = true when local solution has converged - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - fcondbot = c0 - - converged = .false. - - dTsf_prev = c0 - - !----------------------------------------------------------------- - ! Solve for new temperatures. - ! Iterate until temperatures converge with minimal temperature - ! change. - !----------------------------------------------------------------- - - do niter = 1, nitermax - - if (.not. converged) then - - !----------------------------------------------------------------- - ! Update radiative and turbulent fluxes and their derivatives - ! with respect to Tsf. - !----------------------------------------------------------------- - - call surface_fluxes (Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - flwoutn, fsensn, & - flatn, fsurfn, & - dflwout_dT, dfsens_dT, & - dflat_dT, dfsurf_dT) - - !----------------------------------------------------------------- - ! Compute effective ice thickness (includes snow) and thermal - ! conductivity - !----------------------------------------------------------------- - - kratio = kseaice/ksno - - heff = hilyr + kratio * hslyr - kh = kseaice / heff - - !----------------------------------------------------------------- - ! Compute conductive flux at top surface, fcondtopn. - ! If fsurfn < fcondtopn and Tsf = 0, then reset Tsf to slightly less - ! than zero (but not less than -puny). - !----------------------------------------------------------------- - - fcondtopn = kh * (Tsf - Tbot) - - if (fsurfn < fcondtopn) & - Tsf = min (Tsf, -puny) - - !----------------------------------------------------------------- - ! Save surface temperature at start of iteration - !----------------------------------------------------------------- - - Tsf_start = Tsf - - !----------------------------------------------------------------- - ! Solve surface balance equation to obtain the new temperatures. - !----------------------------------------------------------------- - - diag = dfsurf_dT - kh - rhs = dfsurf_dT*Tsf - fsurfn & - - kh*Tbot - Tsf = rhs / diag - - !----------------------------------------------------------------- - ! Determine whether the computation has converged to an acceptable - ! solution. Four conditions must be satisfied: - ! - ! (1) Tsf <= 0 C. - ! (2) Tsf is not oscillating; i.e., if both dTsf(niter) and - ! dTsf(niter-1) have magnitudes greater than puny, then - ! dTsf(niter)/dTsf(niter-1) cannot be a negative number - ! with magnitude greater than 0.5. - ! (3) abs(dTsf) < Tsf_errmax - ! (4) If Tsf = 0 C, then the downward turbulent/radiative - ! flux, fsurfn, must be greater than or equal to the downward - ! conductive flux, fcondtopn. - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! Initialize convergence flag (true until proven false), dTsf, - ! and temperature-averaging coefficients. - ! Average only if test 1 or 2 fails. - ! Initialize energy. - !----------------------------------------------------------------- - - converged = .true. - dTsf = Tsf - Tsf_start - avg_Tsf = c0 - - !----------------------------------------------------------------- - ! Condition 1: check for Tsf > 0 - ! If Tsf > 0, set Tsf = 0 and leave converged=.true. - !----------------------------------------------------------------- - - if (Tsf > puny) then - Tsf = c0 - dTsf = -Tsf_start - - !----------------------------------------------------------------- - ! Condition 2: check for oscillating Tsf - ! If oscillating, average all temps to increase rate of convergence. - ! It is possible that this may never occur. - !----------------------------------------------------------------- - - elseif (niter > 1 & ! condition (2) - .and. Tsf_start <= -puny & - .and. abs(dTsf) > puny & - .and. abs(dTsf_prev) > puny & - .and. -dTsf/(dTsf_prev+puny*puny) > p5) then - - avg_Tsf = c1 ! average with starting temp - dTsf = p5 * dTsf - converged = .false. - endif - - !----------------------------------------------------------------- - ! If condition 2 failed, average new surface temperature with - ! starting value. - !----------------------------------------------------------------- - Tsf = Tsf & - + avg_Tsf * p5 * (Tsf_start - Tsf) - - !----------------------------------------------------------------- - ! Condition 3: check for large change in Tsf - !----------------------------------------------------------------- - - if (abs(dTsf) > Tsf_errmax) then - converged = .false. - endif - - !----------------------------------------------------------------- - ! Condition 4: check for fsurfn < fcondtopn with Tsf > 0 - !----------------------------------------------------------------- - - fsurfn = fsurfn + dTsf*dfsurf_dT - fcondtopn = kh * (Tsf-Tbot) - - if (Tsf > -puny .and. fsurfn < fcondtopn) then - converged = .false. - endif - - fcondbot = fcondtopn - - dTsf_prev = dTsf - - endif ! converged - - enddo ! temperature iteration niter - - !----------------------------------------------------------------- - ! Check for convergence failures. - !----------------------------------------------------------------- - if (.not.converged) then - write(warning,*) 'Thermo iteration does not converge,' - call add_warning(warning) - write(warning,*) 'Ice thickness:', hilyr*nilyr - call add_warning(warning) - write(warning,*) 'Snow thickness:', hslyr*nslyr - call add_warning(warning) - write(warning,*) 'dTsf, Tsf_errmax:',dTsf_prev, & - Tsf_errmax - call add_warning(warning) - write(warning,*) 'Tsf:', Tsf - call add_warning(warning) - write(warning,*) 'fsurfn:', fsurfn - call add_warning(warning) - write(warning,*) 'fcondtopn, fcondbot', & - fcondtopn, fcondbot - call add_warning(warning) - l_stop = .true. - stop_label = "zerolayer_temperature: Thermo iteration does not converge" - return - endif - - !----------------------------------------------------------------- - ! Check that if Tsfc < 0, then fcondtopn = fsurfn - !----------------------------------------------------------------- - - if (l_zerolayerchecks) then - if (Tsf < c0 .and. & - abs(fcondtopn-fsurfn) > puny) then - - write(warning,*) 'fcondtopn does not equal fsurfn,' - call add_warning(warning) - write(warning,*) 'Tsf=',Tsf - call add_warning(warning) - write(warning,*) 'fcondtopn=',fcondtopn - call add_warning(warning) - write(warning,*) 'fsurfn=',fsurfn - call add_warning(warning) - l_stop = .true. - stop_label = "zerolayer_temperature: fcondtopn /= fsurfn" - return - endif - endif ! l_zerolayerchecks - - ! update fluxes that depend on Tsf - flwoutn = flwoutn + dTsf_prev * dflwout_dT - fsensn = fsensn + dTsf_prev * dfsens_dT - flatn = flatn + dTsf_prev * dflat_dT - - end subroutine zerolayer_temperature - -!======================================================================= - - end module ice_therm_0layer - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_therm_bl99.F90 b/components/mpas-seaice/src/column/ice_therm_bl99.F90 deleted file mode 100644 index 19f3a1b4ae29..000000000000 --- a/components/mpas-seaice/src/column/ice_therm_bl99.F90 +++ /dev/null @@ -1,1504 +0,0 @@ - ! SVN:$Id: ice_therm_bl99.F90 1196 2017-04-18 13:32:23Z eclare $ -!========================================================================= -! -! Update ice and snow internal temperatures -! using Bitz and Lipscomb 1999 thermodynamics -! -! authors: William H. Lipscomb, LANL -! C. M. Bitz, UW -! Elizabeth C. Hunke, LANL -! -! 2012: Split from ice_therm_vertical.F90 - - module ice_therm_bl99 - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, p01, p1, p5, puny, & - rhoi, rhos, hs_min, cp_ice, cp_ocn, depressT, Lfresh, kice - use ice_colpkg_shared, only: conduct, calc_Tsfc, solve_zsal, ksno - use ice_therm_shared, only: ferrmax, l_brine, hfrazilmin - use ice_warnings, only: add_warning - - implicit none - save - - private - public :: surface_fluxes, temperature_changes - - real (kind=dbl_kind), parameter :: & - betak = 0.13_dbl_kind, & ! constant in formula for k (W m-1 ppt-1) - kimin = 0.10_dbl_kind ! min conductivity of saline ice (W m-1 deg-1) - -!======================================================================= - - contains - -!======================================================================= -! -! Compute new surface temperature and internal ice and snow -! temperatures. Include effects of salinity on sea ice heat -! capacity in a way that conserves energy (Bitz and Lipscomb, 1999). -! -! New temperatures are computed iteratively by solving a tridiagonal -! system of equations; heat capacity is updated with each iteration. -! Finite differencing is backward implicit. -! -! See Bitz, C.M., and W.H. Lipscomb, 1999: -! An energy-conserving thermodynamic model of sea ice, -! J. Geophys. Res., 104, 15,669-15,677. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine temperature_changes (dt, & - nilyr, nslyr, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fswsfc, fswint, & - Sswabs, Iswabs, & - hilyr, hslyr, & - zqin, zTin, & - zqsn, zTsn, & - zSin, & - Tsf, Tbot, & - fsensn, flatn, & - flwoutn, fsurfn, & - fcondtopn,fcondbot, & - einit, l_stop, & - stop_label) - - use ice_therm_shared, only: surface_heat_flux, dsurface_heat_flux_dTsf - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), & - intent(in) :: & - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - Tbot ! ice bottom surface temperature (deg C) - - real (kind=dbl_kind), & - intent(inout) :: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - fswint ! SW absorbed in ice interior below surface (W m-2) - - real (kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - einit ! initial energy of melting (J m-2) - - real (kind=dbl_kind), dimension (nslyr), & - intent(inout) :: & - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real (kind=dbl_kind), dimension (nilyr), & - intent(inout) :: & - Iswabs ! SW radiation absorbed in ice layers (W m-2) - - real (kind=dbl_kind), intent(inout):: & - fsurfn , & ! net flux to top surface, excluding fcondtopn - fcondtopn , & ! downward cond flux at top surface (W m-2) - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - flwoutn ! upward LW at surface (W m-2) - - real (kind=dbl_kind), intent(out):: & - fcondbot ! downward cond flux at bottom surface (W m-2) - - real (kind=dbl_kind), & - intent(inout):: & - Tsf ! ice/snow surface temperature, Tsfcn - - real (kind=dbl_kind), dimension (nilyr), & - intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zTin ! internal ice layer temperatures - - real (kind=dbl_kind), dimension (nilyr), & - intent(in) :: & - zSin ! internal ice layer salinities - - real (kind=dbl_kind), dimension (nslyr), & - intent(inout) :: & - zqsn , & ! snow layer enthalpy (J m-3) - zTsn ! internal snow layer temperatures - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - - integer (kind=int_kind), parameter :: & - nitermax = 100 ! max number of iterations in temperature solver - - real (kind=dbl_kind), parameter :: & - Tsf_errmax = 5.e-4_dbl_kind ! max allowed error in Tsf - ! recommend Tsf_errmax < 0.01 K - - integer (kind=int_kind) :: & - k , & ! ice layer index - niter , & ! iteration counter in temperature solver - nmat ! matrix dimension - - logical (kind=log_kind) :: & - l_snow , & ! true if snow temperatures are computed - l_cold ! true if surface temperature is computed - - real (kind=dbl_kind) :: & - Tsf_start , & ! Tsf at start of iteration - dTsf , & ! Tsf - Tsf_start - dTi1 , & ! Ti1(1) - Tin_start(1) - dfsurf_dT , & ! derivative of fsurf wrt Tsf - avg_Tsi , & ! = 1. if new snow/ice temps avg'd w/starting temps - enew ! new energy of melting after temp change (J m-2) - - real (kind=dbl_kind) :: & - dTsf_prev , & ! dTsf from previous iteration - dTi1_prev , & ! dTi1 from previous iteration - dfsens_dT , & ! deriv of fsens wrt Tsf (W m-2 deg-1) - dflat_dT , & ! deriv of flat wrt Tsf (W m-2 deg-1) - dflwout_dT , & ! deriv of flwout wrt Tsf (W m-2 deg-1) - dt_rhoi_hlyr, & ! dt/(rhoi*hilyr) - einex , & ! excess energy from dqmat to ocean - ferr ! energy conservation error (W m-2) - - real (kind=dbl_kind), dimension (nilyr) :: & - Tin_init , & ! zTin at beginning of time step - Tin_start , & ! zTin at start of iteration - dTmat , & ! zTin - matrix solution before limiting - dqmat , & ! associated enthalpy difference - Tmlts ! melting temp, -depressT * salinity - - real (kind=dbl_kind), dimension (nslyr) :: & - Tsn_init , & ! zTsn at beginning of time step - Tsn_start , & ! zTsn at start of iteration - etas ! dt / (rho * cp * h) for snow layers - - real (kind=dbl_kind), dimension (nilyr+nslyr+1) :: & - sbdiag , & ! sub-diagonal matrix elements - diag , & ! diagonal matrix elements - spdiag , & ! super-diagonal matrix elements - rhs , & ! rhs of tri-diagonal matrix equation - Tmat ! matrix output temperatures - - real (kind=dbl_kind), dimension (nilyr) :: & - etai ! dt / (rho * cp * h) for ice layers - - real (kind=dbl_kind), dimension(nilyr+nslyr+1):: & - kh ! effective conductivity at interfaces (W m-2 deg-1) - - real (kind=dbl_kind) :: & - ci , & ! specific heat of sea ice (J kg-1 deg-1) - avg_Tsf , & ! = 1. if Tsf averaged w/Tsf_start, else = 0. - Iswabs_tmp , & ! energy to melt through fraction frac of layer - Sswabs_tmp , & ! same for snow - dswabs , & ! difference in swabs and swabs_tmp - frac , & ! fraction of layer that can be melted through - dTemp ! minimum temperature difference for absorption - - logical (kind=log_kind) :: & - converged ! = true when local solution has converged - - logical (kind=log_kind) , dimension (nilyr) :: & - reduce_kh ! reduce conductivity when T exceeds Tmlt - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - converged = .false. - l_snow = .false. - l_cold = .true. - fcondbot = c0 - dTsf_prev = c0 - dTi1_prev = c0 - dfsens_dT = c0 - dflat_dT = c0 - dflwout_dT = c0 - einex = c0 - dt_rhoi_hlyr = dt / (rhoi*hilyr) ! hilyr > 0 - if (hslyr > hs_min/real(nslyr,kind=dbl_kind)) & - l_snow = .true. - - do k = 1, nslyr - Tsn_init (k) = zTsn(k) ! beginning of time step - Tsn_start(k) = zTsn(k) ! beginning of iteration - if (l_snow) then - etas(k) = dt/(rhos*cp_ice*hslyr) - else - etas(k) = c0 - endif - enddo ! k - - do k = 1, nilyr - Tin_init (k) = zTin(k) ! beginning of time step - Tin_start(k) = zTin(k) ! beginning of iteration - Tmlts (k) = -zSin(k) * depressT - enddo - - !----------------------------------------------------------------- - ! Compute thermal conductivity at interfaces (held fixed during - ! subsequent iterations). - ! Ice and snow interfaces are combined into one array (kh) to - ! simplify the logic. - !----------------------------------------------------------------- - - call conductivity (l_snow, & - nilyr, nslyr, & - hilyr, hslyr, & - zTin, kh, zSin) - - !----------------------------------------------------------------- - ! Check for excessive absorbed solar radiation that may result in - ! temperature overshoots. Convergence is particularly difficult - ! if the starting temperature is already very close to the melting - ! temperature and extra energy is added. In that case, or if the - ! amount of energy absorbed is greater than the amount needed to - ! melt through a given fraction of a layer, we put the extra - ! energy into the surface. - ! NOTE: This option is not available if the atmosphere model - ! has already computed fsurf. (Unless we adjust fsurf here) - !----------------------------------------------------------------- -!mclaren: Should there be an if calc_Tsfc statement here then?? - -#ifdef CCSMCOUPLED - frac = c1 - dTemp = p01 -#else - frac = 0.9_dbl_kind - dTemp = 0.02_dbl_kind -#endif - if (solve_zsal) dTemp = p1 ! lower tolerance with dynamic salinity - do k = 1, nilyr - - Iswabs_tmp = c0 ! all Iswabs is moved into fswsfc - if (Tin_init(k) <= Tmlts(k) - dTemp) then - if (l_brine) then - ci = cp_ice - Lfresh * Tmlts(k) / (Tin_init(k)**2) - Iswabs_tmp = min(Iswabs(k), & - frac*(Tmlts(k)-Tin_init(k))*ci/dt_rhoi_hlyr) - else - ci = cp_ice - Iswabs_tmp = min(Iswabs(k), & - frac*(-Tin_init(k))*ci/dt_rhoi_hlyr) - endif - endif - if (Iswabs_tmp < puny) Iswabs_tmp = c0 - - dswabs = min(Iswabs(k) - Iswabs_tmp, fswint) - - fswsfc = fswsfc + dswabs - fswint = fswint - dswabs - Iswabs(k) = Iswabs_tmp - - enddo - -#ifdef CCSMCOUPLED - frac = 0.9_dbl_kind -#endif - do k = 1, nslyr - if (l_snow) then - - Sswabs_tmp = c0 - if (Tsn_init(k) <= -dTemp) then - Sswabs_tmp = min(Sswabs(k), & - -frac*Tsn_init(k)/etas(k)) - endif - if (Sswabs_tmp < puny) Sswabs_tmp = c0 - - dswabs = min(Sswabs(k) - Sswabs_tmp, fswint) - - fswsfc = fswsfc + dswabs - fswint = fswint - dswabs - Sswabs(k) = Sswabs_tmp - - endif - enddo - - !----------------------------------------------------------------- - ! Solve for new temperatures. - ! Iterate until temperatures converge with minimal energy error. - !----------------------------------------------------------------- - converged = .false. - - do niter = 1, nitermax - - !----------------------------------------------------------------- - ! Identify cells, if any, where calculation has not converged. - !----------------------------------------------------------------- - - if (.not.converged) then - - !----------------------------------------------------------------- - ! Allocate and initialize - !----------------------------------------------------------------- - - converged = .true. - dfsurf_dT = c0 - avg_Tsi = c0 - enew = c0 - einex = c0 - - !----------------------------------------------------------------- - ! Update specific heat of ice layers. - ! To ensure energy conservation, the specific heat is a function of - ! both the starting temperature and the (latest guess for) the - ! final temperature. - !----------------------------------------------------------------- - - do k = 1, nilyr - - if (l_brine) then - ci = cp_ice - Lfresh*Tmlts(k) / & - (zTin(k)*Tin_init(k)) - else - ci = cp_ice - endif - etai(k) = dt_rhoi_hlyr / ci - - enddo - - if (calc_Tsfc) then - - !----------------------------------------------------------------- - ! Update radiative and turbulent fluxes and their derivatives - ! with respect to Tsf. - !----------------------------------------------------------------- - - ! surface heat flux - call surface_heat_flux(Tsf , fswsfc, & - rhoa , flw , & - potT , Qa , & - shcoef , lhcoef, & - flwoutn, fsensn, & - flatn , fsurfn) - - ! derivative of heat flux with respect to surface temperature - call dsurface_heat_flux_dTsf(Tsf , fswsfc , & - rhoa , flw , & - potT , Qa , & - shcoef , lhcoef , & - dfsurf_dT, dflwout_dT, & - dfsens_dT, dflat_dT ) - - !----------------------------------------------------------------- - ! Compute conductive flux at top surface, fcondtopn. - ! If fsurfn < fcondtopn and Tsf = 0, then reset Tsf to slightly less - ! than zero (but not less than -puny). - !----------------------------------------------------------------- - - if (l_snow) then - fcondtopn = kh(1) * (Tsf - zTsn(1)) - else - fcondtopn = kh(1+nslyr) * (Tsf - zTin(1)) - endif - - if (Tsf >= c0 .and. fsurfn < fcondtopn) & - Tsf = -puny - - !----------------------------------------------------------------- - ! Save surface temperature at start of iteration - !----------------------------------------------------------------- - - Tsf_start = Tsf - - if (Tsf < c0) then - l_cold = .true. - else - l_cold = .false. - endif - - !----------------------------------------------------------------- - ! Compute elements of tridiagonal matrix. - !----------------------------------------------------------------- - - call get_matrix_elements_calc_Tsfc (nilyr, nslyr, & - l_snow, l_cold, & - Tsf, Tbot, & - fsurfn, dfsurf_dT, & - Tin_init, Tsn_init, & - kh, Sswabs, & - Iswabs, & - etai, etas, & - sbdiag, diag, & - spdiag, rhs) - - else - - call get_matrix_elements_know_Tsfc (nilyr, nslyr, & - l_snow, Tbot, & - Tin_init, Tsn_init, & - kh, Sswabs, & - Iswabs, & - etai, etas, & - sbdiag, diag, & - spdiag, rhs, & - fcondtopn) - - endif ! calc_Tsfc - - !----------------------------------------------------------------- - ! Solve tridiagonal matrix to obtain the new temperatures. - !----------------------------------------------------------------- - - nmat = nslyr + nilyr + 1 ! matrix dimension - - call tridiag_solver (nmat, sbdiag(:), & - diag(:), spdiag(:), & - rhs(:), Tmat(:)) - - !----------------------------------------------------------------- - ! Determine whether the computation has converged to an acceptable - ! solution. Five conditions must be satisfied: - ! - ! (1) Tsf <= 0 C. - ! (2) Tsf is not oscillating; i.e., if both dTsf(niter) and - ! dTsf(niter-1) have magnitudes greater than puny, then - ! dTsf(niter)/dTsf(niter-1) cannot be a negative number - ! with magnitude greater than 0.5. - ! (3) abs(dTsf) < Tsf_errmax - ! (4) If Tsf = 0 C, then the downward turbulent/radiative - ! flux, fsurfn, must be greater than or equal to the downward - ! conductive flux, fcondtopn. - ! (5) The net energy added to the ice per unit time must equal - ! the net change in internal ice energy per unit time, - ! withinic the prescribed error ferrmax. - ! - ! For briny ice (the standard case), zTsn and zTin are limited - ! to prevent them from exceeding their melting temperatures. - ! (Note that the specific heat formula for briny ice assumes - ! that T < Tmlt.) - ! For fresh ice there is no limiting, since there are cases - ! when the only convergent solution has zTsn > 0 and/or zTin > 0. - ! Above-zero temperatures are then reset to zero (with melting - ! to conserve energy) in the thickness_changes subroutine. - !----------------------------------------------------------------- - - if (calc_Tsfc) then - - !----------------------------------------------------------------- - ! Reload Tsf from matrix solution - !----------------------------------------------------------------- - - if (l_cold) then - if (l_snow) then - Tsf = Tmat(1) - else - Tsf = Tmat(1+nslyr) - endif - else ! melting surface - Tsf = c0 - endif - - !----------------------------------------------------------------- - ! Initialize convergence flag (true until proven false), dTsf, - ! and temperature-averaging coefficients. - ! Average only if test 1 or 2 fails. - ! Initialize energy. - !----------------------------------------------------------------- - - dTsf = Tsf - Tsf_start - avg_Tsf = c0 - - !----------------------------------------------------------------- - ! Condition 1: check for Tsf > 0 - ! If Tsf > 0, set Tsf = 0, then average zTsn and zTin to force - ! internal temps below their melting temps. - !----------------------------------------------------------------- - - if (Tsf > puny) then - Tsf = c0 - dTsf = -Tsf_start - if (l_brine) avg_Tsi = c1 ! avg with starting temp - converged = .false. - - !----------------------------------------------------------------- - ! Condition 2: check for oscillating Tsf - ! If oscillating, average all temps to increase rate of convergence. - !----------------------------------------------------------------- - - elseif (niter > 1 & ! condition (2) - .and. Tsf_start <= -puny & - .and. abs(dTsf) > puny & - .and. abs(dTsf_prev) > puny & - .and. -dTsf/(dTsf_prev+puny*puny) > p5) then - - if (l_brine) then ! average with starting temp - avg_Tsf = c1 - avg_Tsi = c1 - endif - dTsf = p5 * dTsf - converged = .false. - endif - -!!! dTsf_prev = dTsf - - !----------------------------------------------------------------- - ! If condition 2 failed, average new surface temperature with - ! starting value. - !----------------------------------------------------------------- - Tsf = Tsf & - + avg_Tsf * p5 * (Tsf_start - Tsf) - - endif ! calc_Tsfc - - do k = 1, nslyr - - !----------------------------------------------------------------- - ! Reload zTsn from matrix solution - !----------------------------------------------------------------- - - if (l_snow) then - zTsn(k) = Tmat(k+1) - else - zTsn(k) = c0 - endif - if (l_brine) zTsn(k) = min(zTsn(k), c0) - - !----------------------------------------------------------------- - ! If condition 1 or 2 failed, average new snow layer - ! temperatures with their starting values. - !----------------------------------------------------------------- - zTsn(k) = zTsn(k) & - + avg_Tsi*p5*(Tsn_start(k)-zTsn(k)) - - !----------------------------------------------------------------- - ! Compute zqsn and increment new energy. - !----------------------------------------------------------------- - zqsn(k) = -rhos * (Lfresh - cp_ice*zTsn(k)) - enew = enew + hslyr * zqsn(k) - - Tsn_start(k) = zTsn(k) ! for next iteration - - enddo ! nslyr - - dTmat(:) = c0 - dqmat(:) = c0 - reduce_kh(:) = .false. - do k = 1, nilyr - - !----------------------------------------------------------------- - ! Reload zTin from matrix solution - !----------------------------------------------------------------- - - zTin(k) = Tmat(k+1+nslyr) - - if (l_brine .and. zTin(k) > Tmlts(k) - puny) then - dTmat(k) = zTin(k) - Tmlts(k) - dqmat(k) = rhoi * dTmat(k) & - * (cp_ice - Lfresh * Tmlts(k)/zTin(k)**2) -! use this for the case that Tmlt changes by an amount dTmlt=Tmltnew-Tmlt(k) -! + rhoi * dTmlt & -! * (cp_ocn - cp_ice + Lfresh/zTin(k)) - zTin(k) = Tmlts(k) - reduce_kh(k) = .true. - endif - - !----------------------------------------------------------------- - ! Condition 2b: check for oscillating zTin(1) - ! If oscillating, average all ice temps to increase rate of convergence. - !----------------------------------------------------------------- - - if (k==1 .and. .not.calc_Tsfc) then - dTi1 = zTin(k) - Tin_start(k) - - if (niter > 1 & ! condition 2b - .and. abs(dTi1) > puny & - .and. abs(dTi1_prev) > puny & - .and. -dTi1/(dTi1_prev+puny*puny) > p5) then - - if (l_brine) avg_Tsi = c1 - dTi1 = p5 * dTi1 - converged = .false. - endif - dTi1_prev = dTi1 - endif ! k = 1 .and. calc_Tsfc = F - - !----------------------------------------------------------------- - ! If condition 1 or 2 failed, average new ice layer - ! temperatures with their starting values. - !----------------------------------------------------------------- - zTin(k) = zTin(k) & - + avg_Tsi*p5*(Tin_start(k)-zTin(k)) - - !----------------------------------------------------------------- - ! Compute zqin and increment new energy. - !----------------------------------------------------------------- - if (l_brine) then - zqin(k) = -rhoi * (cp_ice*(Tmlts(k)-zTin(k)) & - + Lfresh*(c1-Tmlts(k)/zTin(k)) & - - cp_ocn*Tmlts(k)) - else - zqin(k) = -rhoi * (-cp_ice*zTin(k) + Lfresh) - endif - enew = enew + hilyr * zqin(k) - einex = einex + hilyr * dqmat(k) - - Tin_start(k) = zTin(k) ! for next iteration - - enddo ! nilyr - - if (calc_Tsfc) then - - !----------------------------------------------------------------- - ! Condition 3: check for large change in Tsf - !----------------------------------------------------------------- - - if (abs(dTsf) > Tsf_errmax) then - converged = .false. - endif - - !----------------------------------------------------------------- - ! Condition 4: check for fsurfn < fcondtopn with Tsf >= 0 - !----------------------------------------------------------------- - - fsurfn = fsurfn + dTsf*dfsurf_dT - if (l_snow) then - fcondtopn = kh(1) * (Tsf-zTsn(1)) - else - fcondtopn = kh(1+nslyr) * (Tsf-zTin(1)) - endif - - if (Tsf >= c0 .and. fsurfn < fcondtopn) then - converged = .false. - endif - - dTsf_prev = dTsf - - endif ! calc_Tsfc - - !----------------------------------------------------------------- - ! Condition 5: check for energy conservation error - ! Change in internal ice energy should equal net energy input. - !----------------------------------------------------------------- - - fcondbot = kh(1+nslyr+nilyr) * & - (zTin(nilyr) - Tbot) - - ! Flux extra energy out of the ice - fcondbot = fcondbot + einex/dt - - ferr = abs( (enew-einit)/dt & - - (fcondtopn - fcondbot + fswint) ) - - ! factor of 0.9 allows for roundoff errors later - if (ferr > 0.9_dbl_kind*ferrmax) then ! condition (5) - - converged = .false. - - ! reduce conductivity for next iteration - do k = 1, nilyr - if (reduce_kh(k) .and. dqmat(k) > c0) then - frac = max(0.5*(c1-ferr/abs(fcondtopn-fcondbot)),p1) -! frac = p1 - kh(k+nslyr+1) = kh(k+nslyr+1) * frac - kh(k+nslyr) = kh(k+nslyr+1) - endif - enddo - - endif ! ferr - - endif ! convergence - - enddo ! temperature iteration niter - - !----------------------------------------------------------------- - ! Check for convergence failures. - !----------------------------------------------------------------- - if (.not.converged) then - write(warning,*) 'Thermo iteration does not converge,' - call add_warning(warning) - write(warning,*) 'Ice thickness:', hilyr*nilyr - call add_warning(warning) - write(warning,*) 'Snow thickness:', hslyr*nslyr - call add_warning(warning) - write(warning,*) 'dTsf, Tsf_errmax:',dTsf_prev, & - Tsf_errmax - call add_warning(warning) - write(warning,*) 'Tsf:', Tsf - call add_warning(warning) - write(warning,*) 'fsurf:', fsurfn - call add_warning(warning) - write(warning,*) 'fcondtop, fcondbot, fswint', & - fcondtopn, fcondbot, fswint - call add_warning(warning) - write(warning,*) 'fswsfc', fswsfc - call add_warning(warning) - write(warning,*) 'Iswabs',(Iswabs(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'Flux conservation error =', ferr - call add_warning(warning) - write(warning,*) 'Initial snow temperatures:' - call add_warning(warning) - write(warning,*) (Tsn_init(k),k=1,nslyr) - call add_warning(warning) - write(warning,*) 'Initial ice temperatures:' - call add_warning(warning) - write(warning,*) (Tin_init(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'Matrix ice temperature diff:' - call add_warning(warning) - write(warning,*) (dTmat(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'dqmat*hilyr/dt:' - call add_warning(warning) - write(warning,*) (hilyr*dqmat(k)/dt,k=1,nilyr) - call add_warning(warning) - write(warning,*) 'Final snow temperatures:' - call add_warning(warning) - write(warning,*) (zTsn(k),k=1,nslyr) - call add_warning(warning) - write(warning,*) 'Matrix ice temperature diff:' - call add_warning(warning) - write(warning,*) (dTmat(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'dqmat*hilyr/dt:' - call add_warning(warning) - write(warning,*) (hilyr*dqmat(k)/dt,k=1,nilyr) - call add_warning(warning) - write(warning,*) 'Final ice temperatures:' - call add_warning(warning) - write(warning,*) (zTin(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'Ice melting temperatures:' - call add_warning(warning) - write(warning,*) (Tmlts(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'Ice bottom temperature:', Tbot - call add_warning(warning) - write(warning,*) 'dT initial:' - call add_warning(warning) - write(warning,*) (Tmlts(k)-Tin_init(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'dT final:' - call add_warning(warning) - write(warning,*) (Tmlts(k)-zTin(k),k=1,nilyr) - call add_warning(warning) - write(warning,*) 'zSin' - call add_warning(warning) - write(warning,*) (zSin(k),k=1,nilyr) - call add_warning(warning) - l_stop = .true. - stop_label = "temperature_changes: Thermo iteration does not converge" - return - endif - - if (calc_Tsfc) then - - ! update fluxes that depend on Tsf - flwoutn = flwoutn + dTsf_prev * dflwout_dT - fsensn = fsensn + dTsf_prev * dfsens_dT - flatn = flatn + dTsf_prev * dflat_dT - - endif ! calc_Tsfc - - end subroutine temperature_changes - -!======================================================================= -! -! Compute thermal conductivity at interfaces (held fixed during -! the subsequent iteration). -! -! NOTE: Ice conductivity must be >= kimin -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine conductivity (l_snow, & - nilyr, nslyr, & - hilyr, hslyr, & - zTin, kh, zSin) - - logical (kind=log_kind), intent(in) :: & - l_snow ! true if snow temperatures are computed - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (same for all ice layers) - hslyr ! snow layer thickness (same for all snow layers) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - zTin , & ! internal ice layer temperatures - zSin ! internal ice layer salinities - - real (kind=dbl_kind), dimension (nilyr+nslyr+1), & - intent(out) :: & - kh ! effective conductivity at interfaces (W m-2 deg-1) - - ! local variables - - integer (kind=int_kind) :: & - k ! vertical index - - real (kind=dbl_kind), dimension (nilyr) :: & - kilyr ! thermal cond at ice layer midpoints (W m-1 deg-1) - - real (kind=dbl_kind), dimension (nslyr) :: & - kslyr ! thermal cond at snow layer midpoints (W m-1 deg-1) - - ! interior snow layers (simple for now, but may be fancier later) - do k = 1, nslyr - kslyr(k) = ksno - enddo ! nslyr - - ! interior ice layers - if (conduct == 'MU71') then - ! Maykut and Untersteiner 1971 form (with Wettlaufer 1991 constants) - do k = 1, nilyr - kilyr(k) = kice + betak*zSin(k)/min(-puny,zTin(k)) - kilyr(k) = max (kilyr(k), kimin) - enddo ! nilyr - else - ! Pringle et al JGR 2007 'bubbly brine' - do k = 1, nilyr - kilyr(k) = (2.11_dbl_kind - 0.011_dbl_kind*zTin(k) & - + 0.09_dbl_kind*zSin(k)/min(-puny,zTin(k))) & - * rhoi / 917._dbl_kind - kilyr(k) = max (kilyr(k), kimin) - enddo ! nilyr - endif ! conductivity - - ! top snow interface, top and bottom ice interfaces - ! top of snow layer; top surface of top ice layer - if (l_snow) then - kh(1) = c2 * kslyr(1) / hslyr - kh(1+nslyr) = c2 * kslyr(nslyr) * kilyr(1) / & - ( kslyr(nslyr)*hilyr + & - kilyr(1 )*hslyr ) - else - kh(1) = c0 - kh(1+nslyr) = c2 * kilyr(1) / hilyr - endif - - ! bottom surface of bottom ice layer - kh(1+nslyr+nilyr) = c2 * kilyr(nilyr) / hilyr - - ! interior snow interfaces - - if (nslyr > 1) then - do k = 2, nslyr - if (l_snow) then - kh(k) = c2 * kslyr(k-1) * kslyr(k) / & - ((kslyr(k-1) + kslyr(k))*hslyr) - else - kh(k) = c0 - endif - enddo ! nilyr - endif ! nslyr > 1 - - ! interior ice interfaces - do k = 2, nilyr - kh(k+nslyr) = c2 * kilyr(k-1) * kilyr(k) / & - ((kilyr(k-1) + kilyr(k))*hilyr) - enddo ! nilyr - - end subroutine conductivity - -!======================================================================= -! -! Compute radiative and turbulent fluxes and their derivatives -! with respect to Tsf. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine surface_fluxes (Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - flwoutn, fsensn, & - flatn, fsurfn, & - dflwout_dT, dfsens_dT, & - dflat_dT, dfsurf_dT) - - use ice_therm_shared, only: surface_heat_flux, dsurface_heat_flux_dTsf - - real (kind=dbl_kind), intent(in) :: & - Tsf ! ice/snow surface temperature, Tsfcn - - real (kind=dbl_kind), intent(in) :: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - real (kind=dbl_kind), & - intent(inout) :: & - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - flwoutn , & ! upward LW at surface (W m-2) - fsurfn ! net flux to top surface, excluding fcondtopn - - real (kind=dbl_kind), & - intent(inout) :: & - dfsens_dT , & ! deriv of fsens wrt Tsf (W m-2 deg-1) - dflat_dT , & ! deriv of flat wrt Tsf (W m-2 deg-1) - dflwout_dT ! deriv of flwout wrt Tsf (W m-2 deg-1) - - real (kind=dbl_kind), & - intent(inout) :: & - dfsurf_dT ! derivative of fsurfn wrt Tsf - - ! surface heat flux - call surface_heat_flux(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - flwoutn, fsensn, & - flatn, fsurfn) - - ! derivative of heat flux with respect to surface temperature - call dsurface_heat_flux_dTsf(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - dfsurf_dT, dflwout_dT, & - dfsens_dT, dflat_dT) - - end subroutine surface_fluxes - -!======================================================================= -! -! Compute terms in tridiagonal matrix that will be solved to find -! the new vertical temperature profile -! This routine is for the case in which Tsfc is being computed. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW -! -! March 2004 by William H. Lipscomb for multiple snow layers -! April 2008 by E. C. Hunke, divided into two routines based on calc_Tsfc - - subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & - l_snow, l_cold, & - Tsf, Tbot, & - fsurfn, dfsurf_dT, & - Tin_init, Tsn_init, & - kh, Sswabs, & - Iswabs, & - etai, etas, & - sbdiag, diag, & - spdiag, rhs) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - logical (kind=log_kind), & - intent(in) :: & - l_snow , & ! true if snow temperatures are computed - l_cold ! true if surface temperature is computed - - real (kind=dbl_kind), intent(in) :: & - Tsf ! ice/snow top surface temp (deg C) - - real (kind=dbl_kind), intent(in) :: & - fsurfn , & ! net flux to top surface, excluding fcondtopn (W/m^2) - Tbot ! ice bottom surface temperature (deg C) - - real (kind=dbl_kind), intent(in) :: & - dfsurf_dT ! derivative of fsurf wrt Tsf - - real (kind=dbl_kind), dimension (:), intent(in) :: & - etai , & ! dt / (rho*cp*h) for ice layers - Tin_init , & ! ice temp at beginning of time step - Sswabs , & ! SW radiation absorbed in snow layers (W m-2) - Iswabs , & ! absorbed SW flux in ice layers - etas , & ! dt / (rho*cp*h) for snow layers - Tsn_init ! snow temp at beginning of time step - ! Note: no absorbed SW in snow layers - - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(in) :: & - kh ! effective conductivity at layer interfaces - - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(inout) :: & - sbdiag , & ! sub-diagonal matrix elements - diag , & ! diagonal matrix elements - spdiag , & ! super-diagonal matrix elements - rhs ! rhs of tri-diagonal matrix eqn. - - ! local variables - - integer (kind=int_kind) :: & - k, ki, kr ! vertical indices and row counters - - !----------------------------------------------------------------- - ! Initialize matrix elements. - ! Note: When we do not need to solve for the surface or snow - ! temperature, we solve dummy equations with solution T = 0. - ! Ice layers are fully initialized below. - !----------------------------------------------------------------- - - do k = 1, nslyr+1 - sbdiag(k) = c0 - diag (k) = c1 - spdiag(k) = c0 - rhs (k) = c0 - enddo - - !----------------------------------------------------------------- - ! Compute matrix elements - ! - ! Four possible cases to solve: - ! (1) Cold surface (Tsf < 0), snow present - ! (2) Melting surface (Tsf = 0), snow present - ! (3) Cold surface (Tsf < 0), no snow - ! (4) Melting surface (Tsf = 0), no snow - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! Tsf equation for case of cold surface (with or without snow) - !----------------------------------------------------------------- - - if (l_cold) then - if (l_snow) then - k = 1 - else ! no snow - k = 1 + nslyr - endif - kr = k - - sbdiag(kr) = c0 - diag (kr) = dfsurf_dT - kh(k) - spdiag(kr) = kh(k) - rhs (kr) = dfsurf_dT*Tsf - fsurfn - endif ! l_cold - - !----------------------------------------------------------------- - ! top snow layer - !----------------------------------------------------------------- -! k = 1 -! kr = 2 - - if (l_snow) then - if (l_cold) then - sbdiag(2) = -etas(1) * kh(1) - spdiag(2) = -etas(1) * kh(2) - diag (2) = c1 & - + etas(1) * (kh(1) + kh(2)) - rhs (2) = Tsn_init(1) & - + etas(1) * Sswabs(1) - else ! melting surface - sbdiag(2) = c0 - spdiag(2) = -etas(1) * kh(2) - diag (2) = c1 & - + etas(1) * (kh(1) + kh(2)) - rhs (2) = Tsn_init(1) & - + etas(1)*kh(1)*Tsf & - + etas(1) * Sswabs(1) - endif ! l_cold - endif ! l_snow - - !----------------------------------------------------------------- - ! remaining snow layers - !----------------------------------------------------------------- - - if (nslyr > 1) then - - do k = 2, nslyr - kr = k + 1 - - if (l_snow) then - sbdiag(kr) = -etas(k) * kh(k) - spdiag(kr) = -etas(k) * kh(k+1) - diag (kr) = c1 & - + etas(k) * (kh(k) + kh(k+1)) - rhs (kr) = Tsn_init(k) & - + etas(k) * Sswabs(k) - endif - enddo ! nslyr - - endif ! nslyr > 1 - - if (nilyr > 1) then - - !----------------------------------------------------------------- - ! top ice layer - !----------------------------------------------------------------- - - ki = 1 - k = ki + nslyr - kr = k + 1 - - if (l_snow .or. l_cold) then - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = -etai(ki) * kh(k+1) - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki)*Iswabs(ki) - else ! no snow, warm surface - sbdiag(kr) = c0 - spdiag(kr) = -etai(ki) * kh(k+1) - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki)*Iswabs(ki) & - + etai(ki)*kh(k)*Tsf - endif - - !----------------------------------------------------------------- - ! bottom ice layer - !----------------------------------------------------------------- - - ki = nilyr - k = ki + nslyr - kr = k + 1 - - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = c0 - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki)*Iswabs(ki) & - + etai(ki)*kh(k+1)*Tbot - - else ! nilyr = 1 - - !----------------------------------------------------------------- - ! single ice layer - !----------------------------------------------------------------- - - ki = 1 - k = ki + nslyr - kr = k + 1 - - if (l_snow .or. l_cold) then - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = c0 - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki) * Iswabs(ki) & - + etai(ki) * kh(k+1)*Tbot - else ! no snow, warm surface - sbdiag(kr) = c0 - spdiag(kr) = c0 - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki) * Iswabs(ki) & - + etai(ki) * kh(k)*Tsf & - + etai(ki) * kh(k+1)*Tbot - endif - - endif ! nilyr > 1 - - !----------------------------------------------------------------- - ! interior ice layers - !----------------------------------------------------------------- - - do ki = 2, nilyr-1 - - k = ki + nslyr - kr = k + 1 - - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = -etai(ki) * kh(k+1) - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki)*Iswabs(ki) - enddo ! nilyr - - end subroutine get_matrix_elements_calc_Tsfc - -!======================================================================= -! -! Compute terms in tridiagonal matrix that will be solved to find -! the new vertical temperature profile -! This routine is for the case in which Tsfc is already known. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW -! -! March 2004 by William H. Lipscomb for multiple snow layers -! April 2008 by E. C. Hunke, divided into two routines based on calc_Tsfc - - subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & - l_snow, Tbot, & - Tin_init, Tsn_init, & - kh, Sswabs, & - Iswabs, & - etai, etas, & - sbdiag, diag, & - spdiag, rhs, & - fcondtopn) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - logical (kind=log_kind), & - intent(in) :: & - l_snow ! true if snow temperatures are computed - - real (kind=dbl_kind), intent(in) :: & - Tbot ! ice bottom surface temperature (deg C) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - etai , & ! dt / (rho*cp*h) for ice layers - Tin_init , & ! ice temp at beginning of time step - Sswabs , & ! SW radiation absorbed in snow layers (W m-2) - Iswabs , & ! absorbed SW flux in ice layers - etas , & ! dt / (rho*cp*h) for snow layers - Tsn_init ! snow temp at beginning of time step - ! Note: no absorbed SW in snow layers - - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(in) :: & - kh ! effective conductivity at layer interfaces - - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(inout) :: & - sbdiag , & ! sub-diagonal matrix elements - diag , & ! diagonal matrix elements - spdiag , & ! super-diagonal matrix elements - rhs ! rhs of tri-diagonal matrix eqn. - - real (kind=dbl_kind), intent(in), & - optional :: & - fcondtopn ! conductive flux at top sfc, positive down (W/m^2) - - ! local variables - - integer (kind=int_kind) :: & - k, ki, kr ! vertical indices and row counters - - !----------------------------------------------------------------- - ! Initialize matrix elements. - ! Note: When we do not need to solve for the surface or snow - ! temperature, we solve dummy equations with solution T = 0. - ! Ice layers are fully initialized below. - !----------------------------------------------------------------- - - do k = 1, nslyr+1 - sbdiag(k) = c0 - diag (k) = c1 - spdiag(k) = c0 - rhs (k) = c0 - enddo - - !----------------------------------------------------------------- - ! Compute matrix elements - ! - ! Four possible cases to solve: - ! (1) Cold surface (Tsf < 0), snow present - ! (2) Melting surface (Tsf = 0), snow present - ! (3) Cold surface (Tsf < 0), no snow - ! (4) Melting surface (Tsf = 0), no snow - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! top snow layer - !----------------------------------------------------------------- -! k = 1 -! kr = 2 - - if (l_snow) then - sbdiag(2) = c0 - spdiag(2) = -etas(1) * kh(2) - diag (2) = c1 & - + etas(1) * kh(2) - rhs (2) = Tsn_init(1) & - + etas(1) * Sswabs(1) & - + etas(1) * fcondtopn - endif ! l_snow - - !----------------------------------------------------------------- - ! remaining snow layers - !----------------------------------------------------------------- - - if (nslyr > 1) then - - do k = 2, nslyr - kr = k + 1 - - if (l_snow) then - sbdiag(kr) = -etas(k) * kh(k) - spdiag(kr) = -etas(k) * kh(k+1) - diag (kr) = c1 & - + etas(k) * (kh(k) + kh(k+1)) - rhs (kr) = Tsn_init(k) & - + etas(k) * Sswabs(k) - endif - - enddo ! nslyr - - endif ! nslyr > 1 - - if (nilyr > 1) then - - !----------------------------------------------------------------- - ! top ice layer - !----------------------------------------------------------------- - - ki = 1 - k = ki + nslyr - kr = k + 1 - - if (l_snow) then - - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = -etai(ki) * kh(k+1) - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki) * Iswabs(ki) - else - sbdiag(kr) = c0 - spdiag(kr) = -etai(ki) * kh(k+1) - diag (kr) = c1 & - + etai(ki) * kh(k+1) - rhs (kr) = Tin_init(ki) & - + etai(ki) * Iswabs(ki) & - + etai(ki) * fcondtopn - endif ! l_snow - - !----------------------------------------------------------------- - ! bottom ice layer - !----------------------------------------------------------------- - - ki = nilyr - k = ki + nslyr - kr = k + 1 - - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = c0 - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki)*Iswabs(ki) & - + etai(ki)*kh(k+1)*Tbot - - else ! nilyr = 1 - - !----------------------------------------------------------------- - ! single ice layer - !----------------------------------------------------------------- - - ki = 1 - k = ki + nslyr - kr = k + 1 - - if (l_snow) then - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = c0 - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki) * Iswabs(ki) & - + etai(ki) * kh(k+1)*Tbot - else - sbdiag(kr) = c0 - spdiag(kr) = c0 - diag (kr) = c1 & - + etai(ki) * kh(k+1) - rhs (kr) = Tin_init(ki) & - + etai(ki) * Iswabs(ki) & - + etai(ki) * fcondtopn & - + etai(ki) * kh(k+1)*Tbot - endif - - endif ! nilyr > 1 - - !----------------------------------------------------------------- - ! interior ice layers - !----------------------------------------------------------------- - - do ki = 2, nilyr-1 - - k = ki + nslyr - kr = k + 1 - - sbdiag(kr) = -etai(ki) * kh(k) - spdiag(kr) = -etai(ki) * kh(k+1) - diag (kr) = c1 & - + etai(ki) * (kh(k) + kh(k+1)) - rhs (kr) = Tin_init(ki) & - + etai(ki)*Iswabs(ki) - - enddo ! nilyr - - end subroutine get_matrix_elements_know_Tsfc - -!======================================================================= -! -! Tridiagonal matrix solver--used to solve the implicit vertical heat -! equation in ice and snow -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine tridiag_solver (nmat, sbdiag, & - diag, spdiag, & - rhs, xout) - - integer (kind=int_kind), intent(in) :: & - nmat ! matrix dimension - - real (kind=dbl_kind), dimension (:), intent(in) :: & - sbdiag , & ! sub-diagonal matrix elements - diag , & ! diagonal matrix elements - spdiag , & ! super-diagonal matrix elements - rhs ! rhs of tri-diagonal matrix eqn. - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - xout ! solution vector - - ! local variables - - integer (kind=int_kind) :: & - k ! row counter - - real (kind=dbl_kind) :: & - wbeta ! temporary matrix variable - - real (kind=dbl_kind), dimension(nmat) :: & - wgamma ! temporary matrix variable - - wbeta = diag(1) - xout(1) = rhs(1) / wbeta - - do k = 2, nmat - wgamma(k) = spdiag(k-1) / wbeta - wbeta = diag(k) - sbdiag(k)*wgamma(k) - xout(k) = (rhs(k) - sbdiag(k)*xout(k-1)) & - / wbeta - enddo ! k - - do k = nmat-1, 1, -1 - xout(k) = xout(k) - wgamma(k+1)*xout(k+1) - enddo ! k - - end subroutine tridiag_solver - -!======================================================================= - - end module ice_therm_bl99 - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_therm_itd.F90 b/components/mpas-seaice/src/column/ice_therm_itd.F90 deleted file mode 100644 index 22b9d3cd894a..000000000000 --- a/components/mpas-seaice/src/column/ice_therm_itd.F90 +++ /dev/null @@ -1,1537 +0,0 @@ -! SVN:$Id: ice_therm_itd.F90 1196 2017-04-18 13:32:23Z eclare $ -!======================================================================= -! -! Thermo calculations after call to coupler, related to ITD: -! ice thickness redistribution, lateral growth and melting. -! -! NOTE: The thermodynamic calculation is split in two for load balancing. -! First ice_therm_vertical computes vertical growth rates and coupler -! fluxes. Then ice_therm_itd does thermodynamic calculations not -! needed for coupling. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW -! Elizabeth C. Hunke, LANL -! -! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb -! 2004: Block structure added by William Lipscomb -! 2006: Streamlined for efficiency by Elizabeth Hunke -! 2014: Column package created by Elizabeth Hunke -! - module ice_therm_itd - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, c3, c4, c6, c10, & - p001, p1, p333, p5, p666, puny, bignum, & - rhos, rhoi, Lfresh, ice_ref_salinity, rhosmin - use ice_warnings, only: add_warning - - - implicit none - save - - private - public :: linear_itd, add_new_ice, lateral_melt - - logical (kind=log_kind), parameter :: & - l_conservation_check = .false. ! if true, check conservation - ! (useful for debugging) - -!======================================================================= - - contains - -!======================================================================= -! -! ITD scheme that shifts ice among categories -! -! See Lipscomb, W. H. Remapping the thickness distribution in sea -! ice models. 2001, J. Geophys. Res., Vol 106, 13989--14000. -! -! Using the thermodynamic "velocities", interpolate to find the -! velocities in thickness space at the category boundaries, and -! compute the new locations of the boundaries. Then for each -! category, compute the thickness distribution function, g(h), -! between hL and hR, the left and right boundaries of the category. -! Assume g(h) is a linear polynomial that satisfies two conditions: -! -! (1) The ice area implied by g(h) equals aicen(n). -! (2) The ice volume implied by g(h) equals aicen(n)*hicen(n). -! -! Given g(h), at each boundary compute the ice area and volume lying -! between the original and new boundary locations. Transfer area -! and volume across each boundary in the appropriate direction, thus -! restoring the original boundaries. -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine linear_itd (ncat, hin_max, & - nilyr, nslyr, & - ntrcr, trcr_depend, & - trcr_base, n_trcr_strata,& - nt_strata, Tf, & - aicen_init, vicen_init, & - aicen, trcrn, & - vicen, vsnon, & - aice, aice0, & - fpond, l_stop, & - stop_label) - - use ice_itd, only: aggregate_area, shift_ice, & - column_sum, column_conservation_check - use ice_colpkg_tracers, only: nt_qice, nt_qsno, nt_fbri, nt_sice, & - tr_pond_topo, nt_apnd, nt_hpnd, tr_brine, & - nt_rhos, tr_snow - use ice_therm_shared, only: hi_min - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - ntrcr ! number of tracers in use - - real (kind=dbl_kind), intent(in) :: & - Tf ! ocean freezing temperature (C) - - real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & - hin_max ! category boundaries (m) - - integer (kind=int_kind), dimension (:), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (:,:), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension(:), intent(in) :: & - aicen_init, & ! initial ice concentration (before vertical thermo) - vicen_init ! initial ice volume (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! ice concentration - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(inout) :: & - aice , & ! concentration of ice - aice0 , & ! concentration of open water - fpond ! fresh water flux to ponds (kg/m^2/s) - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - ! character (char_len), intent(out) :: stop_label - character (len=*), intent(out) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - n, nd , & ! category indices - k ! ice layer index - - real (kind=dbl_kind) :: & - slope , & ! rate of change of dhice with hice - dh0 , & ! change in ice thickness at h = 0 - da0 , & ! area melting from category 1 - damax , & ! max allowed reduction in category 1 area - etamin, etamax,& ! left and right limits of integration - x1 , & ! etamax - etamin - x2 , & ! (etamax^2 - etamin^2) / 2 - x3 , & ! (etamax^3 - etamin^3) / 3 - wk1, wk2 ! temporary variables - - real (kind=dbl_kind), dimension(0:ncat) :: & - hbnew ! new boundary locations - - real (kind=dbl_kind), dimension(ncat) :: & - g0 , & ! constant coefficient in g(h) - g1 , & ! linear coefficient in g(h) - hL , & ! left end of range over which g(h) > 0 - hR ! right end of range over which g(h) > 0 - - real (kind=dbl_kind), dimension(ncat) :: & - hicen , & ! ice thickness for each cat (m) - hicen_init , & ! initial ice thickness for each cat (pre-thermo) - dhicen , & ! thickness change for remapping (m) - daice , & ! ice area transferred across boundary - dvice ! ice volume transferred across boundary - - real (kind=dbl_kind), dimension (ncat) :: & - eicen, & ! energy of melting for each ice layer (J/m^2) - esnon, & ! energy of melting for each snow layer (J/m^2) - vbrin, & ! ice volume defined by brine height (m) - sicen ! Bulk salt in h ice (ppt*m) - - real (kind=dbl_kind) :: & - vice_init, vice_final, & ! ice volume summed over categories - vsno_init, vsno_final, & ! snow volume summed over categories - eice_init, eice_final, & ! ice energy summed over categories - esno_init, esno_final, & ! snow energy summed over categories - sice_init, sice_final, & ! ice bulk salinity summed over categories - vbri_init, vbri_final ! briny ice volume summed over categories - - ! NOTE: Third index of donor, daice, dvice should be ncat-1, - ! except that compilers would have trouble when ncat = 1 - integer (kind=int_kind), dimension(ncat) :: & - donor ! donor category index - - logical (kind=log_kind) :: & - remap_flag ! remap ITD if remap_flag is true - - character (len=char_len) :: & - fieldid ! field identifier - - logical (kind=log_kind), parameter :: & - print_diags = .false. ! if true, prints when remap_flag=F - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - do n = 1, ncat - donor(n) = 0 - daice(n) = c0 - dvice(n) = c0 - enddo - - !----------------------------------------------------------------- - ! Compute volume and energy sums that linear remapping should - ! conserve. - !----------------------------------------------------------------- - - if (l_conservation_check) then - - do n = 1, ncat - - eicen(n) = c0 - esnon(n) = c0 - vbrin(n) = c0 - sicen(n) = c0 - - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - do k = 1, nslyr - esnon(n) = esnon(n) + trcrn(nt_qsno+k-1,n) & - * vsnon(n)/real(nslyr,kind=dbl_kind) - enddo - - if (tr_brine) then - vbrin(n) = vbrin(n) + trcrn(nt_fbri,n) & - * vicen(n) - endif - - do k = 1, nilyr - sicen(n) = sicen(n) + trcrn(nt_sice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - - enddo ! n - - call column_sum (ncat, vicen, vice_init) - call column_sum (ncat, vsnon, vsno_init) - call column_sum (ncat, eicen, eice_init) - call column_sum (ncat, esnon, esno_init) - call column_sum (ncat, sicen, sice_init) - call column_sum (ncat, vbrin, vbri_init) - - endif ! l_conservation_check - - !----------------------------------------------------------------- - ! Initialize remapping flag. - ! Remapping is done wherever remap_flag = .true. - ! In rare cases the category boundaries may shift too far for the - ! remapping algorithm to work, and remap_flag is set to .false. - ! In these cases the simpler 'rebin' subroutine will shift ice - ! between categories if needed. - !----------------------------------------------------------------- - - remap_flag = .true. - - !----------------------------------------------------------------- - ! Compute thickness change in each category. - !----------------------------------------------------------------- - - do n = 1, ncat - - if (aicen_init(n) > puny) then - hicen_init(n) = vicen_init(n) / aicen_init(n) - else - hicen_init(n) = c0 - endif ! aicen_init > puny - - if (aicen (n) > puny) then - hicen (n) = vicen(n) / aicen(n) - dhicen(n) = hicen(n) - hicen_init(n) - else - hicen (n) = c0 - dhicen(n) = c0 - endif ! aicen > puny - - enddo ! n - - !----------------------------------------------------------------- - ! Compute new category boundaries, hbnew, based on changes in - ! ice thickness from vertical thermodynamics. - !----------------------------------------------------------------- - - hbnew(0) = hin_max(0) - - do n = 1, ncat-1 - - if (hicen_init(n) > puny .and. & - hicen_init(n+1) > puny) then - ! interpolate between adjacent category growth rates - slope = (dhicen(n+1) - dhicen(n)) / & - (hicen_init(n+1) - hicen_init(n)) - hbnew(n) = hin_max(n) + dhicen(n) & - + slope * (hin_max(n) - hicen_init(n)) - elseif (hicen_init(n) > puny) then ! hicen_init(n+1)=0 - hbnew(n) = hin_max(n) + dhicen(n) - elseif (hicen_init(n+1) > puny) then ! hicen_init(n)=0 - hbnew(n) = hin_max(n) + dhicen(n+1) - else - hbnew(n) = hin_max(n) - endif - - !----------------------------------------------------------------- - ! Check that each boundary lies between adjacent values of hicen. - ! If not, set remap_flag = .false. - ! Write diagnosis outputs if remap_flag was changed to false - !----------------------------------------------------------------- - - if (aicen(n) > puny .and. hicen(n) >= hbnew(n)) then - remap_flag = .false. - - if (print_diags) then - write(warning,*) 'ITD: hicen(n) > hbnew(n)' - call add_warning(warning) - write(warning,*) 'cat ',n - call add_warning(warning) - write(warning,*) 'hicen(n) =', hicen(n) - call add_warning(warning) - write(warning,*) 'hbnew(n) =', hbnew(n) - call add_warning(warning) - endif - - elseif (aicen(n+1) > puny .and. hicen(n+1) <= hbnew(n)) then - remap_flag = .false. - - if (print_diags) then - write(warning,*) 'ITD: hicen(n+1) < hbnew(n)' - call add_warning(warning) - write(warning,*) 'cat ',n - call add_warning(warning) - write(warning,*) 'hicen(n+1) =', hicen(n+1) - call add_warning(warning) - write(warning,*) 'hbnew(n) =', hbnew(n) - call add_warning(warning) - endif - endif - - !----------------------------------------------------------------- - ! Check that hbnew(n) lies between hin_max(n-1) and hin_max(n+1). - ! If not, set remap_flag = .false. - ! (In principle we could allow this, but it would make the code - ! more complicated.) - ! Write diagnosis outputs if remap_flag was changed to false - !----------------------------------------------------------------- - - if (hbnew(n) > hin_max(n+1)) then - remap_flag = .false. - - if (print_diags) then - write(warning,*) 'ITD hbnew(n) > hin_max(n+1)' - call add_warning(warning) - write(warning,*) 'cat ',n - call add_warning(warning) - write(warning,*) 'hbnew(n) =', hbnew(n) - call add_warning(warning) - write(warning,*) 'hin_max(n+1) =', hin_max(n+1) - call add_warning(warning) - endif - endif - - if (hbnew(n) < hin_max(n-1)) then - remap_flag = .false. - - if (print_diags) then - write(warning,*) 'ITD: hbnew(n) < hin_max(n-1)' - call add_warning(warning) - write(warning,*) 'cat ',n - call add_warning(warning) - write(warning,*) 'hbnew(n) =', hbnew(n) - call add_warning(warning) - write(warning,*) 'hin_max(n-1) =', hin_max(n-1) - call add_warning(warning) - endif - endif - - enddo ! boundaries, 1 to ncat-1 - - !----------------------------------------------------------------- - ! Compute hbnew(ncat) - !----------------------------------------------------------------- - - if (aicen(ncat) > puny) then - hbnew(ncat) = c3*hicen(ncat) - c2*hbnew(ncat-1) - else - hbnew(ncat) = hin_max(ncat) - endif - hbnew(ncat) = max(hbnew(ncat),hin_max(ncat-1)) - - !----------------------------------------------------------------- - ! Identify cells where the ITD is to be remapped - !----------------------------------------------------------------- - - if (remap_flag) then - - !----------------------------------------------------------------- - ! Compute g(h) for category 1 at start of time step - ! (hicen = hicen_init) - !----------------------------------------------------------------- - - call fit_line(aicen(1), hicen_init(1), & - hbnew(0), hin_max (1), & - g0 (1), g1 (1), & - hL (1), hR (1)) - - !----------------------------------------------------------------- - ! Find area lost due to melting of thin (category 1) ice - !----------------------------------------------------------------- - - if (aicen(1) > puny) then - - dh0 = dhicen(1) - if (dh0 < c0) then ! remove area from category 1 - dh0 = min(-dh0,hin_max(1)) ! dh0 --> |dh0| - - !----------------------------------------------------------------- - ! Integrate g(1) from 0 to dh0 to estimate area melted - !----------------------------------------------------------------- - - ! right integration limit (left limit = 0) - etamax = min(dh0,hR(1)) - hL(1) - - if (etamax > c0) then - x1 = etamax - x2 = p5 * etamax*etamax - da0 = g1(1)*x2 + g0(1)*x1 ! ice area removed - - ! constrain new thickness <= hicen_init - damax = aicen(1) * (c1-hicen(1)/hicen_init(1)) ! damax > 0 - da0 = min (da0, damax) - - ! remove area, conserving volume - hicen(1) = hicen(1) * aicen(1) / (aicen(1)-da0) - aicen(1) = aicen(1) - da0 - - if (tr_pond_topo) & - fpond = fpond - (da0 * trcrn(nt_apnd,1) & - * trcrn(nt_hpnd,1)) - - endif ! etamax > 0 - - else ! dh0 >= 0 - hbnew(0) = min(dh0,hin_max(1)) ! shift hbnew(0) to right - endif - - endif ! aicen(1) > puny - - !----------------------------------------------------------------- - ! Compute g(h) for each ice thickness category. - !----------------------------------------------------------------- - - do n = 1, ncat - - call fit_line(aicen(n), hicen(n), & - hbnew(n-1), hbnew(n), & - g0 (n), g1 (n), & - hL (n), hR (n)) - - !----------------------------------------------------------------- - ! Compute area and volume to be shifted across each boundary. - !----------------------------------------------------------------- - - donor(n) = 0 - daice(n) = c0 - dvice(n) = c0 - enddo - - do n = 1, ncat-1 - - if (hbnew(n) > hin_max(n)) then ! transfer from n to n+1 - - ! left and right integration limits in eta space - etamin = max(hin_max(n), hL(n)) - hL(n) - etamax = min(hbnew(n), hR(n)) - hL(n) - donor(n) = n - - else ! hbnew(n) <= hin_max(n); transfer from n+1 to n - - ! left and right integration limits in eta space - etamin = c0 - etamax = min(hin_max(n), hR(n+1)) - hL(n+1) - donor(n) = n+1 - - endif ! hbnew(n) > hin_max(n) - - if (etamax > etamin) then - x1 = etamax - etamin - wk1 = etamin*etamin - wk2 = etamax*etamax - x2 = p5 * (wk2 - wk1) - wk1 = wk1*etamin - wk2 = wk2*etamax - x3 = p333 * (wk2 - wk1) - nd = donor(n) - daice(n) = g1(nd)*x2 + g0(nd)*x1 - dvice(n) = g1(nd)*x3 + g0(nd)*x2 + daice(n)*hL(nd) - endif ! etamax > etamin - - ! If daice or dvice is very small, shift no ice. - - nd = donor(n) - - if (daice(n) < aicen(nd)*puny) then - daice(n) = c0 - dvice(n) = c0 - donor(n) = 0 - endif - - if (dvice(n) < vicen(nd)*puny) then - daice(n) = c0 - dvice(n) = c0 - donor(n) = 0 - endif - - ! If daice is close to aicen or dvice is close to vicen, - ! shift entire category - - if (daice(n) > aicen(nd)*(c1-puny)) then - daice(n) = aicen(nd) - dvice(n) = vicen(nd) - endif - - if (dvice(n) > vicen(nd)*(c1-puny)) then - daice(n) = aicen(nd) - dvice(n) = vicen(nd) - endif - - enddo ! boundaries, 1 to ncat-1 - - !----------------------------------------------------------------- - ! Shift ice between categories as necessary - !----------------------------------------------------------------- - - ! maintain qsno negative definiteness - do n = 1, ncat - do k = nt_qsno, nt_qsno+nslyr-1 - trcrn(k,n) = trcrn(k,n) + rhos*Lfresh - enddo - enddo - ! maintain rhos_cmp positive definiteness - if (tr_snow) then - do n = 1, ncat - do k = nt_rhos, nt_rhos+nslyr-1 - trcrn(k,n) = max(trcrn(k,n)-rhosmin, c0) -! trcrn(k,n) = trcrn(k,n) - rhosmin - enddo - enddo - endif - - call shift_ice (ntrcr, ncat, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, Tf, & - aicen, trcrn, & - vicen, vsnon, & - hicen, donor, & - daice, dvice, & - l_stop, stop_label) - if (l_stop) return - - ! maintain qsno negative definiteness - do n = 1, ncat - do k = nt_qsno, nt_qsno+nslyr-1 - trcrn(k,n) = trcrn(k,n) - rhos*Lfresh - enddo - enddo - ! maintain rhos_cmp positive definiteness - if (tr_snow) then - do n = 1, ncat - do k = nt_rhos, nt_rhos+nslyr-1 - trcrn(k,n) = trcrn(k,n) + rhosmin - enddo - enddo - endif - - !----------------------------------------------------------------- - ! Make sure hice(1) >= minimum ice thickness hi_min. - !----------------------------------------------------------------- - - if (hi_min > c0 .and. aicen(1) > puny .and. hicen(1) < hi_min) then - - da0 = aicen(1) * (c1 - hicen(1)/hi_min) - aicen(1) = aicen(1) - da0 - hicen(1) = hi_min - - if (tr_pond_topo) & - fpond = fpond - (da0 * trcrn(nt_apnd,1) & - * trcrn(nt_hpnd,1)) - endif - - endif ! remap_flag - - !----------------------------------------------------------------- - ! Update fractional ice area in each grid cell. - !----------------------------------------------------------------- - - call aggregate_area (ncat, aicen, aice, aice0) - - !----------------------------------------------------------------- - ! Check volume and energy conservation. - !----------------------------------------------------------------- - - if (l_conservation_check) then - - do n = 1, ncat - - eicen(n) = c0 - esnon(n) = c0 - vbrin(n) = c0 - sicen(n) = c0 - - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - do k = 1, nslyr - esnon(n) = esnon(n) + trcrn(nt_qsno+k-1,n) & - * vsnon(n)/real(nslyr,kind=dbl_kind) - enddo - - if (tr_brine) then - vbrin(n) = vbrin(n) + trcrn(nt_fbri,n) & - * vicen(n) - endif - - do k = 1, nilyr - sicen(n) = sicen(n) + trcrn(nt_sice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - - enddo ! n - - call column_sum (ncat, vicen, vice_final) - call column_sum (ncat, vsnon, vsno_final) - call column_sum (ncat, eicen, eice_final) - call column_sum (ncat, esnon, esno_final) - call column_sum (ncat, sicen, sice_final) - call column_sum (ncat, vbrin, vbri_final) - - fieldid = 'vice, ITD remap' - call column_conservation_check (fieldid, & - vice_init, vice_final, & - puny, & - l_stop) - fieldid = 'vsno, ITD remap' - call column_conservation_check (fieldid, & - vsno_init, vsno_final, & - puny, & - l_stop) - fieldid = 'eice, ITD remap' - call column_conservation_check (fieldid, & - eice_init, eice_final, & - puny*Lfresh*rhoi, & - l_stop) - fieldid = 'esno, ITD remap' - call column_conservation_check (fieldid, & - esno_init, esno_final, & - puny*Lfresh*rhos, & - l_stop) - fieldid = 'sicen, ITD remap' - call column_conservation_check (fieldid, & - sice_init, sice_final, & - puny, & - l_stop) - fieldid = 'vbrin, ITD remap' - call column_conservation_check (fieldid, & - vbri_init, vbri_final, & - puny*c10, & - l_stop) - if (l_stop) then - stop_label = 'linear_itd: Column conservation error' - return - endif - - endif ! conservation check - - end subroutine linear_itd - -!======================================================================= -! -! Fit g(h) with a line, satisfying area and volume constraints. -! To reduce roundoff errors caused by large values of g0 and g1, -! we actually compute g(eta), where eta = h - hL, and hL is the -! left boundary. -! -! authors: William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine fit_line (aicen, hice, & - hbL, hbR, & - g0, g1, & - hL, hR) - - real (kind=dbl_kind), intent(in) :: & - aicen ! concentration of ice - - real (kind=dbl_kind), intent(in) :: & - hbL, hbR , & ! left and right category boundaries - hice ! ice thickness - - real (kind=dbl_kind), intent(out):: & - g0, g1 , & ! coefficients in linear equation for g(eta) - hL , & ! min value of range over which g(h) > 0 - hR ! max value of range over which g(h) > 0 - - ! local variables - - real (kind=dbl_kind) :: & - h13 , & ! hbL + 1/3 * (hbR - hbL) - h23 , & ! hbL + 2/3 * (hbR - hbL) - dhr , & ! 1 / (hR - hL) - wk1, wk2 ! temporary variables - - !----------------------------------------------------------------- - ! Compute g0, g1, hL, and hR for each category to be remapped. - !----------------------------------------------------------------- - - if (aicen > puny .and. hbR - hbL > puny) then - - ! Initialize hL and hR - - hL = hbL - hR = hbR - - ! Change hL or hR if hicen(n) falls outside central third of range - - h13 = p333 * (c2*hL + hR) - h23 = p333 * (hL + c2*hR) - if (hice < h13) then - hR = c3*hice - c2*hL - elseif (hice > h23) then - hL = c3*hice - c2*hR - endif - - ! Compute coefficients of g(eta) = g0 + g1*eta - - dhr = c1 / (hR - hL) - wk1 = c6 * aicen * dhr - wk2 = (hice - hL) * dhr - g0 = wk1 * (p666 - wk2) - g1 = c2*dhr * wk1 * (wk2 - p5) - - else - - g0 = c0 - g1 = c0 - hL = c0 - hR = c0 - - endif ! aicen > puny - - end subroutine fit_line - -!======================================================================= -! -! Given some added new ice to the base of the existing ice, recalculate -! vertical tracer so that new grid cells are all the same size. -! -! author: A. K. Turner, LANL -! - subroutine update_vertical_tracers(nilyr, trc, h1, h2, trc0) - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - trc ! vertical tracer - - real (kind=dbl_kind), intent(in) :: & - h1, & ! old thickness - h2, & ! new thickness - trc0 ! tracer value of added ice on ice bottom - - ! local variables - - real(kind=dbl_kind), dimension(nilyr) :: trc2 ! updated tracer temporary - - ! vertical indices for old and new grid - integer :: k1, k2 - - real (kind=dbl_kind) :: & - z1a, z1b, & ! upper, lower boundary of old cell/added new ice at bottom - z2a, z2b, & ! upper, lower boundary of new cell - overlap , & ! overlap between old and new cell - rnilyr - - rnilyr = real(nilyr,dbl_kind) - - ! loop over new grid cells - do k2 = 1, nilyr - - ! initialize new tracer - trc2(k2) = c0 - - ! calculate upper and lower boundary of new cell - z2a = ((k2 - 1) * h2) / rnilyr - z2b = (k2 * h2) / rnilyr - - ! loop over old grid cells - do k1 = 1, nilyr - - ! calculate upper and lower boundary of old cell - z1a = ((k1 - 1) * h1) / rnilyr - z1b = (k1 * h1) / rnilyr - - ! calculate overlap between old and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - - ! aggregate old grid cell contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc(k1) - - enddo ! k1 - - ! calculate upper and lower boundary of added new ice at bottom - z1a = h1 - z1b = h2 - - ! calculate overlap between added ice and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - ! aggregate added ice contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc0 - ! renormalize new grid cell - trc2(k2) = (rnilyr * trc2(k2)) / h2 - - enddo ! k2 - - ! update vertical tracer array with the adjusted tracer - trc = trc2 - - end subroutine update_vertical_tracers - -!======================================================================= -! -! Given the fraction of ice melting laterally in each grid cell -! (computed in subroutine frzmlt_bottom_lateral), melt ice. -! -! author: C. M. Bitz, UW -! 2003: Modified by William H. Lipscomb and Elizabeth C. Hunke, LANL -! - subroutine lateral_melt (dt, ncat, & - nilyr, nslyr, & - n_aero, fpond, & - fresh, fsalt, & - fhocn, faero_ocn, & - rside, meltl, & - aicen, vicen, & - vsnon, trcrn, & - fzsal, flux_bio, & - nbtrcr, nblyr) - - use ice_colpkg_tracers, only: nt_qice, nt_qsno, nt_aero, tr_aero, & - tr_pond_topo, nt_apnd, nt_hpnd, bio_index - use ice_colpkg_shared, only: z_tracers , hs_ssl, solve_zsal - use ice_zbgc, only: lateral_melt_bgc - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nblyr , & ! number of bio layers - nslyr , & ! number of snow layers - n_aero , & ! number of aerosol tracers - nbtrcr ! number of bio tracers - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcrn ! tracer array - - real (kind=dbl_kind), intent(in) :: & - rside ! fraction of ice that melts laterally - - real (kind=dbl_kind), intent(inout) :: & - fpond , & ! fresh water flux to ponds (kg/m^2/s) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fsalt , & ! salt flux to ocean (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - meltl , & ! lateral ice melt (m/step-->cm/day) - fzsal ! salt flux from zsalinity (kg/m2/s) - - real (kind=dbl_kind), dimension(nbtrcr), & - intent(inout) :: & - flux_bio ! biology tracer flux from layer bgc (mmol/m^2/s) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - faero_ocn ! aerosol flux to ocean (kg/m^2/s) - - ! local variables - - integer (kind=int_kind) :: & - n , & ! thickness category index - k ! layer index - - real (kind=dbl_kind) :: & - dfhocn , & ! change in fhocn - dfpond , & ! change in fpond - dfresh , & ! change in fresh - dfsalt , & ! change in fsalt - dvssl , & ! snow surface layer volume - dvint ! snow interior layer - - real (kind=dbl_kind), dimension (ncat) :: & - vicen_init, & ! initial volume per unit area of ice (m) - aicen_init, & ! initial area - vsnon_init ! initial volume of snow (m) - - if (rside > c0) then ! grid cells with lateral melting. - - do n = 1, ncat - - !----------------------------------------------------------------- - ! Melt the ice and increment fluxes. - !----------------------------------------------------------------- - - ! fluxes to coupler - ! dfresh > 0, dfsalt > 0, dfpond > 0 - - dfresh = (rhos*vsnon(n) + rhoi*vicen(n)) * rside / dt - dfsalt = rhoi*vicen(n)*ice_ref_salinity*p001 * rside / dt - fresh = fresh + dfresh - fsalt = fsalt + dfsalt - - if (tr_pond_topo) then - dfpond = aicen(n) & - * trcrn(nt_apnd,n) & - * trcrn(nt_hpnd,n) & - * rside - fpond = fpond - dfpond - endif - - ! history diagnostics - meltl = meltl + vicen(n)*rside - - ! state variables - vicen_init(n) = vicen(n) - aicen_init(n) = aicen(n) - vsnon_init(n) = vsnon(n) - aicen(n) = aicen(n) * (c1 - rside) - vicen(n) = vicen(n) * (c1 - rside) - vsnon(n) = vsnon(n) * (c1 - rside) - - do k = 1, nilyr - ! enthalpy tracers do not change (e/v constant) - ! heat flux to coupler for ice melt (dfhocn < 0) - dfhocn = trcrn(nt_qice+k-1,n)*rside / dt & - * vicen(n)/real(nilyr,kind=dbl_kind) - fhocn = fhocn + dfhocn - enddo ! nilyr - - do k = 1, nslyr - ! heat flux to coupler for snow melt (dfhocn < 0) - dfhocn = trcrn(nt_qsno+k-1,n)*rside / dt & - * vsnon(n)/real(nslyr,kind=dbl_kind) - fhocn = fhocn + dfhocn - enddo ! nslyr - - if (tr_aero) then - do k = 1, n_aero - faero_ocn(k) = faero_ocn(k) + (vsnon(n) & - *(trcrn(nt_aero +4*(k-1),n) & - + trcrn(nt_aero+1+4*(k-1),n)) & - + vicen(n) & - *(trcrn(nt_aero+2+4*(k-1),n) & - + trcrn(nt_aero+3+4*(k-1),n))) & - * rside / dt - enddo ! k - endif ! tr_aero - - !----------------------------------------------------------------- - ! Biogeochemistry - !----------------------------------------------------------------- - - if (z_tracers) then ! snow tracers - dvssl = min(p5*vsnon_init(n)/real(nslyr,kind=dbl_kind), hs_ssl*aicen_init(n)) !snow surface layer - dvint = vsnon_init(n)- dvssl !snow interior - do k = 1, nbtrcr - flux_bio(k) = flux_bio(k) & - + (trcrn(bio_index(k)+nblyr+1,n)*dvssl & - + trcrn(bio_index(k)+nblyr+2,n)*dvint) & - * rside / dt - enddo - endif - - enddo ! n - - if (solve_zsal .or. z_tracers) & - call lateral_melt_bgc(dt, & - ncat, nblyr, & - rside, vicen, & - trcrn, fzsal, & - flux_bio, nbtrcr, & - vicen_init) - - endif ! rside - - end subroutine lateral_melt - -!======================================================================= -! -! Given the volume of new ice grown in open water, compute its area -! and thickness and add it to the appropriate category or categories. -! -! NOTE: Usually all the new ice is added to category 1. An exception is -! made if there is no open water or if the new ice is too thick -! for category 1, in which case ice is distributed evenly over the -! entire cell. Subroutine rebin should be called in case the ice -! thickness lies outside category bounds after new ice formation. -! -! When ice must be added to categories above category 1, the mushy -! formulation (ktherm=2) adds it only to the bottom of the ice. When -! added to only category 1, all formulations combine the new ice and -! existing ice tracers as bulk quantities. -! -! authors William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL -! Adrian Turner, LANL -! - subroutine add_new_ice (ncat, nilyr, nblyr, & - n_aero, dt, & - ntrcr, nbtrcr, & - hin_max, ktherm, & - aicen, trcrn, & - vicen, vsnon1, & - aice0, aice, & - frzmlt, frazil, & - frz_onset, yday, & - update_ocn_f, & - fresh, fsalt, & - Tf, sss, & - salinz, phi_init, & - dSin0_frazil, & - bgrid, cgrid, & - igrid, flux_bio, & - ocean_bio, fzsal, & - frazil_diag, & - l_stop, stop_label) - - use ice_itd, only: column_sum, & - column_conservation_check - use ice_colpkg_tracers, only: nt_Tsfc, nt_iage, nt_FY, nt_sice, nt_qice, & - nt_alvl, nt_vlvl, nt_aero, nt_apnd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_brine - use ice_colpkg_shared, only: solve_zsal, skl_bgc, initbio_frac, salt_loss, rhosi - use ice_mushy_physics, only: liquidus_temperature_mush, enthalpy_mush - use ice_therm_shared, only: hfrazilmin - use ice_zbgc, only: add_new_ice_bgc - use ice_zbgc_shared, only: bgc_tracer_type - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nblyr , & ! number of bio layers - ntrcr , & ! number of tracers - nbtrcr, & ! number of bio tracer types - n_aero, & ! number of aerosol tracers - ktherm ! type of thermodynamics (0 0-layer, 1 BL99, 2 mushy) - - real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & - hin_max ! category boundaries (m) - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - aice , & ! total concentration of ice - frzmlt, & ! freezing/melting potential (W/m^2) - Tf , & ! freezing temperature (C) - sss , & ! sea surface salinity (ppt) - vsnon1 ! category 1 snow volume per ice area (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen ! volume per unit area of ice (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - ! 1: surface temperature - - real (kind=dbl_kind), intent(inout) :: & - aice0 , & ! concentration of open water - frazil , & ! frazil ice growth (m/step-->cm/day) - frazil_diag,& ! frazil ice growth diagnostic (m/step-->cm/day) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - fsalt ! salt flux to ocean (kg/m^2/s) - - real (kind=dbl_kind), intent(inout), optional :: & - frz_onset ! day of year that freezing begins (congel or frazil) - - real (kind=dbl_kind), intent(in), optional :: & - yday ! day of year - - real (kind=dbl_kind), dimension(:), intent(in) :: & - salinz ! initial salinity profile - - real (kind=dbl_kind), intent(in) :: & - phi_init , & ! initial frazil liquid fraction - dSin0_frazil ! initial frazil bulk salinity reduction from sss - - logical (kind=log_kind), intent(in) :: & - update_ocn_f ! if true, update fresh water and salt fluxes - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, abort on return - - ! character (char_len), intent(out) :: stop_label - character (len=*), intent(out) :: stop_label - - ! BGC - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - flux_bio ! tracer flux to ocean from biology (mmol/m^2/s) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - ocean_bio ! ocean concentration of biological tracer - - ! zsalinity - real (kind=dbl_kind), intent(inout) :: & - fzsal ! salt flux to ocean from zsalinity (kg/m^2/s) - - ! local variables - - integer (kind=int_kind) :: & - i, j , & ! horizontal indices - n , & ! ice category index - k , & ! ice layer index - it ! aerosol tracer index - - real (kind=dbl_kind) :: & - ai0new , & ! area of new ice added to cat 1 - vi0new , & ! volume of new ice added to cat 1 - hsurp , & ! thickness of new ice added to each cat - fnew , & ! heat flx to open water for new ice (W/m^2) - hi0new , & ! thickness of new ice - hi0max , & ! max allowed thickness of new ice - vsurp , & ! volume of new ice added to each cat - vtmp , & ! total volume of new and old ice - area1 , & ! starting fractional area of existing ice - alvl , & ! starting level ice area - rnilyr , & ! real(nilyr) - dfresh , & ! change in fresh - dfsalt , & ! change in fsalt - vi0tmp , & ! frzmlt part of frazil - Ti , & ! frazil temperature - qi0new , & ! frazil ice enthalpy - Si0new , & ! frazil ice bulk salinity - vi0_init , & ! volume of new ice - vice1 , & ! starting volume of existing ice - vice_init, vice_final, & ! ice volume summed over categories - eice_init, eice_final ! ice energy summed over categories - - real (kind=dbl_kind), dimension (nilyr) :: & - Sprofile ! salinity profile used for new ice additions - - character (len=char_len) :: & - fieldid ! field identifier - - real (kind=dbl_kind), dimension (ncat) :: & - eicen, & ! energy of melting for each ice layer (J/m^2) - aicen_init, & ! fractional area of ice - vicen_init ! volume per unit area of ice (m) - - ! BGC - real (kind=dbl_kind) :: & - vbri1 , & ! starting volume of existing brine - vbri_init , & ! brine volume summed over categories - vbri_final ! brine volume summed over categories - - real (kind=dbl_kind), dimension (ncat) :: & - vbrin ! trcrn(nt_fbri,n)*vicen(n) - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! initialize - !----------------------------------------------------------------- - - l_stop = .false. - - rnilyr = real(nilyr,kind=dbl_kind) - - if (ncat > 1) then - hi0max = hin_max(1)*0.9_dbl_kind ! not too close to boundary - else - hi0max = bignum ! big number - endif - - do n = 1, ncat - aicen_init(n) = aicen(n) - vicen_init(n) = vicen(n) - eicen(n) = c0 - enddo - - if (l_conservation_check) then - - do n = 1, ncat - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - enddo - call column_sum (ncat, vicen, vice_init) - call column_sum (ncat, eicen, eice_init) - - endif ! l_conservation_check - - !----------------------------------------------------------------- - ! Compute average enthalpy of new ice. - ! Sprofile is the salinity profile used when adding new ice to - ! all categories, for ktherm/=2, and to category 1 for all ktherm. - ! - ! NOTE: POP assumes new ice is fresh! - !----------------------------------------------------------------- - - if (ktherm == 2) then ! mushy - if (sss > c2 * dSin0_frazil) then - Si0new = sss - dSin0_frazil - else - Si0new = sss**2 / (c4*dSin0_frazil) - endif - do k = 1, nilyr - Sprofile(k) = Si0new - enddo - Ti = liquidus_temperature_mush(Si0new/phi_init) -!echmod - icepack limits Ti <= Tliquidus_max -!echmod - Tliquidus_max = 0. by default, can be changed when initializing icepack (namelist) -!echmod - BFB in 3-month D cases and 1-year standalone MPAS-SI tests -! Ti = min(liquidus_temperature_mush(Si0new/phi_init), Tliquidus_max) !echmod - as in icepack - qi0new = enthalpy_mush(Ti, Si0new) - else - do k = 1, nilyr - Sprofile(k) = salinz(k) - enddo - qi0new = -rhoi*Lfresh - endif ! ktherm - - !----------------------------------------------------------------- - ! Compute the volume, area, and thickness of new ice. - !----------------------------------------------------------------- - - fnew = max (frzmlt, c0) ! fnew > 0 iff frzmlt > 0 - vi0new = -fnew*dt / qi0new ! note sign convention, qi < 0 - vi0_init = vi0new ! for bgc - - ! increment ice volume and energy - if (l_conservation_check) then - vice_init = vice_init + vi0new - eice_init = eice_init + vi0new*qi0new - endif - - ! history diagnostics - frazil = vi0new - if (solve_zsal) & - fzsal = fzsal & - - rhosi*vi0new/dt*p001*sss*salt_loss - - if (present(frz_onset) .and. present(yday)) then - if (frazil > puny .and. frz_onset < puny) frz_onset = yday - endif - - !----------------------------------------------------------------- - ! Update fresh water and salt fluxes. - ! - ! NOTE: POP assumes fresh water and salt flux due to frzmlt > 0 - ! is NOT included in fluxes fresh and fsalt. - !----------------------------------------------------------------- - - if (update_ocn_f) then - if (ktherm <= 1) then - dfresh = -rhoi*vi0new/dt - dfsalt = ice_ref_salinity*p001*dfresh - fresh = fresh + dfresh - fsalt = fsalt + dfsalt - ! elseif (ktherm == 2) the fluxes are added elsewhere - endif - else ! update_ocn_f = false - if (ktherm == 2) then ! return mushy-layer frazil to ocean (POP) - vi0tmp = fnew*dt / (rhoi*Lfresh) - dfresh = -rhoi*(vi0new - vi0tmp)/dt - dfsalt = ice_ref_salinity*p001*dfresh - fresh = fresh + dfresh - fsalt = fsalt + dfsalt - frazil_diag = frazil - vi0tmp - ! elseif ktherm==1 do nothing - endif - endif - - !----------------------------------------------------------------- - ! Decide how to distribute the new ice. - !----------------------------------------------------------------- - - hsurp = c0 - ai0new = c0 - - if (vi0new > c0) then - - ! new ice area and thickness - ! hin_max(0) < new ice thickness < hin_max(1) - if (aice0 > puny) then - hi0new = max(vi0new/aice0, hfrazilmin) - if (hi0new > hi0max .and. aice0+puny < c1) then - ! distribute excess volume over all categories (below) - hi0new = hi0max - ai0new = aice0 - vsurp = vi0new - ai0new*hi0new - hsurp = vsurp / aice - vi0new = ai0new*hi0new - else - ! put ice in a single category, with hsurp = 0 - ai0new = vi0new/hi0new - endif - else ! aice0 < puny - hsurp = vi0new/aice ! new thickness in each cat - vi0new = c0 - endif ! aice0 > puny - endif ! vi0new > puny - - !----------------------------------------------------------------- - ! Distribute excess ice volume among ice categories by increasing - ! ice thickness, leaving ice area unchanged. - ! - ! NOTE: If new ice contains globally conserved tracers - ! (e.g., isotopes from seawater), code must be added here. - ! - ! The mushy formulation (ktherm=2) puts the new ice only at the - ! bottom of existing ice and adjusts the layers accordingly. - ! The other formulations distribute the new ice throughout the - ! existing ice column. - !----------------------------------------------------------------- - - if (hsurp > c0) then ! add ice to all categories - - do n = 1, ncat - - vsurp = hsurp * aicen(n) - - ! update ice age due to freezing (new ice age = dt) - vtmp = vicen(n) + vsurp - if (tr_iage .and. vtmp > puny) & - trcrn(nt_iage,n) = & - (trcrn(nt_iage,n)*vicen(n) + dt*vsurp) / vtmp - - if (tr_lvl .and. vicen(n) > puny) then - trcrn(nt_vlvl,n) = & - (trcrn(nt_vlvl,n)*vicen(n) + & - trcrn(nt_alvl,n)*vsurp) / vtmp - endif - - if (tr_aero .and. vtmp > puny) then - do it = 1, n_aero - trcrn(nt_aero+2+4*(it-1),n) = & - trcrn(nt_aero+2+4*(it-1),n)*vicen(n) / vtmp - trcrn(nt_aero+3+4*(it-1),n) = & - trcrn(nt_aero+3+4*(it-1),n)*vicen(n) / vtmp - enddo - endif - - ! update category volumes - vicen(n) = vtmp - - if (ktherm == 2) then - vsurp = hsurp * aicen(n) ! note - save this above? - vtmp = vicen(n) - vsurp ! vicen is the new volume - if (vicen(n) > c0) then - call update_vertical_tracers(nilyr, & - trcrn(nt_qice:nt_qice+nilyr-1,n), & - vtmp, vicen(n), qi0new) - call update_vertical_tracers(nilyr, & - trcrn(nt_sice:nt_sice+nilyr-1,n), & - vtmp, vicen(n), Si0new) - endif - else - do k = 1, nilyr - ! factor of nilyr cancels out - vsurp = hsurp * aicen(n) ! note - save this above? - vtmp = vicen(n) - vsurp ! vicen is the new volume - if (vicen(n) > c0) then - ! enthalpy - trcrn(nt_qice+k-1,n) = & - (trcrn(nt_qice+k-1,n)*vtmp + qi0new*vsurp) / vicen(n) - ! salinity - if (.not. solve_zsal) & - trcrn(nt_sice+k-1,n) = & - (trcrn(nt_sice+k-1,n)*vtmp + Sprofile(k)*vsurp) / vicen(n) - endif - enddo ! k - endif ! ktherm - - enddo ! n - - endif ! hsurp > 0 - - !----------------------------------------------------------------- - ! Combine new ice grown in open water with category 1 ice. - ! Assume that vsnon and esnon are unchanged. - ! The mushy formulation assumes salt from frazil is added uniformly - ! to category 1, while the others use a salinity profile. - !----------------------------------------------------------------- - - if (vi0new > c0) then ! add ice to category 1 - - area1 = aicen(1) ! save - vice1 = vicen(1) ! save - aicen(1) = aicen(1) + ai0new - aice0 = aice0 - ai0new - vicen(1) = vicen(1) + vi0new - - trcrn(nt_Tsfc,1) = & - (trcrn(nt_Tsfc,1)*area1 + Tf*ai0new)/aicen(1) - trcrn(nt_Tsfc,1) = min (trcrn(nt_Tsfc,1), c0) - - if (tr_FY) then - trcrn(nt_FY,1) = & - (trcrn(nt_FY,1)*area1 + ai0new)/aicen(1) - trcrn(nt_FY,1) = min(trcrn(nt_FY,1), c1) - endif - - if (vicen(1) > puny) then - if (tr_iage) & - trcrn(nt_iage,1) = & - (trcrn(nt_iage,1)*vice1 + dt*vi0new)/vicen(1) - - if (tr_aero) then - do it = 1, n_aero - trcrn(nt_aero+2+4*(it-1),1) = & - trcrn(nt_aero+2+4*(it-1),1)*vice1/vicen(1) - trcrn(nt_aero+3+4*(it-1),1) = & - trcrn(nt_aero+3+4*(it-1),1)*vice1/vicen(1) - enddo - endif - - if (tr_lvl) then - alvl = trcrn(nt_alvl,1) - trcrn(nt_alvl,1) = & - (trcrn(nt_alvl,1)*area1 + ai0new)/aicen(1) - trcrn(nt_vlvl,1) = & - (trcrn(nt_vlvl,1)*vice1 + vi0new)/vicen(1) - endif - - if (tr_pond_cesm .or. tr_pond_topo) then - trcrn(nt_apnd,1) = & - trcrn(nt_apnd,1)*area1/aicen(1) - elseif (tr_pond_lvl) then - if (trcrn(nt_alvl,1) > puny) then - trcrn(nt_apnd,1) = & - trcrn(nt_apnd,1) * alvl*area1 / (trcrn(nt_alvl,1)*aicen(1)) - endif - endif - endif - - do k = 1, nilyr - - if (vicen(1) > c0) then - ! factor of nilyr cancels out - ! enthalpy - trcrn(nt_qice+k-1,1) = & - (trcrn(nt_qice+k-1,1)*vice1 + qi0new*vi0new)/vicen(1) - ! salinity - if (.NOT. solve_zsal)& - trcrn(nt_sice+k-1,1) = & - (trcrn(nt_sice+k-1,1)*vice1 + Sprofile(k)*vi0new)/vicen(1) - endif - enddo - - endif ! vi0new > 0 - - if (l_conservation_check) then - - do n = 1, ncat - eicen(n) = c0 - do k = 1, nilyr - eicen(n) = eicen(n) + trcrn(nt_qice+k-1,n) & - * vicen(n)/real(nilyr,kind=dbl_kind) - enddo - enddo - call column_sum (ncat, vicen, vice_final) - call column_sum (ncat, eicen, eice_final) - - fieldid = 'vice, add_new_ice' - call column_conservation_check (fieldid, & - vice_init, vice_final, & - puny, & - l_stop) - fieldid = 'eice, add_new_ice' - call column_conservation_check (fieldid, & - eice_init, eice_final, & - puny*Lfresh*rhoi, & - l_stop) - if (l_stop) then - stop_label = 'add_new_ice: Column conservation error' - return - endif - - endif ! l_conservation_check - - !----------------------------------------------------------------- - ! Biogeochemistry - !----------------------------------------------------------------- - if (tr_brine .or. nbtrcr > 0) & - call add_new_ice_bgc(dt, nblyr, & - ncat, nilyr, nbtrcr, & - bgrid, cgrid, igrid, & - aicen_init, vicen_init, vi0_init, & - aicen, vicen, vsnon1, & - vi0new, ntrcr, trcrn, & - sss, ocean_bio, & - flux_bio, hsurp, & - l_stop, stop_label, & - l_conservation_check) - - end subroutine add_new_ice - -!======================================================================= - - end module ice_therm_itd - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_therm_mushy.F90 b/components/mpas-seaice/src/column/ice_therm_mushy.F90 deleted file mode 100644 index ee3046551467..000000000000 --- a/components/mpas-seaice/src/column/ice_therm_mushy.F90 +++ /dev/null @@ -1,3709 +0,0 @@ -! SVN:$Id: ice_therm_mushy.F90 1196 2017-04-18 13:32:23Z eclare $ -!======================================================================= - -module ice_therm_mushy - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c2, c4, c8, c10, c1000, & - p001, p01, p05, p1, p2, p5, pi, bignum, puny, ice_ref_salinity, & - viscosity_dyn, rhow, rhoi, rhos, cp_ocn, cp_ice, Lfresh, gravit, & - hs_min - use ice_colpkg_shared, only: a_rapid_mode, Rac_rapid_mode, ksno, & - aspect_rapid_mode, dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy - - use ice_therm_shared, only: ferrmax - use ice_warnings, only: add_warning - - implicit none - - private - public :: & - temperature_changes_salinity, & - permeability, & - update_vertical_tracers_snow - - real(kind=dbl_kind), parameter :: & - dTemp_errmax = 5.0e-4_dbl_kind ! max allowed change in temperature - ! between iterations - -!======================================================================= - -contains - -!======================================================================= - - subroutine temperature_changes_salinity(dt, & - nilyr, nslyr, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fswsfc, fswint, & - Sswabs, Iswabs, & - hilyr, hslyr, & - apond, hpond, & - zqin, zTin, & - zqsn, zTsn, & - zSin, & - Tsf, Tbot, & - sss, & - fsensn, flatn, & - flwoutn, fsurfn, & - fcondtop, fcondbot, & - fadvheat, snoice, & - einit_old, & - smice, smliq, & - tr_snow, & - lstop, stop_label) - - ! solve the enthalpy and bulk salinity of the ice for a single column - - use ice_mushy_physics, only: & - enthalpy_brine, & - temperature_mush, & - liquid_fraction, & - temperature_snow, & - temperature_mush_liquid_fraction, & - liquidus_brine_salinity_mush, & - conductivity_mush_array, & - conductivity_snow_array - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), intent(in) :: & - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - Tbot , & ! ice bottom surfce temperature (deg C) - sss ! sea surface salinity (PSU) - - real (kind=dbl_kind), intent(inout) :: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - fswint ! SW absorbed in ice interior below surface (W m-2) - - real (kind=dbl_kind), intent(inout) :: & - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - apond , & ! melt pond area fraction - hpond ! melt pond depth (m) - - real (kind=dbl_kind), intent(in) :: & - einit_old ! initial energy of melting (J m-2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - Sswabs , & ! SW radiation absorbed in snow layers (W m-2) - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - smice , & ! ice mass tracer in snow (kg/m^3) - smliq ! liquid water mass tracer in snow (kg/m^3) - - real (kind=dbl_kind), intent(inout):: & - fsurfn , & ! net flux to top surface, excluding fcondtopn - fcondtop , & ! downward cond flux at top surface (W m-2) - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - flwoutn ! upward LW at surface (W m-2) - - real (kind=dbl_kind), intent(out):: & - fcondbot , & ! downward cond flux at bottom surface (W m-2) - fadvheat , & ! flow of heat to ocean due to advection (W m-2) - snoice ! snow ice formation - - real (kind=dbl_kind), intent(inout):: & - Tsf ! ice/snow surface temperature (C) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zTin , & ! internal ice layer temperatures - zSin , & ! internal ice layer salinities - zqsn , & ! snow layer enthalpy (J m-3) - zTsn ! internal snow layer temperatures - - logical (kind=log_kind), intent(in) :: & - tr_snow ! if .true., use snow tracers - - logical (kind=log_kind), intent(inout) :: & - lstop ! solver failure flag - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - real(kind=dbl_kind), dimension(1:nilyr) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at start of timestep - zTin0 , & ! internal ice layer temperatures (C) at start of timestep - zSin0 , & ! internal ice layer salinities (ppt) at start of timestep - phi , & ! liquid fraction - km , & ! ice conductivity (W m-1 K-1) - dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - - real(kind=dbl_kind), dimension(1:nilyr+1) :: & - Sbr , & ! brine salinity (ppt) - qbr ! brine enthalpy (J m-3) - - real(kind=dbl_kind), dimension(0:nilyr) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(1:nslyr) :: & - zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep - zTsn0 , & ! internal snow layer temperatures (C) at start of timestep - ks ! snow conductivity (W m-1 K-1) - - real(kind=dbl_kind) :: & - Tsf0 , & ! ice/snow surface temperature (C) at start of timestep - hin , & ! ice thickness (m) - hsn , & ! snow thickness (m) - hslyr_min , & ! minimum snow layer thickness (m) - w , & ! vertical flushing Darcy velocity (m/s) - qocn , & ! ocean brine enthalpy (J m-3) - qpond , & ! melt pond brine enthalpy (J m-3) - Spond ! melt pond salinity (ppt) - - integer(kind=int_kind) :: & - k ! ice/snow layer index - - logical(kind=log_kind) :: & - lsnow ! snow presence: T: has snow, F: no snow - - character(len=char_len_long) :: & - warning ! warning message - - lstop = .false. - fadvheat = c0 - snoice = c0 - - Tsf0 = Tsf - zqsn0 = zqsn - zqin0 = zqin - zSin0 = zSin - zTsn0 = zTsn - zTin0 = zTin - - Spond = c0 - qpond = enthalpy_brine(c0) - - hslyr_min = hs_min / real(nslyr, dbl_kind) - - lsnow = (hslyr > hslyr_min) - - hin = hilyr * real(nilyr,dbl_kind) - - qocn = enthalpy_brine(Tbot) - - if (lsnow) then - hsn = hslyr * real(nslyr,dbl_kind) - else - hsn = c0 - endif - - do k = 1, nilyr - phi(k) = liquid_fraction(temperature_mush(zqin(k),zSin(k)),zSin(k)) - enddo ! k - - ! calculate vertical bulk darcy flow - call flushing_velocity(zTin, zSin, & - phi, nilyr, & - hin, hsn, & - hilyr, & - hpond, apond, & - dt, w) - - ! calculate quantities related to drainage - call explicit_flow_velocities(nilyr, zSin, & - zTin, Tsf, & - Tbot, q, & - dSdt, Sbr, & - qbr, dt, & - sss, qocn, & - hilyr, hin) - - ! calculate the conductivities - call conductivity_mush_array(nilyr, zqin0, zSin0, km) - - if (lsnow) then - ! case with snow - - ! calculate the snow conductivities - call conductivity_snow_array(ks) - - ! run the two stage solver - call two_stage_solver_snow(nilyr, nslyr, & - Tsf, Tsf0, & - zqsn, zqsn0, & - zqin, zqin0, & - zSin, zSin0, & - zTsn, zTsn0, & - zTin, zTin0, & - phi, Tbot, & - km, ks, & - q, dSdt, & - w, dt, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - Iswabs, Sswabs, & - qpond, qocn, & - Spond, sss, & - hilyr, hslyr, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - lstop, stop_label) - - if (lstop) then - write(warning,*) "temperature_changes_salinity: Picard solver non-convergence (snow)" - call add_warning(warning) - return - endif - - ! given the updated enthalpy and bulk salinity calculate other quantities - do k = 1, nslyr - zTsn(k) = temperature_snow(zqsn(k)) - enddo ! k - - do k = 1, nilyr - zTin(k) = temperature_mush_liquid_fraction(zqin(k), phi(k)) - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) - qbr(k) = enthalpy_brine(zTin(k)) - enddo ! k - - else - ! case without snow - - ! run the two stage solver - call two_stage_solver_nosnow(nilyr, nslyr, & - Tsf, Tsf0, & - zqsn, zqsn0, & - zqin, zqin0, & - zSin, zSin0, & - zTsn, zTsn0, & - zTin, zTin0, & - phi, Tbot, & - km, ks, & - q, dSdt, & - w, dt, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - Iswabs, Sswabs, & - qpond, qocn, & - Spond, sss, & - hilyr, hslyr, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - lstop, stop_label) - - if (lstop) then - write(warning,*) "temperature_changes_salinity: Picard solver non-convergence (no snow)" - call add_warning(warning) - return - endif - - ! given the updated enthalpy and bulk salinity calculate other quantities - do k = 1, nilyr - zTin(k) = temperature_mush_liquid_fraction(zqin(k), phi(k)) - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) - qbr(k) = enthalpy_brine(zTin(k)) - enddo ! k - - endif - - if (lstop) then - return - end if - - ! drain ponds from flushing - call flush_pond(w, hin, hpond, apond, dt) - - ! flood snow ice - call flood_ice(hsn, hin, & - nslyr, nilyr, & - hslyr, hilyr, & - zqsn, zqin, & - phi, dt, & - zSin, Sbr, & - sss, qocn, & - smice, smliq, & - tr_snow, & - snoice, fadvheat) - - end subroutine temperature_changes_salinity - -!======================================================================= - - subroutine two_stage_solver_snow(nilyr, nslyr, & - Tsf, Tsf0, & - zqsn, zqsn0, & - zqin, zqin0, & - zSin, zSin0, & - zTsn, zTsn0, & - zTin, zTin0, & - phi, Tbot, & - km, ks, & - q, dSdt, & - w, dt, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - Iswabs, Sswabs, & - qpond, qocn, & - Spond, sss, & - hilyr, hslyr, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - lstop, stop_label) - - ! solve the vertical temperature and salt change for case with snow - ! 1) determine what type of surface condition existed previously - cold or melting - ! 2) solve the system assuming this condition persists - ! 3) check the consistency of the surface condition of the solution - ! 4) If the surface condition is inconsistent resolve for the other surface condition - ! 5) If neither solution is consistent the resolve the inconsistency - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), intent(inout) :: & - Tsf ! snow surface temperature (C) - - real(kind=dbl_kind), intent(out) :: & - fcondtop , & ! downward cond flux at top surface (W m-2) - fcondbot , & ! downward cond flux at bottom surface (W m-2) - flwoutn , & ! upward LW at surface (W m-2) - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - fsurfn , & ! net flux to top surface, excluding fcondtop - fadvheat ! flow of heat to ocean due to advection (W m-2) - - real(kind=dbl_kind), intent(in) :: & - Tsf0 ! snow surface temperature (C) at beginning of timestep - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqsn , & ! snow layer enthalpy (J m-3) - zTsn ! snow layer temperature (C) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqsn0 , & ! snow layer enthalpy (J m-3) at beginning of timestep - zTsn0 , & ! snow layer temperature (C) at beginning of timestep - ks , & ! snow conductivity (W m-1 K-1) - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zSin , & ! ice layer bulk salinity (ppt) - zTin , & ! ice layer temperature (C) - phi ! ice layer liquid fraction - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beginning of timestep - zSin0 , & ! ice layer bulk salinity (ppt) at beginning of timestep - zTin0 , & ! ice layer temperature (C) at beginning of timestep - km , & ! ice conductivity (W m-1 K-1) - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - Tbot , & ! ice bottom surfce temperature (deg C) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - fswint , & ! SW absorbed in ice interior below surface (W m-2) - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - w , & ! vertical flushing Darcy velocity (m/s) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - Spond , & ! melt pond salinity (ppt) - sss ! sea surface salinity (PSU) - - logical(kind=log_kind), intent(inout) :: & - lstop ! solver failure flag - - character(len=*), intent(out) :: & - stop_label ! fatal error message - - real(kind=dbl_kind) :: & - fcondtop1 , & ! first stage downward cond flux at top surface (W m-2) - fsurfn1 , & ! first stage net flux to top surface, excluding fcondtop - Tsf1 ! first stage ice surface temperature (C) - - - ! determine if surface is initially cold or melting - if (Tsf < c0) then - - ! initially cold - - ! solve the system for cold and snow - call picard_solver(nilyr, nslyr, & - .true., .true., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - surface should still be cold - if (Tsf < dTemp_errmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - surface is warmer than melting - ! resolve assuming surface is melting - Tsf1 = Tsf - - ! reset the solution to initial values - Tsf = c0 - zqsn = zqsn0 - zqin = zqin0 - zSin = zSin0 - - ! solve the system for melting and snow - call picard_solver(nilyr, nslyr, & - .true., .false., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - ! surface conductive heat flux should be less than - ! incoming surface heat flux - if (fcondtop - fsurfn < 0.9_dbl_kind*ferrmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - call two_stage_inconsistency(1, Tsf1, c0, fcondtop, fsurfn) - lstop = .true. - stop_label = "two_stage_solver_snow: two_stage_inconsistency: cold" - return - - endif ! surface flux consistency - - endif ! surface temperature consistency - - else - - ! initially melting - Tsf = c0 - - ! solve the system for melting and snow - call picard_solver(nilyr, nslyr, & - .true., .false., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - ! surface conductive heat flux should be less than - ! incoming surface heat flux - if (fcondtop - fsurfn < 0.9_dbl_kind*ferrmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - resolve assuming other surface condition - ! assume surface is cold - fcondtop1 = fcondtop - fsurfn1 = fsurfn - - ! reset the solution to initial values - Tsf = Tsf0 - zqsn = zqsn0 - zqin = zqin0 - zSin = zSin0 - - ! solve the system for cold and snow - call picard_solver(nilyr, nslyr, & - .true., .true., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - surface should be cold - if (Tsf < dTemp_errmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - ! failed to find a solution so need to refine solutions until consistency found - call two_stage_inconsistency(2, Tsf, c0, fcondtop1, fsurfn1) - lstop = .true. - stop_label = "two_stage_solver_snow: two_stage_inconsistency: melting" - return - - endif ! surface temperature consistency - - endif ! surface flux consistency - - endif - - end subroutine two_stage_solver_snow - -!======================================================================= - - subroutine two_stage_solver_nosnow(nilyr, nslyr, & - Tsf, Tsf0, & - zqsn, zqsn0, & - zqin, zqin0, & - zSin, zSin0, & - zTsn, zTsn0, & - zTin, zTin0, & - phi, Tbot, & - km, ks, & - q, dSdt, & - w, dt, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - Iswabs, Sswabs, & - qpond, qocn, & - Spond, sss, & - hilyr, hslyr, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - lstop, stop_label) - - ! solve the vertical temperature and salt change for case with no snow - ! 1) determine what type of surface condition existed previously - cold or melting - ! 2) solve the system assuming this condition persists - ! 3) check the consistency of the surface condition of the solution - ! 4) If the surface condition is inconsistent resolve for the other surface condition - ! 5) If neither solution is consistent the resolve the inconsistency - - use ice_mushy_physics, only: & - liquidus_temperature_mush - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), intent(inout) :: & - Tsf ! ice surface temperature (C) - - real(kind=dbl_kind), intent(out) :: & - fcondtop , & ! downward cond flux at top surface (W m-2) - fcondbot , & ! downward cond flux at bottom surface (W m-2) - flwoutn , & ! upward LW at surface (W m-2) - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - fsurfn , & ! net flux to top surface, excluding fcondtop - fadvheat ! flow of heat to ocean due to advection (W m-2) - - real(kind=dbl_kind), intent(in) :: & - Tsf0 ! ice surface temperature (C) at beginning of timestep - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqsn , & ! snow layer enthalpy (J m-3) - zTsn ! snow layer temperature (C) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqsn0 , & ! snow layer enthalpy (J m-3) at beginning of timestep - zTsn0 , & ! snow layer temperature (C) at beginning of timestep - ks , & ! snow conductivity (W m-1 K-1) - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zSin , & ! ice layer bulk salinity (ppt) - zTin , & ! ice layer temperature (C) - phi ! ice layer liquid fraction - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beginning of timestep - zSin0 , & ! ice layer bulk salinity (ppt) at beginning of timestep - zTin0 , & ! ice layer temperature (C) at beginning of timestep - km , & ! ice conductivity (W m-1 K-1) - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - fswint , & ! SW absorbed in ice interior below surface (W m-2) - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - w , & ! vertical flushing Darcy velocity (m/s) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - Spond , & ! melt pond salinity (ppt) - sss ! sea surface salinity (PSU) - - logical, intent(inout) :: & - lstop ! solver failure flag - - character(len=*), intent(out) :: & - stop_label ! fatal error message - - real(kind=dbl_kind) :: & - Tmlt , & ! upper ice layer melting temperature (C) - fcondtop1 , & ! first stage downward cond flux at top surface (W m-2) - fsurfn1 , & ! first stage net flux to top surface, excluding fcondtop - Tsf1 ! first stage ice surface temperature (C) - - ! initial surface melting temperature - Tmlt = liquidus_temperature_mush(zSin0(1)) - - ! determine if surface is initially cold or melting - if (Tsf < Tmlt) then - - ! initially cold - - ! solve the system for cold and no snow - call picard_solver(nilyr, nslyr, & - .false., .true., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - surface should still be cold - if (Tsf < Tmlt + dTemp_errmax) then - - ! solution is consistent - have solution so finish - return - - else - ! solution is inconsistent - surface is warmer than melting - ! resolve assuming surface is melting - Tsf1 = Tsf - - ! reset the solution to initial values - Tsf = liquidus_temperature_mush(zSin0(1)) - zqin = zqin0 - zSin = zSin0 - - ! solve the system for melt and no snow - call picard_solver(nilyr, nslyr, & - .false., .false., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - ! surface conductive heat flux should be less than - ! incoming surface heat flux - if (fcondtop - fsurfn < 0.9_dbl_kind*ferrmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - call two_stage_inconsistency(3, Tsf1, Tmlt, fcondtop, fsurfn) - lstop = .true. - stop_label = "two_stage_solver_nosnow: two_stage_inconsistency: cold" - return - - endif - - endif - - else - ! initially melting - - ! solve the system for melt and no snow - Tsf = Tmlt - - call picard_solver(nilyr, nslyr, & - .false., .false., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - ! surface conductive heat flux should be less than - ! incoming surface heat flux - if (fcondtop - fsurfn < 0.9_dbl_kind*ferrmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - resolve assuming other surface condition - ! assume surface is cold - fcondtop1 = fcondtop - fsurfn1 = fsurfn - - ! reset the solution to initial values - Tsf = Tsf0 - zqin = zqin0 - zSin = zSin0 - - ! solve the system for cold and no snow - call picard_solver(nilyr, nslyr, & - .false., .true., & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - ! halt if solver failed - if (lstop) return - - ! check if solution is consistent - surface should be cold - if (Tsf < Tmlt + dTemp_errmax) then - - ! solution is consistent - have solution so finish - return - - else - - ! solution is inconsistent - call two_stage_inconsistency(4, Tsf, Tmlt, fcondtop1, fsurfn1) - lstop = .true. - stop_label = "two_stage_solver_nosnow: two_stage_inconsistency: melting" - return - - endif - - endif - - endif - - end subroutine two_stage_solver_nosnow - -!======================================================================= - - subroutine two_stage_inconsistency(type, Tsf, Tmlt, fcondtop, fsurfn) - - integer (kind=int_kind), intent(in) :: & - type - - real(kind=dbl_kind), intent(in) :: & - Tsf, & - Tmlt, & - fcondtop, & - fsurfn - - character(len=char_len_long) :: & - warning ! warning message - - write(warning,*) "ice_therm_mushy: two stage inconsistency" - call add_warning(warning) - write(warning,*) "type:", type - call add_warning(warning) - - if (type == 1) then - - write(warning,*) "First stage : Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax" - call add_warning(warning) - write(warning,*) " :", Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax - call add_warning(warning) - write(warning,*) "Second stage : fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax" - call add_warning(warning) - write(warning,*) " :", fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax - call add_warning(warning) - - else if (type == 2) then - - write(warning,*) "First stage : Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax" - call add_warning(warning) - write(warning,*) " :", Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax - call add_warning(warning) - write(warning,*) "Second stage : fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax" - call add_warning(warning) - write(warning,*) " :", fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax - call add_warning(warning) - - else if (type == 3) then - - write(warning,*) "First stage : Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax" - call add_warning(warning) - write(warning,*) " :", Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax - call add_warning(warning) - write(warning,*) "Second stage : fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax" - call add_warning(warning) - write(warning,*) " :", fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax - call add_warning(warning) - - else if (type == 4) then - - write(warning,*) "First stage : fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax" - call add_warning(warning) - write(warning,*) " :", fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax - call add_warning(warning) - write(warning,*) "Second stage : Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax" - call add_warning(warning) - write(warning,*) " :", Tsf, Tmlt, dTemp_errmax, Tsf - Tmlt - dTemp_errmax - call add_warning(warning) - - endif - - end subroutine two_stage_inconsistency - -!======================================================================= -! Picard/TDMA based solver -!======================================================================= - - subroutine prep_picard(nilyr, nslyr, & - lsnow, zqsn, & - zqin, zSin, & - hilyr, hslyr, & - km, ks, & - zTin, zTsn, & - Sbr, phi, & - dxp, kcstar, & - einit) - - use ice_mushy_physics, only: & - temperature_mush, & - liquidus_brine_salinity_mush, & - liquid_fraction, & - temperature_snow - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin , & ! ice layer enthalpy (J m-3) - zSin , & ! ice layer bulk salinity (ppt) - km , & ! ice conductivity (W m-1 K-1) - zqsn , & ! snow layer enthalpy (J m-3) - ks ! snow conductivity (W m-1 K-1) - - real(kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hslyr ! snow layer thickness (m) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - zTin , & ! ice layer temperature (C) - Sbr , & ! ice layer brine salinity (ppt) - phi , & ! ice layer liquid fraction - zTsn , & ! snow layer temperature (C) - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - real(kind=dbl_kind), intent(out) :: & - einit ! initial total energy (J) - - integer(kind=int_kind) :: k - - ! calculate initial ice temperatures - do k = 1, nilyr - zTin(k) = temperature_mush(zqin(k), zSin(k)) - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) - phi(k) = liquid_fraction(zTin(k), zSin(k)) - enddo ! k - - if (lsnow) then - - do k = 1, nslyr - zTsn(k) = temperature_snow(zqsn(k)) - enddo ! k - - endif ! lsnow - - ! interface distances - call calc_intercell_thickness(nilyr, nslyr, lsnow, hilyr, hslyr, dxp) - - ! interface conductivities - call calc_intercell_conductivity(lsnow, nilyr, nslyr, & - km, ks, hilyr, hslyr, kcstar) - - ! total energy content - call total_energy_content(lsnow, & - nilyr, nslyr, & - zqin, zqsn, & - hilyr, hslyr, & - einit) - - end subroutine prep_picard - -!======================================================================= - - subroutine picard_solver(nilyr, nslyr, & - lsnow, lcold, & - Tsf, zqsn, & - zqin, zSin, & - zTin, zTsn, & - phi, dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w, & - lstop, stop_label) - - use ice_therm_shared, only: surface_heat_flux, dsurface_heat_flux_dTsf - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - logical, intent(in) :: & - lsnow , & ! snow presence: T: has snow, F: no snow - lcold ! surface cold: T: surface is cold, F: surface is melting - - real(kind=dbl_kind), intent(inout) :: & - Tsf ! snow surface temperature (C) - - real(kind=dbl_kind), intent(out) :: & - fcondtop , & ! downward cond flux at top surface (W m-2) - fcondbot , & ! downward cond flux at bottom surface (W m-2) - fadvheat ! flow of heat to ocean due to advection (W m-2) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zSin , & ! ice layer bulk salinity (ppt) - zTin , & ! ice layer temperature (C) - phi , & ! ice layer liquid fraction - zqsn , & ! snow layer enthalpy (J m-3) - zTsn ! snow layer temperature (C) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - km , & ! ice conductivity (W m-1 K-1) - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - ks , & ! snow conductivity (W m-1 K-1) - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), intent(out) :: & - flwoutn , & ! upward LW at surface (W m-2) - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - fsurfn ! net flux to top surface, excluding fcondtop - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - fswint , & ! SW absorbed in ice interior below surface (W m-2) - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - Spond , & ! melt pond salinity (ppt) - sss , & ! sea surface salinity (ppt) - w ! vertical flushing Darcy velocity (m/s) - - logical(kind=log_kind), intent(inout) :: & - lstop ! solver failure flag - - character(len=*), intent(out) :: & - stop_label ! fatal error message - - real(kind=dbl_kind), dimension(nilyr) :: & - Sbr , & ! ice layer brine salinity (ppt) - qbr , & ! ice layer brine enthalpy (J m-3) - zTin0 , & ! ice layer temperature (C) at start of timestep - zqin0 , & ! ice layer enthalpy (J m-3) at start of timestep - zSin0 , & ! ice layer bulk salinity (ppt) at start of timestep - zTin_prev ! ice layer temperature at previous iteration - - real(kind=dbl_kind), dimension(nslyr) :: & - zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep - zTsn0 , & ! snow layer temperature (C) at start of timestep - zTsn_prev ! snow layer temperature at previous iteration - - real(kind=dbl_kind), dimension(nslyr+nilyr+1) :: & - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - real(kind=dbl_kind) :: & - Tsf0 , & ! snow surface temperature (C) at start of timestep - dfsurfn_dTsf , & ! derivative of net flux to top surface, excluding fcondtopn - dflwoutn_dTsf , & ! derivative of longwave flux wrt surface temperature - dfsensn_dTsf , & ! derivative of sensible heat flux wrt surface temperature - dflatn_dTsf , & ! derivative of latent heat flux wrt surface temperature - Tsf_prev , & ! snow surface temperature at previous iteration - einit , & ! initial total energy (J) - fadvheat_nit ! heat to ocean due to advection (W m-2) during iteration - - logical :: & - lconverged ! has Picard solver converged? - - integer :: & - nit ! Picard iteration count - - integer, parameter :: & - nit_max = 100 ! maximum number of Picard iterations - - lconverged = .false. - - ! prepare quantities for picard iteration - call prep_picard(nilyr, nslyr, & - lsnow, zqsn, & - zqin, zSin, & - hilyr, hslyr, & - km, ks, & - zTin, zTsn, & - Sbr, phi, & - dxp, kcstar, & - einit) - - Tsf0 = Tsf - zqin0 = zqin - zqsn0 = zqsn - zTin0 = zTin - zTsn0 = zTsn - zSin0 = zSin - - ! set prev variables - Tsf_prev = Tsf - zTsn_prev = zTsn - zTin_prev = zTin - - ! picard iteration - picard: do nit = 1, nit_max - - ! surface heat flux - call surface_heat_flux(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - flwoutn, fsensn, & - flatn, fsurfn) - - ! derivative of heat flux with respect to surface temperature - call dsurface_heat_flux_dTsf(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - dfsurfn_dTsf, dflwoutn_dTsf, & - dfsensn_dTsf, dflatn_dTsf) - - ! tridiagonal solve of new temperatures - call solve_heat_conduction(lsnow, lcold, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, zqsn0, & - phi, dt, & - qpond, qocn, & - q, w, & - hilyr, hslyr, & - dxp, kcstar, & - Iswabs, Sswabs, & - fsurfn, dfsurfn_dTsf, & - zTin, zTsn,nit) - - ! update brine enthalpy - call picard_updates_enthalpy(nilyr, zTin, qbr) - - ! drainage fluxes - call picard_drainage_fluxes(fadvheat_nit, q, & - qbr, qocn, & - hilyr, nilyr) - - ! flushing fluxes - call picard_flushing_fluxes(nilyr, & - fadvheat_nit, w, & - qbr, & - qocn, qpond) - - ! perform convergence check - call check_picard_convergence(nilyr, nslyr, & - lsnow, & - lconverged, nit, & - Tsf, Tsf_prev, & - zTin, zTin_prev,& - zTsn, zTsn_prev,& - phi, Tbot, & - zqin, zqsn, & - km, ks, & - hilyr, hslyr, & - fswint, & - einit, dt, & - fcondtop, fcondbot, & - fadvheat_nit) - - if (lconverged) exit - - Tsf_prev = Tsf - zTsn_prev = zTsn - zTin_prev = zTin - - enddo picard - - fadvheat = fadvheat_nit - - ! update the picard iterants - call picard_updates(nilyr, zTin, & - Sbr, qbr) - - ! solve for the salinity - call solve_salinity(zSin, Sbr, & - Spond, sss, & - q, dSdt, & - w, hilyr, & - dt, nilyr) - - ! final surface heat flux - call surface_heat_flux(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - flwoutn, fsensn, & - flatn, fsurfn) - - ! if not converged - if (.not. lconverged) then - - call picard_nonconvergence(nilyr, nslyr, & - Tsf0, Tsf, & - zTsn0, zTsn, & - zTin0, zTin, & - zSin0, zSin, & - zqsn0, zqsn, & - zqin0, phi, & - dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w) - lstop = .true. - stop_label = "picard_solver: Picard solver non-convergence" - - endif - - end subroutine picard_solver - -!======================================================================= - - subroutine picard_nonconvergence(nilyr, nslyr, & - Tsf0, Tsf, & - zTsn0, zTsn, & - zTin0, zTin, & - zSin0, zSin, & - zqsn0, zqsn, & - zqin0, phi, & - dt, & - hilyr, hslyr, & - km, ks, & - Iswabs, Sswabs, & - Tbot, & - fswint, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fcondtop, fcondbot, & - fadvheat, & - flwoutn, fsensn, & - flatn, fsurfn, & - qpond, qocn, & - Spond, sss, & - q, dSdt, & - w) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), intent(in) :: & - Tsf0 , & ! snow surface temperature (C) at beginning of timestep - Tsf ! snow surface temperature (C) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTsn0 , & ! snow layer temperature (C) at beginning of timestep - zTsn , & ! snow layer temperature (C) - zqsn0 , & - zqsn , & - zTin0 , & ! ice layer temperature (C) - zTin , & ! ice layer temperature (C) - zSin0 , & ! ice layer bulk salinity (ppt) - zSin , & ! ice layer bulk salinity (ppt) - phi , & ! ice layer liquid fraction - zqin0 - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - fswint , & ! SW absorbed in ice interior below surface (W m-2) - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - Spond , & ! melt pond salinity (ppt) - sss , & ! sea surface salinity (ppt) - w ! vertical flushing Darcy velocity (m/s) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - km , & ! ice conductivity (W m-1 K-1) - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - ks , & ! snow conductivity (W m-1 K-1) - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), intent(in) :: & - flwoutn , & ! upward LW at surface (W m-2) - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - fsurfn ! net flux to top surface, excluding fcondtop - - real(kind=dbl_kind), intent(in) :: & - fcondtop , & ! downward cond flux at top surface (W m-2) - fcondbot , & ! downward cond flux at bottom surface (W m-2) - fadvheat ! flow of heat to ocean due to advection (W m-2) - - integer :: & - k ! vertical layer index - - character(len=char_len_long) :: & - warning ! warning message - - write(warning,*) "-------------------------------------" - call add_warning(warning) - write(warning,*) - call add_warning(warning) - - write(warning,*) "picard convergence failed!" - call add_warning(warning) - write(warning,*) "==========================" - call add_warning(warning) - write(warning,*) - call add_warning(warning) - - write(warning,*) "Surface: Tsf0, Tsf" - call add_warning(warning) - write(warning,*) 0, Tsf0, Tsf - call add_warning(warning) - write(warning,*) - call add_warning(warning) - - write(warning,*) "Snow: zTsn0(k), zTsn(k), zqsn0(k), ks(k), Sswabs(k)" - call add_warning(warning) - do k = 1, nslyr - write(warning,*) k, zTsn0(k), zTsn(k), zqsn0(k), ks(k), Sswabs(k) - call add_warning(warning) - enddo ! k - write(warning,*) - call add_warning(warning) - - write(warning,*) "Ice: zTin0(k), zTin(k), zSin0(k), zSin(k), phi(k), zqin0(k), km(k), Iswabs(k), dSdt(k)" - call add_warning(warning) - do k = 1, nilyr - write(warning,*) k, zTin0(k), zTin(k), zSin0(k), zSin(k), phi(k), zqin0(k), km(k), Iswabs(k), dSdt(k) - call add_warning(warning) - enddo ! k - write(warning,*) - call add_warning(warning) - - write(warning,*) "Ice boundary: q(k)" - call add_warning(warning) - do k = 0, nilyr - write(warning,*) k, q(k) - call add_warning(warning) - enddo ! k - write(warning,*) - call add_warning(warning) - - write(warning,*) "dt: ", dt - call add_warning(warning) - write(warning,*) "hilyr: ", hilyr - call add_warning(warning) - write(warning,*) "hslyr: ", hslyr - call add_warning(warning) - write(warning,*) "Tbot: ", Tbot - call add_warning(warning) - write(warning,*) "fswint: ", fswint - call add_warning(warning) - write(warning,*) "fswsfc: ", fswsfc - call add_warning(warning) - write(warning,*) "rhoa: ", rhoa - call add_warning(warning) - write(warning,*) "flw: ", flw - call add_warning(warning) - write(warning,*) "potT: ", potT - call add_warning(warning) - write(warning,*) "Qa: ", Qa - call add_warning(warning) - write(warning,*) "shcoef: ", shcoef - call add_warning(warning) - write(warning,*) "lhcoef: ", lhcoef - call add_warning(warning) - write(warning,*) "qpond: ", qpond - call add_warning(warning) - write(warning,*) "qocn: ", qocn - call add_warning(warning) - write(warning,*) "Spond: ", Spond - call add_warning(warning) - write(warning,*) "sss: ", sss - call add_warning(warning) - write(warning,*) "w: ", w - call add_warning(warning) - write(warning,*) "flwoutn: ", flwoutn - call add_warning(warning) - write(warning,*) "fsensn: ", fsensn - call add_warning(warning) - write(warning,*) "flatn: ", flatn - call add_warning(warning) - write(warning,*) "fsurfn: ", fsurfn - call add_warning(warning) - write(warning,*) "fcondtop: ", fcondtop - call add_warning(warning) - write(warning,*) "fcondbot: ", fcondbot - call add_warning(warning) - write(warning,*) "fadvheat: ", fadvheat - call add_warning(warning) - write(warning,*) - call add_warning(warning) - - write(warning,*) "-------------------------------------" - call add_warning(warning) - - end subroutine picard_nonconvergence - -!======================================================================= - - subroutine check_picard_convergence(nilyr, nslyr, & - lsnow, & - lconverged, nit, & - Tsf, Tsf_prev, & - zTin, zTin_prev,& - zTsn, zTsn_prev,& - phi, Tbot, & - zqin, zqsn, & - km, ks, & - hilyr, hslyr, & - fswint, & - einit, dt, & - fcondtop, fcondbot, & - fadvheat) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - logical, intent(inout) :: & - lconverged ! has Picard solver converged? - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - integer, intent(in) :: & - nit ! Picard iteration count - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - Tsf , & ! snow surface temperature (C) - Tsf_prev , & ! snow surface temperature at previous iteration - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - fswint , & ! SW absorbed in ice interior below surface (W m-2) - einit , & ! initial total energy (J) - Tbot , & ! ice bottom surfce temperature (deg C) - fadvheat ! flow of heat to ocean due to advection (W m-2) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTin , & ! ice layer temperature (C) - zTin_prev, & ! ice layer temperature at previous iteration - phi , & ! ice layer liquid fraction - km ! ice conductivity (W m-1 K-1) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - zqin ! ice layer enthalpy (J m-3) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTsn , & ! snow layer temperature (C) - zTsn_prev, & ! snow layer temperature at previous iteration - ks ! snow conductivity (W m-1 K-1) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - zqsn ! snow layer enthalpy (J m-3) - - real(kind=dbl_kind), intent(out) :: & - fcondtop , & ! downward cond flux at top surface (W m-2) - fcondbot ! downward cond flux at bottom surface (W m-2) - - real(kind=dbl_kind) :: & - ferr , & ! energy flux error - efinal , & ! initial total energy (J) at iteration - dzTsn , & ! change in snow temperature (C) between iterations - dzTin , & ! change in ice temperature (C) between iterations - dTsf ! change in surface temperature (C) between iterations - - call picard_final(lsnow, & - nilyr, nslyr, & - zqin, zqsn, & - zTin, zTsn, & - phi) - - call total_energy_content(lsnow, & - nilyr, nslyr, & - zqin, zqsn, & - hilyr, hslyr, & - efinal) - - call maximum_variables_changes(lsnow, & - Tsf, Tsf_prev, dTsf, & - zTsn, zTsn_prev, dzTsn, & - zTin, zTin_prev, dzTin) - - fcondbot = c2 * km(nilyr) * ((zTin(nilyr) - Tbot) / hilyr) - - if (lsnow) then - fcondtop = c2 * ks(1) * ((Tsf - zTsn(1)) / hslyr) - else - fcondtop = c2 * km(1) * ((Tsf - zTin(1)) / hilyr) - endif - - ferr = (efinal - einit) / dt - (fcondtop - fcondbot + fswint - fadvheat) - - lconverged = (dTsf < dTemp_errmax .and. & - dzTsn < dTemp_errmax .and. & - dzTin < dTemp_errmax .and. & - abs(ferr) < 0.9_dbl_kind*ferrmax) - - end subroutine check_picard_convergence - -!======================================================================= - - subroutine picard_drainage_fluxes(fadvheat, q, & - qbr, qocn, & - hilyr, nilyr) - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), intent(out) :: & - fadvheat ! flow of heat to ocean due to advection (W m-2) - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - qbr ! ice layer brine enthalpy (J m-3) - - real(kind=dbl_kind), intent(in) :: & - qocn , & ! ocean brine enthalpy (J m-3) - hilyr ! ice layer thickness (m) - - integer :: & - k ! vertical layer index - - fadvheat = c0 - - ! calculate fluxes from base upwards - do k = 1, nilyr-1 - - fadvheat = fadvheat - q(k) * (qbr(k+1) - qbr(k)) - - enddo ! k - - k = nilyr - - fadvheat = fadvheat - q(k) * (qocn - qbr(k)) - - end subroutine picard_drainage_fluxes - -!======================================================================= - - subroutine picard_flushing_fluxes(nilyr, & - fadvheat, w, & - qbr, & - qocn, qpond) - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), intent(inout) :: & - fadvheat ! flow of heat to ocean due to advection (W m-2) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - qbr ! ice layer brine enthalpy (J m-3) - - real(kind=dbl_kind), intent(in) :: & - w , & ! vertical flushing Darcy velocity (m/s) - qocn , & ! ocean brine enthalpy (J m-3) - qpond ! melt pond brine enthalpy (J m-3) - - fadvheat = fadvheat + w * (qbr(nilyr) - qpond) - - end subroutine picard_flushing_fluxes - -!======================================================================= - - subroutine maximum_variables_changes(lsnow, & - Tsf, Tsf_prev, dTsf, & - zTsn, zTsn_prev, dzTsn, & - zTin, zTin_prev, dzTin) - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - real(kind=dbl_kind), intent(in) :: & - Tsf , & ! snow surface temperature (C) - Tsf_prev ! snow surface temperature at previous iteration - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTsn , & ! snow layer temperature (C) - zTsn_prev, & ! snow layer temperature at previous iteration - zTin , & ! ice layer temperature (C) - zTin_prev ! ice layer temperature at previous iteration - - real(kind=dbl_kind), intent(out) :: & - dTsf , & ! change in surface temperature (C) between iterations - dzTsn , & ! change in snow temperature (C) between iterations - dzTin ! change in surface temperature (C) between iterations - - dTsf = abs(Tsf - Tsf_prev) - - if (lsnow) then - dzTsn = maxval(abs(zTsn - zTsn_prev)) - else ! lsnow - dzTsn = c0 - endif ! lsnow - - dzTin = maxval(abs(zTin - zTin_prev)) - - end subroutine maximum_variables_changes - -!======================================================================= - - subroutine total_energy_content(lsnow, & - nilyr, nslyr, & - zqin, zqsn, & - hilyr, hslyr, & - energy) - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin , & ! ice layer enthalpy (J m-3) - zqsn ! snow layer enthalpy (J m-3) - - real(kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hslyr ! snow layer thickness (m) - - real(kind=dbl_kind), intent(out) :: & - energy ! total energy of ice and snow - - integer :: & - k ! vertical layer index - - energy = c0 - - if (lsnow) then - - do k = 1, nslyr - - energy = energy + hslyr * zqsn(k) - - enddo ! k - - endif ! lsnow - - do k = 1, nilyr - - energy = energy + hilyr * zqin(k) - - enddo ! k - - end subroutine total_energy_content - -!======================================================================= - - subroutine picard_updates(nilyr, zTin, & - Sbr, qbr) - - ! update brine salinity and liquid fraction based on new temperatures - - use ice_mushy_physics, only: & - liquidus_brine_salinity_mush, & - enthalpy_brine - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - Sbr , & ! ice layer brine salinity (ppt) - qbr ! ice layer brine enthalpy (J m-3) - - integer :: & - k ! vertical layer index - - do k = 1, nilyr - - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) - qbr(k) = enthalpy_brine(zTin(k)) - - enddo ! k - - end subroutine picard_updates - -!======================================================================= - - subroutine picard_updates_enthalpy(nilyr, zTin, qbr) - - ! update brine salinity and liquid fraction based on new temperatures - - use ice_mushy_physics, only: & - enthalpy_brine - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - qbr ! ice layer brine enthalpy (J m-3) - - integer :: & - k ! vertical layer index - - do k = 1, nilyr - - qbr(k) = enthalpy_brine(zTin(k)) - - enddo ! k - - end subroutine picard_updates_enthalpy - -!======================================================================= - - subroutine picard_final(lsnow, & - nilyr, nslyr, & - zqin, zqsn, & - zTin, zTsn, & - phi) - - use ice_mushy_physics, only: & - enthalpy_mush_liquid_fraction, & - enthalpy_snow - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nslyr ! number of snow layers - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - real(kind=dbl_kind), dimension(:), intent(out) :: & - zqin, & ! ice layer enthalpy (J m-3) - zqsn ! snow layer enthalpy (J m-3) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTin, & ! ice layer temperature (C) - phi , & ! ice layer liquid fraction - zTsn ! snow layer temperature (C) - - integer :: & - k ! vertical layer index - - do k = 1, nilyr - zqin(k) = enthalpy_mush_liquid_fraction(zTin(k), phi(k)) - enddo ! k - - if (lsnow) then - - do k = 1, nslyr - zqsn(k) = enthalpy_snow(zTsn(k)) - enddo ! k - - endif ! lsnow - - end subroutine picard_final - -!======================================================================= - - subroutine calc_intercell_thickness(nilyr, nslyr, lsnow, hilyr, hslyr, dxp) - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nslyr ! number of snow layers - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - real(kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hslyr ! snow layer thickness (m) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - dxp ! distances between grid points (m) - - integer :: & - l ! vertical index - - if (lsnow) then - - dxp(1) = hslyr / c2 - - do l = 2, nslyr - - dxp(l) = hslyr - - enddo ! l - - dxp(nslyr+1) = (hilyr + hslyr) / c2 - - do l = nslyr+2, nilyr+nslyr - - dxp(l) = hilyr - - enddo ! l - - dxp(nilyr+nslyr+1) = hilyr / c2 - - else ! lsnow - - dxp(1) = hilyr / c2 - - do l = 2, nilyr - - dxp(l) = hilyr - - enddo ! l - - dxp(nilyr+1) = hilyr / c2 - - do l = nilyr+2, nilyr+nslyr+1 - - dxp(l) = c0 - - enddo ! l - - endif ! lsnow - - end subroutine calc_intercell_thickness - -!======================================================================= - - subroutine calc_intercell_conductivity(lsnow, & - nilyr, nslyr, & - km, ks, & - hilyr, hslyr, & - kcstar) - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nslyr ! number of snow layers - - logical, intent(in) :: & - lsnow ! snow presence: T: has snow, F: no snow - - real(kind=dbl_kind), dimension(:), intent(in) :: & - km , & ! ice conductivity (W m-1 K-1) - ks ! snow conductivity (W m-1 K-1) - - real(kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hslyr ! snow layer thickness (m) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - kcstar ! interface conductivities (W m-1 K-1) - - real(kind=dbl_kind) :: & - fe ! distance fraction at interface - - integer :: & - k, & ! vertical layer index - l ! vertical index - - if (lsnow) then - - kcstar(1) = ks(1) - - do l = 2, nslyr - - k = l - kcstar(l) = (c2 * ks(k) * ks(k-1)) / (ks(k) + ks(k-1)) - - enddo ! l - - fe = hilyr / (hilyr + hslyr) - kcstar(nslyr+1) = c1 / ((c1 - fe) / ks(nslyr) + fe / km(1)) - - do k = 2, nilyr - - l = k + nslyr - kcstar(l) = (c2 * km(k) * km(k-1)) / (km(k) + km(k-1)) - - enddo ! k - - kcstar(nilyr+nslyr+1) = km(nilyr) - - else ! lsnow - - kcstar(1) = km(1) - - do k = 2, nilyr - - l = k - kcstar(l) = (c2 * km(k) * km(k-1)) / (km(k) + km(k-1)) - - enddo ! k - - kcstar(nilyr+1) = km(nilyr) - - do l = nilyr+2, nilyr+nslyr+1 - - kcstar(l) = c0 - - enddo ! l - - endif ! lsnow - - end subroutine calc_intercell_conductivity - -!======================================================================= - - subroutine solve_heat_conduction(lsnow, lcold, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, zqsn0, & - phi, dt, & - qpond, qocn, & - q, w, & - hilyr, hslyr, & - dxp, kcstar, & - Iswabs, Sswabs, & - fsurfn, dfsurfn_dTsf, & - zTin, zTsn,nit) - - logical, intent(in) :: & - lsnow , & ! snow presence: T: has snow, F: no snow - lcold ! surface cold: T: surface is cold, F: surface is melting - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beggining of timestep - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - phi , & ! ice layer liquid fraction - zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), intent(inout) :: & - Tsf ! snow surface temperature (C) - - real(kind=dbl_kind), intent(in) :: & - dt , & ! timestep (s) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - w , & ! vertical flushing Darcy velocity (m/s) - fsurfn , & ! net flux to top surface, excluding fcondtop - dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zTin ! ice layer temperature (C) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - zTsn ! snow layer temperature (C) - - integer, intent(in) :: & - nit ! Picard iteration count - - real(kind=dbl_kind), dimension(nilyr+nslyr+1) :: & - Ap , & ! diagonal of tridiagonal matrix - As , & ! lower off-diagonal of tridiagonal matrix - An , & ! upper off-diagonal of tridiagonal matrix - b , & ! right hand side of matrix solve - T ! ice and snow temperatures - - integer :: & - nyn ! matrix size - - ! set up matrix and right hand side - snow - if (lsnow) then - - if (lcold) then - - call matrix_elements_snow_cold(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, zqsn0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, hslyr, & - dxp, kcstar, & - Iswabs, Sswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - else ! lcold - - call matrix_elements_snow_melt(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, zqsn0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, hslyr, & - dxp, kcstar, & - Iswabs, Sswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - endif ! lcold - - else ! lsnow - - if (lcold) then - - call matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, & - dxp, kcstar, & - Iswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - else ! lcold - - call matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, & - dxp, kcstar, & - Iswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - endif ! lcold - - endif ! lsnow - - ! tridiag to get new temperatures - call tdma_solve_sparse(nilyr, nslyr, & - An(1:nyn), Ap(1:nyn), As(1:nyn), b(1:nyn), T(1:nyn), nyn) - - call update_temperatures(lsnow, lcold, & - nilyr, nslyr, & - T, Tsf, & - zTin, zTsn) - - end subroutine solve_heat_conduction - -!======================================================================= - - subroutine update_temperatures(lsnow, lcold, & - nilyr, nslyr, & - T, Tsf, & - zTin, zTsn) - - logical, intent(in) :: & - lsnow , & ! snow presence: T: has snow, F: no snow - lcold ! surface cold: T: surface is cold, F: surface is melting - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - T ! matrix solution vector - - real(kind=dbl_kind), intent(inout) :: & - Tsf ! snow surface temperature (C) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zTin , & ! ice layer temperature (C) - zTsn ! snow layer temperature (C) - - integer :: & - l , & ! vertical index - k ! vertical layer index - - if (lsnow) then - - if (lcold) then - - Tsf = T(1) - - do k = 1, nslyr - l = k + 1 - zTsn(k) = T(l) - enddo ! k - - do k = 1, nilyr - l = k + nslyr + 1 - zTin(k) = T(l) - enddo ! k - - else ! lcold - - do k = 1, nslyr - l = k - zTsn(k) = T(l) - enddo ! k - - do k = 1, nilyr - l = k + nslyr - zTin(k) = T(l) - enddo ! k - - endif ! lcold - - else ! lsnow - - if (lcold) then - - Tsf = T(1) - - do k = 1, nilyr - l = k + 1 - zTin(k) = T(l) - enddo ! k - - else ! lcold - - do k = 1, nilyr - l = k - zTin(k) = T(l) - enddo ! k - - endif ! lcold - - endif ! lsnow - - end subroutine update_temperatures - -!======================================================================= - - subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, & - dxp, kcstar, & - Iswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - Ap , & ! diagonal of tridiagonal matrix - As , & ! lower off-diagonal of tridiagonal matrix - An , & ! upper off-diagonal of tridiagonal matrix - b ! right hand side of matrix solve - - integer, intent(out) :: & - nyn ! matrix size - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beggining of timestep - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - phi ! ice layer liquid fraction - - real(kind=dbl_kind), intent(in) :: & - Tsf , & ! snow surface temperature (C) - dt , & ! timestep (s) - hilyr , & ! ice layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - w , & ! downwards vertical flushing Darcy velocity (m/s) - fsurfn , & ! net flux to top surface, excluding fcondtop - dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - integer :: & - k , & ! vertical layer index - l ! vertical index - - ! surface layer - k = 1 - l = k - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(k+1) / dxp(k+1) + & - kcstar(k) / dxp(k) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(k+1) / dxp(k+1) - & - q(k) * cp_ocn * rhow - An(l) = c0 - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - (kcstar(k) / dxp(k)) * Tsf + & - w * qpond - - ! interior ice layers - do k = 2, nilyr-1 - - l = k - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(k+1) / dxp(k+1) + & - kcstar(k) / dxp(k) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(k+1) / dxp(k+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(k) / dxp(k) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) - - enddo ! k - - ! bottom layer - k = nilyr - l = k - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(k+1) / dxp(k+1) + & - kcstar(k) / dxp(k) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = c0 - An(l) = -kcstar(k) / dxp(k) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - (kcstar(k+1) * Tbot) / dxp(k+1) + & - q(k) * qocn - - nyn = nilyr - - end subroutine matrix_elements_nosnow_melt - -!======================================================================= - - subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, & - dxp, kcstar, & - Iswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - Ap , & ! diagonal of tridiagonal matrix - As , & ! lower off-diagonal of tridiagonal matrix - An , & ! upper off-diagonal of tridiagonal matrix - b ! right hand side of matrix solve - - integer, intent(out) :: & - nyn ! matrix size - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beggining of timestep - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - phi ! ice layer liquid fraction - - real(kind=dbl_kind), intent(in) :: & - Tsf , & ! snow surface temperature (C) - dt , & ! timestep (s) - hilyr , & ! ice layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - w , & ! downwards vertical flushing Darcy velocity (m/s) - fsurfn , & ! net flux to top surface, excluding fcondtop - dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - integer :: & - k , & ! vertical layer index - l ! vertical index - - ! surface temperature - l = 1 - Ap(l) = dfsurfn_dTsf - kcstar(1) / dxp(1) - As(l) = kcstar(1) / dxp(1) - An(l) = c0 - b (l) = dfsurfn_dTsf * Tsf - fsurfn - - ! surface layer - k = 1 - l = k + 1 - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(k+1) / dxp(k+1) + & - kcstar(k) / dxp(k) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(k+1) / dxp(k+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(k) / dxp(k) - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - w * qpond - - ! interior ice layers - do k = 2, nilyr-1 - - l = k + 1 - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(k+1) / dxp(k+1) + & - kcstar(k) / dxp(k) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(k+1) / dxp(k+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(k) / dxp(k) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) - - enddo ! k - - ! bottom layer - k = nilyr - l = k + 1 - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(k+1) / dxp(k+1) + & - kcstar(k) / dxp(k) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = c0 - An(l) = -kcstar(k) / dxp(k) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - (kcstar(k+1) * Tbot) / dxp(k+1) + & - q(k) * qocn - - nyn = nilyr + 1 - - end subroutine matrix_elements_nosnow_cold - -!======================================================================= - - subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, zqsn0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, hslyr, & - dxp, kcstar, & - Iswabs, Sswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - Ap , & ! diagonal of tridiagonal matrix - As , & ! lower off-diagonal of tridiagonal matrix - An , & ! upper off-diagonal of tridiagonal matrix - b ! right hand side of matrix solve - - integer, intent(out) :: & - nyn ! matrix size - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beggining of timestep - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - phi , & ! ice layer liquid fraction - zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), intent(in) :: & - Tsf , & ! snow surface temperature (C) - dt , & ! timestep (s) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - w , & ! downwards vertical flushing Darcy velocity (m/s) - fsurfn , & ! net flux to top surface, excluding fcondtop - dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - integer :: & - k , & ! vertical layer index - l ! vertical index - - ! surface layer - k = 1 - l = k - - Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & - kcstar(l+1) / dxp(l+1) + & - kcstar(l) / dxp(l) - As(l) = -kcstar(l+1) / dxp(l+1) - An(l) = c0 - b (l) = ((rhos * Lfresh + zqsn0(k)) / dt) * hslyr + Sswabs(k) + & - (kcstar(l) * Tsf) / dxp(l) - - ! interior snow layers - do k = 2, nslyr - - l = k - - Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & - kcstar(l+1) / dxp(l+1) + & - kcstar(l) / dxp(l) - As(l) = -kcstar(l+1) / dxp(l+1) - An(l) = -kcstar(l) / dxp(l) - b (l) = ((rhos * Lfresh + zqsn0(k)) / dt) * hslyr + Sswabs(k) - - enddo ! k - - ! top ice layer - k = 1 - l = nslyr + k - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(l+1) / dxp(l+1) + & - kcstar(l) / dxp(l) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(l+1) / dxp(l+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(l) / dxp(l) - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - w * qpond - - ! interior ice layers - do k = 2, nilyr-1 - - l = nslyr + k - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(l+1) / dxp(l+1) + & - kcstar(l) / dxp(l) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(l+1) / dxp(l+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(l) / dxp(l) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) - - enddo ! k - - ! bottom layer - k = nilyr - l = nilyr + nslyr - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(l+1) / dxp(l+1) + & - kcstar(l) / dxp(l) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = c0 - An(l) = -kcstar(l) / dxp(l) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - (kcstar(l+1) * Tbot) / dxp(l+1) + & - q(k) * qocn - - nyn = nilyr + nslyr - - end subroutine matrix_elements_snow_melt - -!======================================================================= - - subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & - nilyr, nslyr, & - Tsf, Tbot, & - zqin0, zqsn0, & - qpond, qocn, & - phi, q, & - w, & - hilyr, hslyr, & - dxp, kcstar, & - Iswabs, Sswabs, & - fsurfn, dfsurfn_dTsf, & - dt) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - Ap , & ! diagonal of tridiagonal matrix - As , & ! lower off-diagonal of tridiagonal matrix - An , & ! upper off-diagonal of tridiagonal matrix - b ! right hand side of matrix solve - - integer, intent(out) :: & - nyn ! matrix size - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin0 , & ! ice layer enthalpy (J m-3) at beggining of timestep - Iswabs , & ! SW radiation absorbed in ice layers (W m-2) - phi , & ! ice layer liquid fraction - zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep - Sswabs ! SW radiation absorbed in snow layers (W m-2) - - real(kind=dbl_kind), intent(in) :: & - Tsf , & ! snow surface temperature (C) - dt , & ! timestep (s) - hilyr , & ! ice layer thickness (m) - hslyr , & ! snow layer thickness (m) - Tbot , & ! ice bottom surfce temperature (deg C) - qpond , & ! melt pond brine enthalpy (J m-3) - qocn , & ! ocean brine enthalpy (J m-3) - w , & ! downwards vertical flushing Darcy velocity (m/s) - fsurfn , & ! net flux to top surface, excluding fcondtop - dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - dxp , & ! distances between grid points (m) - kcstar ! interface conductivities (W m-1 K-1) - - integer :: & - k , & ! vertical layer index - l , & ! matrix index - m ! vertical index - - ! surface temperature - l = 1 - Ap(l) = dfsurfn_dTsf - kcstar(1) / dxp(1) - As(l) = kcstar(1) / dxp(1) - An(l) = c0 - b (l) = dfsurfn_dTsf * Tsf - fsurfn - - ! surface layer - k = 1 - l = k + 1 - m = 1 - - Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & - kcstar(m+1) / dxp(m+1) + & - kcstar(m) / dxp(m) - As(l) = -kcstar(m+1) / dxp(m+1) - An(l) = -kcstar(m) / dxp(m) - b (l) = ((rhos * Lfresh + zqsn0(k)) / dt) * hslyr + Sswabs(k) - - ! interior snow layers - do k = 2, nslyr - - l = k + 1 - m = k - - Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & - kcstar(m+1) / dxp(m+1) + & - kcstar(m) / dxp(m) - As(l) = -kcstar(m+1) / dxp(m+1) - An(l) = -kcstar(m) / dxp(m) - b (l) = ((rhos * Lfresh + zqsn0(k)) / dt) * hslyr + Sswabs(k) - - enddo ! k - - ! top ice layer - k = 1 - l = nslyr + k + 1 - m = k + nslyr - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(m+1) / dxp(m+1) + & - kcstar(m) / dxp(m) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(m+1) / dxp(m+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(m) / dxp(m) - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - w * qpond - - ! interior ice layers - do k = 2, nilyr-1 - - l = nslyr + k + 1 - m = k + nslyr - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(m+1) / dxp(m+1) + & - kcstar(m) / dxp(m) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = -kcstar(m+1) / dxp(m+1) - & - q(k) * cp_ocn * rhow - An(l) = -kcstar(m) / dxp(m) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) - - enddo ! k - - ! bottom layer - k = nilyr - l = nilyr + nslyr + 1 - m = k + nslyr - - Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & - kcstar(m+1) / dxp(m+1) + & - kcstar(m) / dxp(m) + & - q(k) * cp_ocn * rhow + & - w * cp_ocn * rhow - As(l) = c0 - An(l) = -kcstar(m) / dxp(m) - & - w * cp_ocn * rhow - b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & - (kcstar(m+1) * Tbot) / dxp(m+1) + & - q(k) * qocn - - nyn = nilyr + nslyr + 1 - - end subroutine matrix_elements_snow_cold - -!======================================================================= - - subroutine solve_salinity(zSin, Sbr, & - Spond, sss, & - q, dSdt, & - w, hilyr, & - dt, nilyr) - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zSin ! ice layer bulk salinity (ppt) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - Sbr , & ! ice layer brine salinity (ppt) - dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & - q ! upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), intent(in) :: & - Spond , & ! melt pond salinity (ppt) - sss , & ! sea surface salinity (ppt) - w , & ! vertical flushing Darcy velocity (m/s) - hilyr , & ! ice layer thickness (m) - dt ! timestep (s) - - integer :: & - k ! vertical layer index - - real(kind=dbl_kind), parameter :: & - S_min = p01 - - real(kind=dbl_kind), dimension(nilyr) :: & - zSin0 - - zSin0 = zSin - - k = 1 - zSin(k) = zSin(k) + max(S_min - zSin(k), & - ((q(k) * (Sbr(k+1) - Sbr(k))) / hilyr + & - dSdt(k) + & - (w * (Spond - Sbr(k))) / hilyr) * dt) - - do k = 2, nilyr-1 - - zSin(k) = zSin(k) + max(S_min - zSin(k), & - ((q(k) * (Sbr(k+1) - Sbr(k))) / hilyr + & - dSdt(k) + & - (w * (Sbr(k-1) - Sbr(k))) / hilyr) * dt) - - enddo ! k - - k = nilyr - zSin(k) = zSin(k) + max(S_min - zSin(k), & - ((q(k) * (sss - Sbr(k))) / hilyr + & - dSdt(k) + & - (w * (Sbr(k-1) - Sbr(k))) / hilyr) * dt) - - - if (minval(zSin) < c0) then - - - write(*,*) (q(k) * (Sbr(k+1) - Sbr(k))) / hilyr, & - dSdt(k) , & - (w * (Spond - Sbr(k))) / hilyr - - do k = 1, nilyr - - write(*,*) k, zSin(k), zSin0(k) - - enddo - - stop - - endif - - end subroutine solve_salinity - -!======================================================================= - - subroutine tdma_solve_sparse(nilyr, nslyr, a, b, c, d, x, n) - - ! perform a tri-diagonal solve with TDMA using a sparse tridiagoinal matrix - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nslyr ! number of snow layers - - integer(kind=int_kind), intent(in) :: & - n ! matrix size - - real(kind=dbl_kind), dimension(:), intent(in) :: & - a , & ! matrix lower off-diagonal - b , & ! matrix diagonal - c , & ! matrix upper off-diagonal - d ! right hand side vector - - real(kind=dbl_kind), dimension(:), intent(out) :: & - x ! solution vector - - real(kind=dbl_kind), dimension(nilyr+nslyr+1) :: & - cp , & ! modified upper off-diagonal vector - dp ! modified right hand side vector - - integer(kind=int_kind) :: & - i ! vector index - - ! forward sweep - cp(1) = c(1) / b(1) - do i = 2, n-1 - cp(i) = c(i) / (b(i) - cp(i-1)*a(i)) - enddo - - dp(1) = d(1) / b(1) - do i = 2, n - dp(i) = (d(i) - dp(i-1)*a(i)) / (b(i) - cp(i-1)*a(i)) - enddo - - ! back substitution - x(n) = dp(n) - do i = n-1,1,-1 - x(i) = dp(i) - cp(i)*x(i+1) - enddo - - end subroutine tdma_solve_sparse - -!======================================================================= -! Effect of salinity -!======================================================================= - - function permeability(phi) result(perm) - - ! given the liquid fraction calculate the permeability - ! See Golden et al. 2007 - - real(kind=dbl_kind), intent(in) :: & - phi ! liquid fraction - - real(kind=dbl_kind) :: & - perm ! permeability (m2) - - real(kind=dbl_kind), parameter :: & - phic = p05 ! critical liquid fraction for impermeability - - perm = 3.0e-8_dbl_kind * max(phi - phic, c0)**3 - - end function permeability - -!======================================================================= - - subroutine explicit_flow_velocities(nilyr, zSin, & - zTin, Tsf, & - Tbot, q, & - dSdt, Sbr, & - qbr, dt, & - sss, qocn, & - hilyr, hin) - - ! calculate the rapid gravity drainage mode Darcy velocity and the - ! slow mode drainage rate - - use ice_mushy_physics, only: & - liquidus_brine_salinity_mush, & - liquid_fraction, & - enthalpy_brine, & - density_brine - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zSin, & ! ice layer bulk salinity (ppt) - zTin ! ice layer temperature (C) - - real(kind=dbl_kind), intent(in) :: & - Tsf , & ! ice/snow surface temperature (C) - Tbot , & ! ice bottom temperature (C) - dt , & ! time step (s) - sss , & ! sea surface salinty (ppt) - qocn , & ! ocean enthalpy (J m-3) - hilyr , & ! ice layer thickness (m) - hin ! ice thickness (m) - - real(kind=dbl_kind), dimension(0:nilyr), intent(out) :: & - q ! rapid mode upward interface vertical Darcy flow (m s-1) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - dSdt ! slow mode drainage rate (ppt s-1) - - real(kind=dbl_kind), dimension(:), intent(out) :: & - Sbr , & ! ice layer brine salinity (ppt) - qbr ! ice layer brine enthalpy (J m-3) - - real(kind=dbl_kind), parameter :: & - kappal = 8.824e-8_dbl_kind, & ! heat diffusivity of liquid - ra_constants = gravit / (viscosity_dyn * kappal), & ! for Rayleigh number - fracmax = p2 , & ! limiting advective layer fraction - zSin_min = p1 , & ! minimum bulk salinity (ppt) - safety_factor = c10 ! to prevent negative salinities - - real(kind=dbl_kind), dimension(1:nilyr) :: & - phi ! ice layer liquid fraction - - real(kind=dbl_kind), dimension(0:nilyr) :: & - rho ! ice layer brine density (kg m-3) - - real(kind=dbl_kind) :: & - rho_ocn , & ! ocean density (kg m-3) - perm_min , & ! minimum permeability from layer to ocean (m2) - perm_harm , & ! harmonic mean of permeability from layer to ocean (m2) - rho_sum , & ! sum of the brine densities from layer to ocean (kg m-3) - rho_pipe , & ! density of the brine in the channel (kg m-3) - z , & ! distance to layer from top surface (m) - perm , & ! ice layer permeability (m2) - drho , & ! brine density difference between layer and ocean (kg m-3) - Ra , & ! local mush Rayleigh number - rn , & ! real value of number of layers considered - L , & ! thickness of the layers considered (m) - dx , & ! horizontal size of convective flow (m) - dx2 , & ! square of the horizontal size of convective flow (m2) - Am , & ! A parameter for mush - Bm , & ! B parameter for mush - Ap , & ! A parameter for channel - Bp , & ! B parameter for channel - qlimit , & ! limit to vertical Darcy flow for numerical stability - dS_guess , & ! expected bulk salinity without limits - alpha ! desalination limiting factor - - integer(kind=int_kind) :: & - k ! ice layer index - - ! initial downward sweep - determine derived physical quantities - do k = 1, nilyr - - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) - phi(k) = liquid_fraction(zTin(k), zSin(k)) - qbr(k) = enthalpy_brine(zTin(k)) - rho(k) = density_brine(Sbr(k)) - - enddo ! k - - rho(0) = rho(1) - - ! ocean conditions - Sbr(nilyr+1) = sss - qbr(nilyr+1) = qocn - rho_ocn = density_brine(sss) - - ! initialize accumulated quantities - perm_min = bignum - perm_harm = c0 - rho_sum = c0 - - ! limit to q for numerical stability - qlimit = (fracmax * hilyr) / dt - - ! no flow through ice top surface - q(0) = c0 - - ! first iterate over layers going up - do k = nilyr, 1, -1 - - ! vertical position from ice top surface - z = ((real(k, dbl_kind) - p5) / real(nilyr, dbl_kind)) * hin - - ! permeabilities - perm = permeability(phi(k)) - perm_min = min(perm_min,perm) - perm_harm = perm_harm + (c1 / max(perm,1.0e-30_dbl_kind)) - - ! densities - rho_sum = rho_sum + rho(k) - !rho_pipe = rho(k) - rho_pipe = p5 * (rho(k) + rho(k-1)) - drho = max(rho(k) - rho_ocn, c0) - - ! mush Rayleigh number - Ra = drho * (hin-z) * perm_min * ra_constants - - ! height of mush layer to layer k - rn = real(nilyr-k+1,dbl_kind) - L = rn * hilyr - - ! horizontal size of convection - dx = L * c2 * aspect_rapid_mode - dx2 = dx**2 - - ! determine vertical Darcy flow - Am = (dx2 * rn) / (viscosity_dyn * perm_harm) - Bm = (-gravit * rho_sum) / rn - - Ap = (pi * a_rapid_mode**4) / (c8 * viscosity_dyn) - Bp = -rho_pipe * gravit - - q(k) = max((Am / dx2) * ((-Ap*Bp - Am*Bm) / (Am + Ap) + Bm), 1.0e-30_dbl_kind) - - ! modify by Rayleigh number and advection limit - q(k) = min(q(k) * (max(Ra - Rac_rapid_mode, c0) / (Ra+puny)), qlimit) - - ! late stage drainage - dSdt(k) = dSdt_slow_mode * (max((zSin(k) - phi_c_slow_mode*Sbr(k)), c0) & - * max((Tbot - Tsf), c0)) / (hin + 0.001_dbl_kind) - - dSdt(k) = max(dSdt(k), (-zSin(k) * 0.5_dbl_kind) / dt) - - ! restrict flows to prevent too much salt loss - dS_guess = (((q(k) * (Sbr(k+1) - Sbr(k))) / hilyr + dSdt(k)) * dt) * safety_factor - - if (abs(dS_guess) < puny) then - alpha = c1 - else - alpha = (zSin_min - zSin(k)) / dS_guess - endif - - if (alpha < c0 .or. alpha > c1) alpha = c1 - - q(k) = q(k) * alpha - dSdt(k) = dSdt(k) * alpha - - enddo ! k - - end subroutine explicit_flow_velocities - -!======================================================================= -! Flushing -!======================================================================= - - subroutine flushing_velocity(zTin, zSin, & - phi, nilyr, & - hin, hsn, & - hilyr, & - hpond, apond, & - dt, w) - - ! calculate the vertical flushing Darcy velocity (positive downward) - - use ice_mushy_physics, only: & - density_brine, & - liquidus_brine_salinity_mush - - use ice_colpkg_tracers, only: & - tr_pond - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zTin , & ! ice layer temperature (C) - zSin , & ! ice layer bulk salinity (ppt) - phi ! ice layer liquid fraction - - real(kind=dbl_kind), intent(in) :: & - hilyr , & ! ice layer thickness (m) - hpond , & ! melt pond thickness (m) - apond , & ! melt pond area (-) - hsn , & ! snow thickness (m) - hin , & ! ice thickness (m) - dt ! time step (s) - - real(kind=dbl_kind), intent(out) :: & - w ! vertical flushing Darcy flow rate (m s-1) - - real(kind=dbl_kind), parameter :: & - advection_limit = 0.005_dbl_kind ! limit to fraction of brine in - ! any layer that can be advected - - real(kind=dbl_kind) :: & - perm , & ! ice layer permeability (m2) - ice_mass , & ! mass of ice (kg m-2) - perm_harm , & ! harmonic mean of ice permeability (m2) - hocn , & ! ocean surface height above ice base (m) - hbrine , & ! brine surface height above ice base (m) - w_down_max , & ! maximum downward flushing Darcy flow rate (m s-1) - phi_min , & ! minimum porosity in the mush - wlimit , & ! limit to w to avoid advecting all brine in layer - dhhead ! hydraulic head (m) - - integer(kind=int_kind) :: & - k ! ice layer index - - ! initialize - w = c0 - - ! only flush if ponds are active - if (tr_pond) then - - ice_mass = c0 - perm_harm = c0 - phi_min = c1 - - do k = 1, nilyr - - ! liquid fraction - !phi = liquid_fraction(zTin(k), zSin(k)) - phi_min = min(phi_min,phi(k)) - - ! permeability - perm = permeability(phi(k)) - - ! ice mass - ice_mass = ice_mass + phi(k) * density_brine(liquidus_brine_salinity_mush(zTin(k))) + & - (c1 - phi(k)) * rhoi - - ! permeability harmonic mean - perm_harm = perm_harm + c1 / (perm + 1e-30_dbl_kind) - - enddo ! k - - ice_mass = ice_mass * hilyr - - perm_harm = real(nilyr,dbl_kind) / perm_harm - - ! calculate ocean surface height above bottom of ice - hocn = (ice_mass + hpond * apond * rhow + hsn * rhos) / rhow - - ! calculate brine height above bottom of ice - hbrine = hin + hpond - - ! pressure head - dhhead = max(hbrine - hocn,c0) - - ! darcy flow through ice - w = (perm_harm * rhow * gravit * (dhhead / hin)) / viscosity_dyn - - ! maximum down flow to drain pond - w_down_max = (hpond * apond) / dt - - ! limit flow - w = min(w,w_down_max) - - ! limit amount of brine that can be advected out of any particular layer - wlimit = (advection_limit * phi_min * hilyr) / dt - - if (abs(w) > puny) then - w = w * max(min(abs(wlimit/w),c1),c0) - else - w = c0 - endif - - w = max(w, c0) - - endif - - end subroutine flushing_velocity - -!======================================================================= - - subroutine flush_pond(w, hin, hpond, apond, dt) - - use ice_colpkg_tracers, only: & - tr_pond - - ! given a flushing velocity drain the meltponds - - real(kind=dbl_kind), intent(in) :: & - w , & ! vertical flushing Darcy flow rate (m s-1) - hin , & ! ice thickness (m) - apond , & ! melt pond area (-) - dt ! time step (s) - - real(kind=dbl_kind), intent(inout) :: & - hpond ! melt pond thickness (m) - - real(kind=dbl_kind), parameter :: & - lambda_pond = c1 / (10.0_dbl_kind * 24.0_dbl_kind * 3600.0_dbl_kind), & - hpond0 = 0.01_dbl_kind - - if (tr_pond) then - if (apond > c0 .and. hpond > c0) then - - ! flush pond through mush - hpond = hpond - w * dt / apond - - hpond = max(hpond, c0) - - ! exponential decay of pond - hpond = hpond - lambda_pond * dt * (hpond + hpond0) - - hpond = max(hpond, c0) - - endif - endif - - end subroutine flush_pond - - !======================================================================= - - subroutine flood_ice(hsn, hin, & - nslyr, nilyr, & - hslyr, hilyr, & - zqsn, zqin, & - phi, dt, & - zSin, Sbr, & - sss, qocn, & - smice, smliq, & - tr_snow, & - snoice, fadvheat) - - ! given upwards flushing brine flow calculate amount of snow ice and - ! convert snow to ice with appropriate properties - - use ice_mushy_physics, only: & - density_brine - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step (s) - hsn , & ! snow thickness (m) - hin , & ! ice thickness (m) - sss , & ! sea surface salinity (ppt) - qocn ! ocean brine enthalpy (J m-2) - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqsn , & ! snow layer enthalpy (J m-2) - zqin , & ! ice layer enthalpy (J m-2) - zSin , & ! ice layer bulk salinity (ppt) - phi , & ! ice liquid fraction - smice , & ! ice mass tracer in snow (kg/m^3) - smliq ! liquid water mass tracer in snow (kg/m^3) - - real(kind=dbl_kind), dimension(:), intent(in) :: & - Sbr ! ice layer brine salinity (ppt) - - real(kind=dbl_kind), intent(inout) :: & - hslyr , & ! snow layer thickness (m) - hilyr ! ice layer thickness (m) - - real(kind=dbl_kind), intent(out) :: & - snoice ! snow ice formation - - real(kind=dbl_kind), intent(inout) :: & - fadvheat ! advection heat flux to ocean - - logical (kind=log_kind), intent(in) :: & - tr_snow ! if .true., use snow tracers - - real(kind=dbl_kind) :: & - hin2 , & ! new ice thickness (m) - hsn2 , & ! new snow thickness (m) - hilyr2 , & ! new ice layer thickness (m) - hslyr2 , & ! new snow layer thickness (m) - dh , & ! thickness of snowice formation (m) - phi_snowice , & ! liquid fraction of new snow ice - rho_snowice , & ! density of snowice (kg m-3) - zSin_snowice , & ! bulk salinity of new snowice (ppt) - zqin_snowice , & ! ice enthalpy of new snowice (J m-2) - zqsn_snowice , & ! snow enthalpy of snow thats becoming snowice (J m-2) - freeboard_density , & ! negative of ice surface freeboard times the ocean density (kg m-2) - ice_mass , & ! mass of the ice (kg m-2) - snow_mass , & ! mass of the ice (kg m-2) - rho_ocn , & ! density of the ocean (kg m-3) - ice_density , & ! density of ice layer (kg m-3) - hadded , & ! thickness rate of water used from ocean (m/s) - wadded , & ! mass rate of water used from ocean (kg/m^2/s) - eadded , & ! energy rate of water used from ocean (W/m^2) - sadded ! salt rate of water used from ocean (kg/m^2/s) - - integer :: & - k ! vertical index - - snoice = c0 - - ! check we have snow - if (hsn > puny) then - - rho_ocn = density_brine(sss) - - ! ice mass - ice_mass = c0 - do k = 1, nilyr - ice_density = min(phi(k) * density_brine(Sbr(k)) + (c1 - phi(k)) * rhoi,rho_ocn) - ice_mass = ice_mass + ice_density - enddo ! k - ice_mass = ice_mass * hilyr - -! for now, do not use variable snow density -! snow_mass = c0 -! if (tr_snow) then -! do k = 1,nslyr -! snow_mass = snow_mass + (smice(k) + smliq(k)) * hslyr -! enddo -! else - snow_mass = rhos * hsn -! endif - - ! negative freeboard times ocean density - freeboard_density = max(ice_mass + snow_mass - hin * rho_ocn, c0) - - ! check if have flooded ice - if (freeboard_density > c0) then - - ! sea ice fraction of newly formed snow ice -! phi_snowice = (c1 - snow_mass / hsn / rhoi) ! non-BFB - phi_snowice = (c1 - rhos / rhoi) ! for now, do not use variable snow density - -! njeffery: changed to rhos instead of (c1-phi_snowice)*rhoi -! to conserve ice and liquid snow tracers when rhos = smice + smliq -! eclare: this change seems to be BFB - - ! density of newly formed snowice -! rho_snowice = phi_snowice * rho_ocn + rhos - rho_snowice = phi_snowice * rho_ocn + (c1 - phi_snowice) * rhoi - - ! calculate thickness of new ice added - dh = freeboard_density / (rho_ocn - rho_snowice + rhos) - dh = max(min(dh,hsn),c0) - - ! enthalpy of snow that becomes snowice - call enthalpy_snow_snowice(nslyr, dh, hsn, zqsn, zqsn_snowice) - - ! change thicknesses - hin2 = hin + dh - hsn2 = hsn - dh - - hilyr2 = hin2 / real(nilyr,dbl_kind) - hslyr2 = hsn2 / real(nslyr,dbl_kind) - - ! properties of new snow ice - zSin_snowice = phi_snowice * sss - zqin_snowice = phi_snowice * qocn + zqsn_snowice - - ! change snow properties - call update_vertical_tracers_snow(nslyr, zqsn, hslyr, hslyr2) - - if (tr_snow .and. hslyr2 > puny) then - call update_vertical_tracers_snow(nslyr, smice, hslyr, hslyr2) - call update_vertical_tracers_snow(nslyr, smliq, hslyr, hslyr2) - endif - - ! change ice properties - call update_vertical_tracers_ice(nilyr, zqin, hilyr, hilyr2, & - hin, hin2, zqin_snowice) - call update_vertical_tracers_ice(nilyr, zSin, hilyr, hilyr2, & - hin, hin2, zSin_snowice) - call update_vertical_tracers_ice(nilyr, phi, hilyr, hilyr2, & - hin, hin2, phi_snowice) - - ! change thicknesses - hilyr = hilyr2 - hslyr = hslyr2 - snoice = dh - - hadded = (dh * phi_snowice) / dt - wadded = hadded * rhoi - eadded = hadded * qocn - sadded = wadded * ice_ref_salinity * p001 - - ! conservation - fadvheat = fadvheat - eadded - - endif - - endif - - end subroutine flood_ice - -!======================================================================= - - subroutine enthalpy_snow_snowice(nslyr, dh, hsn, zqsn, zqsn_snowice) - - ! determine enthalpy of the snow being converted to snow ice - - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - real(kind=dbl_kind), intent(in) :: & - dh , & ! thickness of new snowice formation (m) - hsn ! initial snow thickness - - real(kind=dbl_kind), dimension(:), intent(in) :: & - zqsn ! snow layer enthalpy (J m-2) - - real(kind=dbl_kind), intent(out) :: & - zqsn_snowice ! enthalpy of snow becoming snowice (J m-2) - - real(kind=dbl_kind) :: & - rnlyr ! real value of number of snow layers turning to snowice - - integer(kind=int_kind) :: & - nlyr , & ! no of snow layers completely converted to snowice - k ! snow layer index - - zqsn_snowice = c0 - - ! snow depth and snow layers affected by snowice formation - if (hsn > puny) then - rnlyr = (dh / hsn) * nslyr - nlyr = min(floor(rnlyr),nslyr-1) ! nlyr=0 if nslyr=1 - - ! loop over full snow layers affected - ! not executed if nlyr=0 - do k = nslyr, nslyr-nlyr+1, -1 - zqsn_snowice = zqsn_snowice + zqsn(k) / rnlyr - enddo ! k - - ! partially converted snow layer - zqsn_snowice = zqsn_snowice + & - ((rnlyr - real(nlyr,dbl_kind)) / rnlyr) * zqsn(nslyr-nlyr) - endif - - end subroutine enthalpy_snow_snowice - -!======================================================================= - - subroutine update_vertical_tracers_snow(nslyr, trc, hlyr1, hlyr2) - - ! given some snow ice formation regrid snow layers - - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - trc ! vertical tracer - - real(kind=dbl_kind), intent(in) :: & - hlyr1 , & ! old cell thickness - hlyr2 ! new cell thickness - - real(kind=dbl_kind), dimension(1:nslyr) :: & - trc2 ! temporary array for updated tracer - - ! vertical indexes for old and new grid - integer(kind=int_kind) :: & - k1 , & ! vertical index for old grid - k2 ! vertical index for new grid - - real(kind=dbl_kind) :: & - z1a , & ! lower boundary of old cell - z1b , & ! upper boundary of old cell - z2a , & ! lower boundary of new cell - z2b , & ! upper boundary of new cell - overlap ! overlap between old and new cell - - ! loop over new grid cells - do k2 = 1, nslyr - - ! initialize new tracer - trc2(k2) = c0 - - ! calculate upper and lower boundary of new cell - z2a = (k2 - 1) * hlyr2 - z2b = k2 * hlyr2 - - ! loop over old grid cells - do k1 = 1, nslyr - - ! calculate upper and lower boundary of old cell - z1a = (k1 - 1) * hlyr1 - z1b = k1 * hlyr1 - - ! calculate overlap between old and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - - ! aggregate old grid cell contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc(k1) - - enddo ! k1 - - ! renormalize new grid cell - trc2(k2) = trc2(k2) / hlyr2 - - enddo ! k2 - - ! update vertical tracer array with the adjusted tracer - trc = trc2 - - end subroutine update_vertical_tracers_snow - -!======================================================================= - - subroutine update_vertical_tracers_ice(nilyr, trc, hlyr1, hlyr2, & - h1, h2, trc0) - - ! given some snow ice formation regrid ice layers - - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - - real(kind=dbl_kind), dimension(:), intent(inout) :: & - trc ! vertical tracer - - real(kind=dbl_kind), intent(in) :: & - hlyr1 , & ! old cell thickness - hlyr2 , & ! new cell thickness - h1 , & ! old total thickness - h2 , & ! new total thickness - trc0 ! tracer value of added snow ice on ice top - - real(kind=dbl_kind), dimension(1:nilyr) :: & - trc2 ! temporary array for updated tracer - - integer(kind=int_kind) :: & - k1 , & ! vertical indexes for old grid - k2 ! vertical indexes for new grid - - real(kind=dbl_kind) :: & - z1a , & ! lower boundary of old cell - z1b , & ! upper boundary of old cell - z2a , & ! lower boundary of new cell - z2b , & ! upper boundary of new cell - overlap ! overlap between old and new cell - - ! loop over new grid cells - do k2 = 1, nilyr - - ! initialize new tracer - trc2(k2) = c0 - - ! calculate upper and lower boundary of new cell - z2a = (k2 - 1) * hlyr2 - z2b = k2 * hlyr2 - - ! calculate upper and lower boundary of added snow ice at top - z1a = c0 - z1b = h2 - h1 - - ! calculate overlap between added ice and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - - ! aggregate added ice contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc0 - - ! loop over old grid cells - do k1 = 1, nilyr - - ! calculate upper and lower boundary of old cell - z1a = (k1 - 1) * hlyr1 + h2 - h1 - z1b = k1 * hlyr1 + h2 - h1 - - ! calculate overlap between old and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - - ! aggregate old grid cell contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc(k1) - - enddo ! k1 - - ! renormalize new grid cell - trc2(k2) = trc2(k2) / hlyr2 - - enddo ! k2 - - ! update vertical tracer array with the adjusted tracer - trc = trc2 - - end subroutine update_vertical_tracers_ice - -!======================================================================= - -end module ice_therm_mushy - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_therm_shared.F90 b/components/mpas-seaice/src/column/ice_therm_shared.F90 deleted file mode 100644 index 09bf6b759302..000000000000 --- a/components/mpas-seaice/src/column/ice_therm_shared.F90 +++ /dev/null @@ -1,203 +0,0 @@ -! SVN:$Id: ice_therm_shared.F90 1196 2017-04-18 13:32:23Z eclare $ -!========================================================================= -! -! Shared thermo variables, subroutines -! -! authors: Elizabeth C. Hunke, LANL - - module ice_therm_shared - - use ice_kinds_mod - use ice_constants_colpkg, only: c1, c2, c4, & - cp_ocn, cp_ice, rhoi, Tffresh, TTTice, qqqice, & - stefan_boltzmann, emissivity, Lfresh - - implicit none - save - - private - public :: calculate_Tin_from_qin, & - surface_heat_flux, dsurface_heat_flux_dTsf - - real (kind=dbl_kind), parameter, public :: & - ferrmax = 1.0e-3_dbl_kind ! max allowed energy flux error (W m-2) - ! recommend ferrmax < 0.01 W m-2 - - real (kind=dbl_kind), parameter, public :: & - Tmin = -100.0_dbl_kind ! min allowed internal temperature (deg C) - - logical (kind=log_kind), public :: & - l_brine ! if true, treat brine pocket effects - - real (kind=dbl_kind), parameter, public :: & - hfrazilmin = 0.05_dbl_kind ! min thickness of new frazil ice (m) - - real (kind=dbl_kind), public :: & - hi_min ! minimum ice thickness allowed (m) - -!======================================================================= - - contains - -!======================================================================= -! -! Compute the internal ice temperatures from enthalpy using -! quadratic formula - - function calculate_Tin_from_qin (qin, Tmltk) & - result(Tin) - - real (kind=dbl_kind), intent(in) :: & - qin , & ! enthalpy - Tmltk ! melting temperature at one level - - real (kind=dbl_kind) :: & - Tin ! internal temperature - - ! local variables - - real (kind=dbl_kind) :: & - aa1,bb1,cc1 ! quadratic solvers - - if (l_brine) then - aa1 = cp_ice - bb1 = (cp_ocn-cp_ice)*Tmltk - qin/rhoi - Lfresh - cc1 = Lfresh * Tmltk - Tin = min((-bb1 - sqrt(bb1*bb1 - c4*aa1*cc1)) / & - (c2*aa1),Tmltk) - - else ! fresh ice - Tin = (Lfresh + qin/rhoi) / cp_ice - endif - - end function calculate_Tin_from_qin - -!======================================================================= -! Surface heat flux -!======================================================================= - -! heat flux into ice - - subroutine surface_heat_flux(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - flwoutn, fsensn, & - flatn, fsurfn) - - ! input surface temperature - real(kind=dbl_kind), intent(in) :: & - Tsf ! ice/snow surface temperature (C) - - ! input variables - real(kind=dbl_kind), intent(in) :: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - ! output - real(kind=dbl_kind), intent(out) :: & - fsensn , & ! surface downward sensible heat (W m-2) - flatn , & ! surface downward latent heat (W m-2) - flwoutn , & ! upward LW at surface (W m-2) - fsurfn ! net flux to top surface, excluding fcondtopn - - ! local variables - real(kind=dbl_kind) :: & - TsfK , & ! ice/snow surface temperature (K) - Qsfc , & ! saturated surface specific humidity (kg/kg) - qsat , & ! the saturation humidity of air (kg/m^3) - flwdabs , & ! downward longwave absorbed heat flx (W/m^2) - tmpvar ! 1/TsfK - - ! ice surface temperature in Kelvin - TsfK = Tsf + Tffresh -! TsfK = max(Tsf + Tffresh, c1) - tmpvar = c1/TsfK - - ! saturation humidity - qsat = qqqice * exp(-TTTice*tmpvar) - Qsfc = qsat / rhoa - - ! longwave radiative flux - flwdabs = emissivity * flw - flwoutn = -emissivity * stefan_boltzmann * TsfK**4 - - ! downward latent and sensible heat fluxes - fsensn = shcoef * (potT - TsfK) - flatn = lhcoef * (Qa - Qsfc) - - ! combine fluxes - fsurfn = fswsfc + flwdabs + flwoutn + fsensn + flatn - - end subroutine surface_heat_flux - - !======================================================================= - - subroutine dsurface_heat_flux_dTsf(Tsf, fswsfc, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - dfsurfn_dTsf, dflwoutn_dTsf, & - dfsensn_dTsf, dflatn_dTsf) - - ! input surface temperature - real(kind=dbl_kind), intent(in) :: & - Tsf ! ice/snow surface temperature (C) - - ! input variables - real(kind=dbl_kind), intent(in) :: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - rhoa , & ! air density (kg/m^3) - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - ! output - real(kind=dbl_kind), intent(out) :: & - dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - - real(kind=dbl_kind), intent(out) :: & - dflwoutn_dTsf , & ! derivative of longwave flux wrt surface temperature - dfsensn_dTsf , & ! derivative of sensible heat flux wrt surface temperature - dflatn_dTsf ! derivative of latent heat flux wrt surface temperature - - ! local variables - real(kind=dbl_kind) :: & - TsfK , & ! ice/snow surface temperature (K) - dQsfc_dTsf , & ! saturated surface specific humidity (kg/kg) - qsat , & ! the saturation humidity of air (kg/m^3) - tmpvar ! 1/TsfK - - ! ice surface temperature in Kelvin -! TsfK = max(Tsf + Tffresh, c1) - TsfK = Tsf + Tffresh - tmpvar = c1/TsfK - - ! saturation humidity - qsat = qqqice * exp(-TTTice*tmpvar) - dQsfc_dTsf = TTTice * tmpvar * tmpvar * (qsat / rhoa) - - ! longwave radiative flux - dflwoutn_dTsf = -emissivity * stefan_boltzmann * c4*TsfK**3 - - ! downward latent and sensible heat fluxes - dfsensn_dTsf = -shcoef - dflatn_dTsf = -lhcoef * dQsfc_dTsf - - ! combine fluxes - dfsurfn_dTsf = dflwoutn_dTsf + dfsensn_dTsf + dflatn_dTsf - - end subroutine dsurface_heat_flux_dTsf - -!======================================================================= - - end module ice_therm_shared - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_therm_vertical.F90 b/components/mpas-seaice/src/column/ice_therm_vertical.F90 deleted file mode 100644 index ce6f419874de..000000000000 --- a/components/mpas-seaice/src/column/ice_therm_vertical.F90 +++ /dev/null @@ -1,2270 +0,0 @@ -! SVN:$Id: ice_therm_vertical.F90 1196 2017-04-18 13:32:23Z eclare $ -!========================================================================= -! -! Update ice and snow internal temperatures and compute -! thermodynamic growth rates and atmospheric fluxes. -! -! NOTE: The thermodynamic calculation is split in two for load balancing. -! First ice_therm_vertical computes vertical growth rates and coupler -! fluxes. Then ice_therm_itd does thermodynamic calculations not -! needed for coupling. -! -! authors: William H. Lipscomb, LANL -! C. M. Bitz, UW -! Elizabeth C. Hunke, LANL -! -! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb -! 2004: Block structure added by William Lipscomb -! 2006: Streamlined for efficiency by Elizabeth Hunke -! Converted to free source form (F90) - - module ice_therm_vertical - - use ice_kinds_mod - use ice_constants_colpkg, only: c0, c1, c3, p001, p5, puny, & - pi, depressT, Lvap, hs_min, cp_ice, & - cp_ocn, rhow, rhoi, rhos, Lfresh, rhofresh, ice_ref_salinity - use ice_colpkg_shared, only: ktherm, heat_capacity, calc_Tsfc, & - min_salin, rsnw_fall, rsnw_tmax - use ice_therm_shared, only: ferrmax, l_brine, & - calculate_tin_from_qin, Tmin - use ice_therm_bl99, only: temperature_changes - use ice_therm_0layer, only: zerolayer_temperature - use ice_warnings, only: add_warning - - implicit none - save - - private - public :: frzmlt_bottom_lateral, thermo_vertical, adjust_enthalpy - - real(kind=dbl_kind), public :: & - lateralMeltActive = c1, & - congelBasalMeltActive = c1 - -!======================================================================= - - contains - -!======================================================================= -! -! Driver for updating ice and snow internal temperatures and -! computing thermodynamic growth rates and atmospheric fluxes. -! -! authors: William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine thermo_vertical (nilyr, nslyr, & - dt, aicen, & - vicen, vsnon, & - Tsf, zSin, & - zqin, zqsn, & - smice, smliq, & - tr_snow, apond, & - hpond, iage, & - tr_pond_topo, & - flw, potT, & - Qa, rhoa, & - fsnow, fpond, & - fbot, Tbot, & - sss, rsnw, & - lhcoef, shcoef, & - fswsfc, fswint, & - Sswabs, Iswabs, & - fsurfn, fcondtopn, & - fsensn, flatn, & - flwoutn, evapn, & - freshn, fsaltn, & - fhocnn, frain, & - meltt, & - melts, meltb, & - meltsliq, & - congel, snoice, & - mlt_onset, frz_onset, & - yday, dsnow, & - tr_rsnw, & - !NJ: for bulk conservation fix - !tr_rsnw, fsloss, & - l_stop, stop_label,& - prescribed_ice) - - use ice_therm_mushy, only: temperature_changes_salinity - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - frain ! rainfall rate (kg/m2/s) - !NJ: for bulk conservation fix - !frain , & ! rainfall rate (kg/m2/s) - !fsloss ! blowing snow loss to leads (kg/m2/s) - - ! ice state variables - real (kind=dbl_kind), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - ! tracers - real (kind=dbl_kind), intent(inout) :: & - Tsf , & ! ice/snow top surface temp, same as Tsfcn (deg C) - apond , & ! melt pond area fraction - hpond , & ! melt pond depth (m) - iage ! ice age (s) - - logical (kind=log_kind), intent(in) :: & - tr_pond_topo ! if .true., use melt pond tracer - - logical (kind=log_kind), intent(in), optional :: & - prescribed_ice ! if .true., use prescribed ice instead of computed - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqsn , & ! snow layer enthalpy, zqsn < 0 (J m-3) - zqin , & ! ice layer enthalpy, zqin < 0 (J m-3) - zSin , & ! internal ice layer salinities - rsnw , & ! snow grain radius (10^-6 m) - smice , & ! ice mass tracer in snow (kg/m^3) - smliq ! liquid water mass tracer in snow (kg/m^3) - - ! input from atmosphere - real (kind=dbl_kind), & - intent(in) :: & - flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - rhoa , & ! air density (kg/m^3) - fsnow , & ! snowfall rate (kg m-2 s-1) - shcoef , & ! transfer coefficient for sensible heat - lhcoef ! transfer coefficient for latent heat - - real (kind=dbl_kind), & - intent(inout) :: & - fswsfc , & ! SW absorbed at ice/snow surface (W m-2) - fswint , & ! SW absorbed in ice interior, below surface (W m-2) - fpond ! fresh water flux to ponds (kg/m^2/s) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - Sswabs , & ! SW radiation absorbed in snow layers (W m-2) - Iswabs ! SW radiation absorbed in ice layers (W m-2) - - ! input from ocean - real (kind=dbl_kind), intent(in) :: & - fbot , & ! ice-ocean heat flux at bottom surface (W/m^2) - Tbot , & ! ice bottom surface temperature (deg C) - sss ! ocean salinity - - ! coupler fluxes to atmosphere - real (kind=dbl_kind), intent(out):: & - flwoutn , & ! outgoing longwave radiation (W/m^2) - evapn ! evaporative water flux (kg/m^2/s) - - ! Note: these are intent out if calc_Tsfc = T, otherwise intent in - real (kind=dbl_kind), intent(inout):: & - fsensn , & ! sensible heat flux (W/m^2) - flatn , & ! latent heat flux (W/m^2) - fsurfn , & ! net flux to top surface, excluding fcondtopn - fcondtopn ! downward cond flux at top surface (W m-2) - - ! coupler fluxes to ocean - real (kind=dbl_kind), intent(out):: & - freshn , & ! fresh water flux to ocean (kg/m^2/s) - fsaltn , & ! salt flux to ocean (kg/m^2/s) - fhocnn ! net heat flux to ocean (W/m^2) - - ! diagnostic fields - real (kind=dbl_kind), & - intent(inout):: & - meltt , & ! top ice melt (m/step-->cm/day) - melts , & ! snow melt (m/step-->cm/day) - meltsliq , & ! snow melt mass (kg/m^2/step-->kg/m^2/day) - meltb , & ! basal ice melt (m/step-->cm/day) - congel , & ! basal ice growth (m/step-->cm/day) - snoice , & ! snow-ice formation (m/step-->cm/day) - dsnow , & ! change in snow thickness (m/step-->cm/day) - mlt_onset, & ! day of year that sfc melting begins - frz_onset ! day of year that freezing begins (congel or frazil) - - real (kind=dbl_kind), intent(in) :: & - yday ! day of year - - logical (kind=log_kind), intent(in) :: & - tr_snow , & ! if .true., use snow density tracer - tr_rsnw ! if .true., use dynamic snow grain radius, liquid and snow mass - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - - integer (kind=int_kind) :: & - k ! ice layer index - - real (kind=dbl_kind) :: & - dhi , & ! change in ice thickness - dhs ! change in snow thickness - -! 2D state variables (thickness, temperature) - - real (kind=dbl_kind) :: & - hilyr , & ! ice layer thickness - hslyr , & ! snow layer thickness - hin , & ! ice thickness (m) - hsn , & ! snow thickness (m) - hsn_new , & ! thickness of new snow (m) - worki , & ! local work array - works , & ! local work array - fbotUse - - real (kind=dbl_kind), dimension (nilyr) :: & - zTin ! internal ice layer temperatures - - real (kind=dbl_kind), dimension (nslyr) :: & - zTsn ! internal snow layer temperatures - -! other 2D flux and energy variables - - real (kind=dbl_kind) :: & - fcondbot , & ! downward cond flux at bottom surface (W m-2) - einit , & ! initial energy of melting (J m-2) - efinal , & ! final energy of melting (J m-2) - einter ! intermediate energy - - real (kind=dbl_kind) :: & - fadvocn ! advective heat flux to ocean - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - - flwoutn = c0 - evapn = c0 - freshn = c0 - fsaltn = c0 - fhocnn = c0 - fadvocn = c0 - - meltt = c0 - meltb = c0 - melts = c0 - congel = c0 - snoice = c0 - dsnow = c0 - meltsliq= c0 - - if (calc_Tsfc) then - fsensn = c0 - flatn = c0 - fsurfn = c0 - fcondtopn = c0 - endif - - !----------------------------------------------------------------- - ! Compute variables needed for vertical thermo calculation - !----------------------------------------------------------------- - - call init_vertical_profile (nilyr, nslyr, & - aicen, & - vicen, vsnon, & - hin, hilyr, & - hsn, hslyr, & - zqin, zTin, & - zqsn, zTsn, & - zSin, & - einit, Tbot, & - l_stop, stop_label) - - if (l_stop) return - - ! Save initial ice and snow thickness (for fresh and fsalt) - worki = hin - works = hsn - - !----------------------------------------------------------------- - ! Compute new surface temperature and internal ice and snow - ! temperatures. - !----------------------------------------------------------------- - - if (heat_capacity) then ! usual case - - if (ktherm == 2) then - - call temperature_changes_salinity(dt, & - nilyr, nslyr, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fswsfc, fswint, & - Sswabs, Iswabs, & - hilyr, hslyr, & - apond, hpond, & - zqin, zTin, & - zqsn, zTsn, & - zSin, & - Tsf, Tbot, & - sss, & - fsensn, flatn, & - flwoutn, fsurfn, & - fcondtopn, fcondbot, & - fadvocn, snoice, & - einit, & - smice, smliq, & - tr_rsnw, & - l_stop, stop_label) - - if (l_stop) return - - else ! ktherm - - call temperature_changes(dt, & - nilyr, nslyr, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fswsfc, fswint, & - Sswabs, Iswabs, & - hilyr, hslyr, & - zqin, zTin, & - zqsn, zTsn, & - zSin, & - Tsf, Tbot, & - fsensn, flatn, & - flwoutn, fsurfn, & - fcondtopn, fcondbot, & - einit, l_stop, & - stop_label) - - if (l_stop) return - - endif ! ktherm - - else - - if (calc_Tsfc) then - - call zerolayer_temperature(dt, & - nilyr, nslyr, & - rhoa, flw, & - potT, Qa, & - shcoef, lhcoef, & - fswsfc, & - hilyr, hslyr, & - Tsf, Tbot, & - fsensn, flatn, & - flwoutn, fsurfn, & - fcondtopn, fcondbot, & - l_stop, stop_label) - - if (l_stop) return - - else - - !------------------------------------------------------------ - ! Set fcondbot = fcondtop for zero layer thermodynamics - ! fcondtop is set in call to set_sfcflux in step_therm1 - !------------------------------------------------------------ - - fcondbot = fcondtopn ! zero layer - - endif ! calc_Tsfc - - endif ! heat_capacity - - ! intermediate energy for error check - - einter = c0 - do k = 1, nslyr - einter = einter + hslyr * zqsn(k) - enddo ! k - do k = 1, nilyr - einter = einter + hilyr * zqin(k) - enddo ! k - - if (l_stop) return - - !----------------------------------------------------------------- - ! Compute growth and/or melting at the top and bottom surfaces. - ! Add new snowfall. - ! Repartition ice into equal-thickness layers, conserving energy. - !----------------------------------------------------------------- - - fbotUse = & - congelBasalMeltActive * fbot + & - (c1 - congelBasalMeltActive) * fcondbot - - call thickness_changes(nilyr, nslyr, & - dt, yday, & - efinal, & - hin, hilyr, & - hsn, hslyr, & - zqin, zqsn, & - smice, smliq, & - fbotUse, Tbot, & - flatn, fsurfn, & - fcondtopn, fcondbot, & - fsnow, hsn_new, & - fhocnn, evapn, & - meltt, melts, & - meltsliq, frain, & - meltb, iage, & - congel, snoice, & - mlt_onset, frz_onset, & - zSin, sss, & - dsnow, tr_snow, & - rsnw, tr_rsnw) - !NJL for bulk conservation fix - !rsnw, tr_rsnw, & - !fsloss) - - - !----------------------------------------------------------------- - ! Check for energy conservation by comparing the change in energy - ! to the net energy input - !----------------------------------------------------------------- - - call conservation_check_vthermo(dt, & - fsurfn, flatn, & - fhocnn, fswint, & - fsnow, einit, & - einter, efinal, & - fcondtopn, fcondbot, & - fadvocn, fbotUse, & - l_stop, stop_label) - !NJ: for bulk conservation fix - !l_stop, stop_label, fsloss) - - if (l_stop) return - - !----------------------------------------------------------------- - ! If prescribed ice, set hi back to old values - !----------------------------------------------------------------- - -#ifdef CCSMCOUPLED - if (present(prescribed_ice)) then - if (prescribed_ice) then - hin = worki - fhocnn = c0 ! for diagnostics - endif - endif -#endif - - !----------------------------------------------------------------- - ! Compute fluxes of water and salt from ice to ocean. - ! evapn < 0 => sublimation, evapn > 0 => condensation - ! aerosol flux is accounted for in ice_aerosol.F90 - !----------------------------------------------------------------- - - dhi = hin - worki - dhs = hsn - works - hsn_new - - freshn = freshn + evapn - (rhoi*dhi + rhos*dhs) / dt - !NJ: for bulk conservation fix - !freshn = freshn + evapn - (rhoi*dhi + rhos*dhs) / dt + fsloss - fsaltn = fsaltn - rhoi*dhi*ice_ref_salinity*p001/dt - fhocnn = fhocnn + fadvocn ! for ktherm=2 - - if (hin == c0) then - if (tr_pond_topo) fpond = fpond - aicen * apond * hpond - endif - - !----------------------------------------------------------------- - ! Given the vertical thermo state variables, compute the new ice - ! state variables. - !----------------------------------------------------------------- - - call update_state_vthermo(nilyr, nslyr, & - Tbot, Tsf, & - hin, hsn, & - zqin, zSin, & - zqsn, & - aicen, & - vicen, vsnon) - - !----------------------------------------------------------------- - ! Reload passive tracer array - !----------------------------------------------------------------- - - end subroutine thermo_vertical - -!======================================================================= -! -! Compute heat flux to bottom surface. -! Compute fraction of ice that melts laterally. -! -! authors C. M. Bitz, UW -! William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine frzmlt_bottom_lateral (dt, ncat, & - nilyr, nslyr, & - aice, frzmlt, & - vicen, vsnon, & - qicen, qsnon, & - sst, Tf, & - ustar_min, & - fbot_xfer_type, & - strocnxT, strocnyT, & - Tbot, fbot, & - rside, Cdn_ocn) - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), intent(in) :: & - aice , & ! ice concentration - frzmlt , & ! freezing/melting potential (W/m^2) - sst , & ! sea surface temperature (C) - Tf , & ! freezing temperature (C) - ustar_min,& ! minimum friction velocity for ice-ocean heat flux - Cdn_ocn , & ! ocean-ice neutral drag coefficient - strocnxT, & ! ice-ocean stress, x-direction - strocnyT ! ice-ocean stress, y-direction - - character (char_len), intent(in) :: & - fbot_xfer_type ! transfer coefficient type for ice-ocean heat flux - - real (kind=dbl_kind), dimension(:), intent(in) :: & - vicen , & ! ice volume (m) - vsnon ! snow volume (m) - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - qicen , & ! ice layer enthalpy (J m-3) - qsnon ! snow layer enthalpy (J m-3) - - real (kind=dbl_kind), intent(out) :: & - Tbot , & ! ice bottom surface temperature (deg C) - fbot , & ! heat flux to ice bottom (W/m^2) - rside ! fraction of ice that melts laterally - - ! local variables - - integer (kind=int_kind) :: & - n , & ! thickness category index - k ! layer index - - real (kind=dbl_kind) :: & - etot , & ! total energy in column - fside ! lateral heat flux (W/m^2) - - real (kind=dbl_kind) :: & - deltaT , & ! SST - Tbot >= 0 - ustar , & ! skin friction velocity for fbot (m/s) - wlat , & ! lateral melt rate (m/s) - xtmp ! temporary variable - - ! Parameters for bottom melting - - real (kind=dbl_kind) :: & - cpchr ! -cp_ocn*rhow*exchange coefficient - - ! Parameters for lateral melting - - real (kind=dbl_kind), parameter :: & - floediam = 300.0_dbl_kind, & ! effective floe diameter (m) - floeshape = 0.66_dbl_kind , & ! constant from Steele (unitless) - m1 = 1.6e-6_dbl_kind , & ! constant from Maykut & Perovich - ! (m/s/deg^(-m2)) - m2 = 1.36_dbl_kind ! constant from Maykut & Perovich - ! (unitless) - - !----------------------------------------------------------------- - ! Identify grid cells where ice can melt. - !----------------------------------------------------------------- - - rside = c0 - Tbot = Tf - fbot = c0 - - if (aice > puny .and. frzmlt < c0) then ! ice can melt - - fside = c0 - - !----------------------------------------------------------------- - ! Use boundary layer theory for fbot. - ! See Maykut and McPhee (1995): JGR, 100, 24,691-24,703. - !----------------------------------------------------------------- - - deltaT = max((sst-Tbot),c0) - - ! strocnx has units N/m^2 so strocnx/rho has units m^2/s^2 - ustar = sqrt (sqrt(strocnxT**2+strocnyT**2)/rhow) - ustar = max (ustar,ustar_min) - - if (trim(fbot_xfer_type) == 'Cdn_ocn') then - ! Note: Cdn_ocn has already been used for calculating ustar - ! (formdrag only) --- David Schroeder (CPOM) - cpchr = -cp_ocn*rhow*Cdn_ocn - else ! fbot_xfer_type == 'constant' - ! 0.006 = unitless param for basal heat flx ala McPhee and Maykut - cpchr = -cp_ocn*rhow*0.006_dbl_kind - endif - - fbot = cpchr * deltaT * ustar ! < 0 - fbot = max (fbot, frzmlt) ! frzmlt < fbot < 0 - -!!! uncomment to use all frzmlt for standalone runs - ! fbot = min (c0, frzmlt) - - !----------------------------------------------------------------- - ! Compute rside. See these references: - ! Maykut and Perovich (1987): JGR, 92, 7032-7044 - ! Steele (1992): JGR, 97, 17,729-17,738 - !----------------------------------------------------------------- - - wlat = m1 * deltaT**m2 ! Maykut & Perovich - rside = wlat*dt*pi/(floeshape*floediam) ! Steele - rside = max(c0,min(rside,c1)) * lateralMeltActive - - !----------------------------------------------------------------- - ! Compute heat flux associated with this value of rside. - !----------------------------------------------------------------- - - do n = 1, ncat - - etot = c0 - - ! melting energy/unit area in each column, etot < 0 - - do k = 1, nslyr - etot = etot + qsnon(k,n) * vsnon(n)/real(nslyr,kind=dbl_kind) - enddo - - do k = 1, nilyr - etot = etot + qicen(k,n) * vicen(n)/real(nilyr,kind=dbl_kind) - enddo ! nilyr - - ! lateral heat flux - fside = fside + rside*etot/dt ! fside < 0 - - enddo ! n - - !----------------------------------------------------------------- - ! Limit bottom and lateral heat fluxes if necessary. - !----------------------------------------------------------------- - - xtmp = frzmlt/(fbot + fside + puny) - xtmp = min(xtmp, c1) - fbot = fbot * xtmp - rside = rside * xtmp - - endif - - end subroutine frzmlt_bottom_lateral - -!======================================================================= -! -! Given the state variables (vicen, vsnon, zqin, etc.), -! compute variables needed for the vertical thermodynamics -! (hin, hsn, zTin, etc.) -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine init_vertical_profile(nilyr, nslyr, & - aicen, vicen, & - vsnon, & - hin, hilyr, & - hsn, hslyr, & - zqin, zTin, & - zqsn, zTsn, & - zSin, & - einit, Tbot, & - l_stop, stop_label) - - use ice_mushy_physics, only: temperature_mush, & - liquidus_temperature_mush, & - enthalpy_of_melting - - use ice_constants_colpkg, only: p1 !!!AKT Column!!! - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), intent(out):: & - hilyr , & ! ice layer thickness - hslyr , & ! snow layer thickness - einit ! initial energy of melting (J m-2) - - real (kind=dbl_kind), intent(in):: & - Tbot ! bottom ice temp (C) - - real (kind=dbl_kind), intent(out):: & - hin , & ! ice thickness (m) - hsn ! snow thickness (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zTin ! internal ice layer temperatures - - real (kind=dbl_kind), dimension (:), intent(in) :: & - zSin ! internal ice layer salinities - - real (kind=dbl_kind), dimension (:), & - intent(out) :: & - zTsn ! snow temperature - - real (kind=dbl_kind), dimension (:), & - intent(inout) :: & - zqsn ! snow enthalpy - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - real (kind=dbl_kind), dimension(nilyr) :: & - Tmlts ! melting temperature - - integer (kind=int_kind) :: & - k ! ice layer index - - real (kind=dbl_kind) :: & - rnslyr, & ! real(nslyr) - Tmax ! maximum allowed snow/ice temperature (deg C) - - logical (kind=log_kind) :: & ! for vector-friendly error checks - tsno_high , & ! flag for zTsn > Tmax - tice_high , & ! flag for zTin > Tmlt - tsno_low , & ! flag for zTsn < Tmin - tice_low ! flag for zTin < Tmin - - character(len=char_len_long) :: & - warning ! warning message - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - rnslyr = real(nslyr,kind=dbl_kind) - - tsno_high = .false. - tice_high = .false. - tsno_low = .false. - tice_low = .false. - - einit = c0 - - !----------------------------------------------------------------- - ! Surface temperature, ice and snow thickness - ! Initialize internal energy - !----------------------------------------------------------------- - - hin = vicen / aicen - hsn = vsnon / aicen - hilyr = hin / real(nilyr,kind=dbl_kind) - hslyr = hsn / rnslyr - - !----------------------------------------------------------------- - ! Snow enthalpy and maximum allowed snow temperature - ! If heat_capacity = F, zqsn and zTsn are used only for checking - ! conservation. - !----------------------------------------------------------------- - - do k = 1, nslyr - - !----------------------------------------------------------------- - ! Tmax based on the idea that dT ~ dq / (rhos*cp_ice) - ! dq ~ q dv / v - ! dv ~ puny = eps11 - ! where 'd' denotes an error due to roundoff. - !----------------------------------------------------------------- - - if (hslyr > hs_min/rnslyr .and. heat_capacity) then - ! zqsn < 0 - Tmax = -zqsn(k)*puny*rnslyr / & - (rhos*cp_ice*vsnon) - else - zqsn (k) = -rhos * Lfresh - Tmax = puny - endif - - !----------------------------------------------------------------- - ! Compute snow temperatures from enthalpies. - ! Note: zqsn <= -rhos*Lfresh, so zTsn <= 0. - !----------------------------------------------------------------- - zTsn(k) = (Lfresh + zqsn(k)/rhos)/cp_ice - - !----------------------------------------------------------------- - ! Check for zTsn > Tmax (allowing for roundoff error) and zTsn < Tmin. - !----------------------------------------------------------------- - if (zTsn(k) > Tmax) then - tsno_high = .true. - elseif (zTsn(k) < Tmin) then - tsno_low = .true. - endif - - enddo ! nslyr - - !----------------------------------------------------------------- - ! If zTsn is out of bounds, print diagnostics and exit. - !----------------------------------------------------------------- - - if (tsno_high .and. heat_capacity) then - do k = 1, nslyr - - if (hslyr > hs_min/rnslyr) then - Tmax = -zqsn(k)*puny*rnslyr / & - (rhos*cp_ice*vsnon) - else - Tmax = puny - endif - - if (zTsn(k) > Tmax) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Starting thermo, zTsn > Tmax, k = ', k - call add_warning(warning) - write(warning,*) 'zTsn=',zTsn(k) - call add_warning(warning) - write(warning,*) 'Tmax=',Tmax - call add_warning(warning) - write(warning,*) 'zqsn',zqsn(k),-Lfresh*rhos,zqsn(k)+Lfresh*rhos - call add_warning(warning) - l_stop = .true. - stop_label = "init_vertical_profile: Starting thermo, zTsn > Tmax" - return - endif - - enddo ! nslyr - endif ! tsno_high - - if (tsno_low .and. heat_capacity) then - do k = 1, nslyr - - if (zTsn(k) < Tmin) then ! allowing for roundoff error - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Starting thermo, zTsn < Tmin, k = ',k - call add_warning(warning) - write(warning,*) 'zTsn=', zTsn(k) - call add_warning(warning) - write(warning,*) 'Tmin=', Tmin - call add_warning(warning) - write(warning,*) 'zqsn', zqsn(k) - call add_warning(warning) - write(warning,*) 'hin', hin - call add_warning(warning) - write(warning,*) 'hsn', hsn - call add_warning(warning) - l_stop = .true. - stop_label = "init_vertical_profile: Starting thermo, zTsn < Tmin" - return - endif - - enddo ! nslyr - endif ! tsno_low - - do k = 1, nslyr - - if (zTsn(k) > c0) then ! correct roundoff error - zTsn(k) = c0 - zqsn(k) = -rhos*Lfresh - endif - - !----------------------------------------------------------------- - ! initial energy per unit area of ice/snow, relative to 0 C - !----------------------------------------------------------------- - einit = einit + hslyr*zqsn(k) - - enddo ! nslyr - - do k = 1, nilyr - - !--------------------------------------------------------------------- - ! Use initial salinity profile for thin ice - !--------------------------------------------------------------------- - - if (ktherm == 1 .and. zSin(k) < min_salin-puny) then - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Starting zSin < min_salin, layer', k - call add_warning(warning) - write(warning,*) 'zSin =', zSin(k) - call add_warning(warning) - write(warning,*) 'min_salin =', min_salin - call add_warning(warning) - l_stop = .true. - stop_label = "init_vertical_profile: Starting zSin < min_salin, layer" - return - endif - - if (ktherm == 2) then - Tmlts(k) = liquidus_temperature_mush(zSin(k)) - else - Tmlts(k) = -zSin(k) * depressT - endif - - !----------------------------------------------------------------- - ! Compute ice enthalpy - ! If heat_capacity = F, zqin and zTin are used only for checking - ! conservation. - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! Compute ice temperatures from enthalpies using quadratic formula - !----------------------------------------------------------------- - - if (ktherm == 2) then - zTin(k) = temperature_mush(zqin(k),zSin(k)) - else - zTin(k) = calculate_Tin_from_qin(zqin(k),Tmlts(k)) - endif - - if (l_brine) then - Tmax = Tmlts(k) - else ! fresh ice - Tmax = -zqin(k)*puny/(rhos*cp_ice*vicen) - endif - - !----------------------------------------------------------------- - ! Check for zTin > Tmax and zTin < Tmin - !----------------------------------------------------------------- - if (zTin(k) > Tmax) then - tice_high = .true. - elseif (zTin(k) < Tmin) then - tice_low = .true. - endif - - !----------------------------------------------------------------- - ! If zTin is out of bounds, print diagnostics and exit. - !----------------------------------------------------------------- - - if (tice_high .and. heat_capacity) then - - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Starting thermo, zTin > Tmax, layer', k - call add_warning(warning) - write(warning,*) 'k:', k - call add_warning(warning) - write(warning,*) 'zTin =',zTin(k),', Tmax=',Tmax - call add_warning(warning) - write(warning,*) 'zSin =',zSin(k) - call add_warning(warning) - write(warning,*) 'hin =',hin - call add_warning(warning) - write(warning,*) 'zqin =',zqin(k) - call add_warning(warning) - write(warning,*) 'qmlt=',enthalpy_of_melting(zSin(k)) - call add_warning(warning) - write(warning,*) 'Tmlt=',Tmlts(k) - call add_warning(warning) - - if (ktherm == 2) then - zqin(k) = enthalpy_of_melting(zSin(k)) - c1 - zTin(k) = temperature_mush(zqin(k),zSin(k)) - write(warning,*) 'Corrected quantities' - call add_warning(warning) - write(warning,*) 'zqin=',zqin(k) - call add_warning(warning) - write(warning,*) 'zTin=',zTin(k) - call add_warning(warning) - else - l_stop = .true. - stop_label = "init_vertical_profile: Starting thermo, zTin > Tmax, layer" - return - endif - endif ! tice_high - - if (tice_low .and. heat_capacity) then - - write(warning,*) ' ' - call add_warning(warning) - write(warning,*) 'Starting thermo, zTin < Tmin, layer', k - call add_warning(warning) - write(warning,*) 'k:', k - call add_warning(warning) - write(warning,*) 'zTin =',zTin(k),', Tmin=',Tmin - call add_warning(warning) - write(warning,*) 'zSin =',zSin(k) - call add_warning(warning) - write(warning,*) 'hin =',hin - call add_warning(warning) - write(warning,*) 'zqin =',zqin(k) - call add_warning(warning) - l_stop = .true. - stop_label = "init_vertical_profile: Starting thermo, zTin < Tmin, layer" - return - endif ! tice_low - - !----------------------------------------------------------------- - ! correct roundoff error - !----------------------------------------------------------------- - - if (ktherm /= 2) then - - if (zTin(k) > c0) then - zTin(k) = c0 - zqin(k) = -rhoi*Lfresh - endif - - endif - -! echmod: is this necessary? -! if (ktherm == 1) then -! if (zTin(k)>= -zSin(k)*depressT) then -! zTin(k) = -zSin(k)*depressT - puny -! zqin(k) = -rhoi*cp_ocn*zSin(k)*depressT -! endif -! endif - - !----------------------------------------------------------------- - ! initial energy per unit area of ice/snow, relative to 0 C - !----------------------------------------------------------------- - - einit = einit + hilyr*zqin(k) - - enddo ! nilyr - - end subroutine init_vertical_profile - -!======================================================================= -! -! Compute growth and/or melting at the top and bottom surfaces. -! Convert snow to ice if necessary. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine thickness_changes (nilyr, nslyr, & - dt, yday, & - efinal, & - hin, hilyr, & - hsn, hslyr, & - zqin, zqsn, & - smice, smliq, & - fbot, Tbot, & - flatn, fsurfn, & - fcondtopn, fcondbot, & - fsnow, hsn_new, & - fhocnn, evapn, & - meltt, melts, & - meltsliq, frain, & - meltb, iage, & - congel, snoice, & - mlt_onset, frz_onset,& - zSin, sss, & - dsnow, tr_snow, & - rsnw, tr_rsnw) - !NJ: for bulk conservation fix - !rsnw, tr_rsnw, & - !fsloss) - - use ice_colpkg_shared, only: phi_i_mushy - use ice_mushy_physics, only: enthalpy_mush, enthalpy_of_melting, & - temperature_mush, liquidus_temperature_mush, & - liquid_fraction - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - yday ! day of the year - - real (kind=dbl_kind), intent(in) :: & - fbot , & ! ice-ocean heat flux at bottom surface (W/m^2) - Tbot , & ! ice bottom surface temperature (deg C) - fsnow , & ! snowfall rate (kg m-2 s-1) - !NJ: for bulk conservation fix - !fsloss , & ! snow loss to leads (kg m-2 s-1) - flatn , & ! surface downward latent heat (W m-2) - fsurfn , & ! net flux to top surface, excluding fcondtopn - fcondtopn , & ! downward cond flux at top surface (W m-2) - frain ! rainfall rate (kg/m2/s) - - real (kind=dbl_kind), intent(inout) :: & - fcondbot ! downward cond flux at bottom surface (W m-2) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zqsn , & ! snow layer enthalpy (J m-3) - rsnw , & ! snow grain radius (10^-6 m) - smice , & ! ice mass tracer in snow (kg/m^3) - smliq ! liquid water mass tracer in snow (kg/m^3) - - real (kind=dbl_kind), intent(inout) :: & - hilyr , & ! ice layer thickness (m) - hslyr ! snow layer thickness (m) - - real (kind=dbl_kind), intent(inout) :: & - meltt , & ! top ice melt (m/step-->cm/day) - melts , & ! snow melt (m/step-->cm/day) - meltsliq , & ! snow melt mass (kg/m^2/step-->kg/m^2/day) - meltb , & ! basal ice melt (m/step-->cm/day) - congel , & ! basal ice growth (m/step-->cm/day) - snoice , & ! snow-ice formation (m/step-->cm/day) - dsnow , & ! snow formation (m/step-->cm/day) - iage , & ! ice age (s) - mlt_onset , & ! day of year that sfc melting begins - frz_onset ! day of year that freezing begins (congel or frazil) - - real (kind=dbl_kind), intent(inout) :: & - hin , & ! total ice thickness (m) - hsn ! total snow thickness (m) - - real (kind=dbl_kind), intent(out):: & - efinal ! final energy of melting (J m-2) - - real (kind=dbl_kind), intent(out):: & - fhocnn , & ! fbot, corrected for any surplus energy (W m-2) - evapn ! ice/snow mass sublimated/condensed (kg m-2 s-1) - - real (kind=dbl_kind), intent(out):: & - hsn_new ! thickness of new snow (m) - - ! changes to zSin in this subroutine are not reloaded into the - ! trcrn array for ktherm /= 2, so we could remove ktherm=2 conditionals - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zSin ! ice layer salinity (ppt) - - real (kind=dbl_kind), intent(in) :: & - sss ! ocean salinity (PSU) - - logical (kind=log_kind), intent(in) :: & - tr_snow , & ! if .true., use snow density tracer - tr_rsnw ! if .true., use snow dynamic snow grain radius, snow liquid and mass - - ! local variables - - real (kind=dbl_kind), parameter :: & - qbotmax = -p5*rhoi*Lfresh ! max enthalpy of ice growing at bottom - - integer (kind=int_kind) :: & - k ! vertical index - - real (kind=dbl_kind) :: & - esub , & ! energy for sublimation, > 0 (J m-2) - econ , & ! energy for condensation, < 0 (J m-2) - etop_mlt , & ! energy for top melting, > 0 (J m-2) - ebot_mlt , & ! energy for bottom melting, > 0 (J m-2) - ebot_gro , & ! energy for bottom growth, < 0 (J m-2) - emlt_atm , & ! total energy of brine, from atmosphere (J m-2) - emlt_ocn ! total energy of brine, to ocean (J m-2) - - real (kind=dbl_kind) :: & - dhi , & ! change in ice thickness - dhs , & ! change in snow thickness - Ti , & ! ice temperature - Ts , & ! snow temperature - qbot , & ! enthalpy of ice growing at bottom surface (J m-3) - qsub , & ! energy/unit volume to sublimate ice/snow (J m-3) - hqtot , & ! sum of h*q for two layers - wk1 , & ! temporary variable - zqsnew , & ! enthalpy of new snow (J m-3) - hstot , & ! snow thickness including new snow (m) - Tmlts , & ! melting temperature - smtot , & ! total ice + liquid mass of snow - smice_precs ! ice mass added to snow due to snowfall (kg/m^2) - !NJ: for bulk conservation fix - !smice_precs , & ! ice mass added to snow due to snowfall (kg/m^2) - !fsnw ! snow fall rate minus loss to leads (kg m-2 s-1) - - real (kind=dbl_kind), dimension (nilyr+1) :: & - zi1 , & ! depth of ice layer boundaries (m) - zi2 ! adjusted depths, with equal hilyr (m) - - real (kind=dbl_kind), dimension (nslyr+1) :: & - zs1 , & ! depth of snow layer boundaries (m) - zs2 ! adjusted depths, with equal hslyr (m) - - real (kind=dbl_kind), dimension (nilyr) :: & - dzi ! ice layer thickness after growth/melting - - real (kind=dbl_kind), dimension (nslyr) :: & - dzs , & ! snow layer thickness after growth/melting - smicetot , & ! total ice mass of snow in each layer (kg/m^2) - smliqtot ! total liquid mass of snow in each layer (kg/m^2) - - real (kind=dbl_kind), dimension (nilyr) :: & - qm , & ! energy of melting (J m-3) = zqin in BL99 formulation - qmlt ! enthalpy of melted ice (J m-3) = zero in BL99 formulation - - real (kind=dbl_kind) :: & - qbotm , & - qbotp , & - qbot0 , & - mass , & ! total snow ice + liq (kg/m2) - massi ! ice mass change factor - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - hsn_new = c0 - - do k = 1, nilyr - dzi(k) = hilyr - enddo - - do k = 1, nslyr - dzs(k) = hslyr - smicetot(k) = c0 - smliqtot(k) = c0 - if (tr_rsnw) then - smicetot(k) = dzs(k) * smice(k) - smliqtot(k) = dzs(k) * smliq(k) - endif - enddo - - do k = 1, nilyr - if (ktherm == 2) then - qmlt(k) = enthalpy_of_melting(zSin(k)) - else - qmlt(k) = c0 - endif - qm(k) = zqin(k) - qmlt(k) - emlt_atm = c0 - emlt_ocn = c0 - enddo - - !----------------------------------------------------------------- - ! For l_brine = false (fresh ice), check for temperatures > 0. - ! Melt ice or snow as needed to bring temperatures back to 0. - ! For l_brine = true, this should not be necessary. - !----------------------------------------------------------------- - - if (.not. l_brine) then - - do k = 1, nslyr - Ts = (Lfresh + zqsn(k)/rhos) / cp_ice - if (Ts > c0) then - dhs = cp_ice*Ts*dzs(k) / Lfresh ! melt - smice_precs = c0 - if (dzs(k) > puny) smice_precs = smicetot(k)/dzs(k) * dhs - smicetot(k) = max(c0,smicetot(k) - smice_precs) ! dhs << dzs - smliqtot(k) = max(c0,smliqtot(k) + smice_precs) - dzs (k) = dzs(k) - dhs - melts = melts + dhs - zqsn(k) = -rhos*Lfresh - endif - enddo - - do k = 1, nilyr - Ti = (Lfresh + zqin(k)/rhoi) / cp_ice - if (Ti > c0) then - dhi = cp_ice*Ti*dzi(k) / Lfresh - dzi(k) = dzi(k) - dhi - zqin(k) = -rhoi*Lfresh - endif - enddo ! k - - endif ! .not. l_brine - - !----------------------------------------------------------------- - ! Compute energy available for sublimation/condensation, top melt, - ! and bottom growth/melt. - !----------------------------------------------------------------- - - wk1 = -flatn * dt - esub = max(wk1, c0) ! energy for sublimation, > 0 - econ = min(wk1, c0) ! energy for condensation, < 0 - - wk1 = (fsurfn - fcondtopn) * dt - etop_mlt = max(wk1, c0) ! etop_mlt > 0 - - wk1 = (fcondbot - fbot) * dt - ebot_mlt = max(wk1, c0) ! ebot_mlt > 0 - ebot_gro = min(wk1, c0) ! ebot_gro < 0 - - !-------------------------------------------------------------- - ! Condensation (evapn > 0) - ! Note: evapn here has unit of kg/m^2. Divide by dt later. - ! This is the only case in which energy from the atmosphere - ! is used for changes in the brine energy (emlt_atm). - !-------------------------------------------------------------- - - evapn = c0 ! initialize - - if (hsn > puny) then ! add snow with enthalpy zqsn(1) - dhs = econ / (zqsn(1) - rhos*Lvap) ! econ < 0, dhs > 0 - smicetot(1) = dhs*rhos + smicetot(1) ! new snow ice - dzs(1) = dzs(1) + dhs - evapn = evapn + dhs*rhos - else ! add ice with enthalpy zqin(1) - dhi = econ / (qm(1) - rhoi*Lvap) ! econ < 0, dhi > 0 - dzi(1) = dzi(1) + dhi - evapn = evapn + dhi*rhoi - ! enthalpy of melt water - emlt_atm = emlt_atm - qmlt(1) * dhi - endif - - !-------------------------------------------------------------- - ! Grow ice (bottom) - !-------------------------------------------------------------- - - if (ktherm == 2) then - - qbotm = enthalpy_mush(Tbot, sss) - qbotp = -Lfresh * rhoi * (c1 - phi_i_mushy) - qbot0 = qbotm - qbotp - - dhi = ebot_gro / qbotp ! dhi > 0 - - hqtot = dzi(nilyr)*zqin(nilyr) + dhi*qbotm - hstot = dzi(nilyr)*zSin(nilyr) + dhi*sss - emlt_ocn = emlt_ocn - qbot0 * dhi - - else - - Tmlts = -zSin(nilyr) * depressT - - ! enthalpy of new ice growing at bottom surface - if (heat_capacity) then - if (l_brine) then - qbot = -rhoi * (cp_ice * (Tmlts-Tbot) & - + Lfresh * (c1-Tmlts/Tbot) & - - cp_ocn * Tmlts) - qbot = min (qbot, qbotmax) ! in case Tbot is close to Tmlt - else - qbot = -rhoi * (-cp_ice * Tbot + Lfresh) - endif - else ! zero layer - qbot = -rhoi * Lfresh - endif - - dhi = ebot_gro / qbot ! dhi > 0 - - hqtot = dzi(nilyr)*zqin(nilyr) + dhi*qbot - hstot = c0 - endif ! ktherm - - dzi(nilyr) = dzi(nilyr) + dhi - if (dzi(nilyr) > puny) then - zqin(nilyr) = hqtot / dzi(nilyr) - if (ktherm == 2) then - zSin(nilyr) = hstot / dzi(nilyr) - qmlt(nilyr) = enthalpy_of_melting(zSin(nilyr)) - else - qmlt(nilyr) = c0 - endif - qm(nilyr) = zqin(nilyr) - qmlt(nilyr) - endif - - ! update ice age due to freezing (new ice age = dt) - ! if (tr_iage) & - ! iage = (iage*hin + dt*dhi) / (hin + dhi) - - ! history diagnostics - congel = congel + dhi - if (dhi > puny .and. frz_onset < puny) & - frz_onset = yday - - do k = 1, nslyr - - !-------------------------------------------------------------- - ! Remove internal snow melt - !-------------------------------------------------------------- - - if (ktherm == 2 .and. zqsn(k) > -rhos * Lfresh) then - - dhs = max(-dzs(k), & - -((zqsn(k) + rhos*Lfresh) / (rhos*Lfresh)) * dzs(k)) ! dhs < 0 - smice_precs = c0 - if (dzs(k) > puny) smice_precs = smicetot(k)/dzs(k) * dhs - smicetot(k) = max(c0,smicetot(k) + smice_precs) ! -dhs <= dzs - smliqtot(k) = max(c0,smliqtot(k) - smice_precs) - dzs (k) = dzs(k) + dhs - zqsn(k) = -rhos * Lfresh - melts = melts - dhs - ! delta E = zqsn(k) + rhos * Lfresh - - endif - - !-------------------------------------------------------------- - ! Sublimation of snow (evapn < 0) - !-------------------------------------------------------------- - - qsub = zqsn(k) - rhos*Lvap ! qsub < 0 - dhs = max (-dzs(k), esub/qsub) ! esub > 0, dhs < 0 - mass = smicetot(k) + smliqtot(k) - massi = c0 - if (dzs(k) > puny) massi = c1 + dhs/dzs(k) - smicetot(k) = smicetot(k) * massi - smliqtot(k) = max(c0, mass + rhos*dhs - smicetot(k)) ! conserve new total mass - dzs(k) = dzs(k) + dhs - esub = esub - dhs*qsub - esub = max(esub, c0) ! in case of roundoff error - evapn = evapn + dhs*rhos - - !-------------------------------------------------------------- - ! Melt snow (top) - !-------------------------------------------------------------- - - dhs = max(-dzs(k), etop_mlt/zqsn(k)) - smice_precs = c0 - if (abs(dzs(k)) > puny) smice_precs = smicetot(k)/dzs(k) * dhs - smicetot(k) = max(c0,smicetot(k) + smice_precs) - smliqtot(k) = max(c0,smliqtot(k) - smice_precs) - dzs(k) = dzs(k) + dhs ! zqsn < 0, dhs < 0 - etop_mlt = etop_mlt - dhs*zqsn(k) - etop_mlt = max(etop_mlt, c0) ! in case of roundoff error - - ! history diagnostics - if (dhs < -puny .and. mlt_onset < puny) & - mlt_onset = yday - melts = melts - dhs - - enddo ! nslyr - - do k = 1, nilyr - - !-------------------------------------------------------------- - ! Sublimation of ice (evapn < 0) - !-------------------------------------------------------------- - - qsub = qm(k) - rhoi*Lvap ! qsub < 0 - dhi = max (-dzi(k), esub/qsub) ! esub < 0, dhi < 0 - dzi(k) = dzi(k) + dhi - esub = esub - dhi*qsub - esub = max(esub, c0) - evapn = evapn + dhi*rhoi - emlt_ocn = emlt_ocn - qmlt(k) * dhi - - !-------------------------------------------------------------- - ! Melt ice (top) - !-------------------------------------------------------------- - - if (qm(k) < c0) then - dhi = max(-dzi(k), etop_mlt/qm(k)) - else - qm(k) = c0 - dhi = -dzi(k) - endif - emlt_ocn = emlt_ocn - max(zqin(k),qmlt(k)) * dhi - - dzi(k) = dzi(k) + dhi ! zqin < 0, dhi < 0 - etop_mlt = max(etop_mlt - dhi*qm(k), c0) - - ! history diagnostics - if (dhi < -puny .and. mlt_onset < puny) & - mlt_onset = yday - meltt = meltt - dhi - - enddo ! nilyr - - do k = nilyr, 1, -1 - - !-------------------------------------------------------------- - ! Melt ice (bottom) - !-------------------------------------------------------------- - - if (qm(k) < c0) then - dhi = max(-dzi(k), ebot_mlt/qm(k)) - else - qm(k) = c0 - dhi = -dzi(k) - endif - emlt_ocn = emlt_ocn - max(zqin(k),qmlt(k)) * dhi - - dzi(k) = dzi(k) + dhi ! zqin < 0, dhi < 0 - ebot_mlt = max(ebot_mlt - dhi*qm(k), c0) - - ! history diagnostics - meltb = meltb -dhi - - enddo ! nilyr - - do k = nslyr, 1, -1 - - !-------------------------------------------------------------- - ! Melt snow (only if all the ice has melted) - !-------------------------------------------------------------- - - ! NJ: if all the ice is melted, should all remaining snow be added to fresh - ! and latent heat to fhocnn? - - dhs = max(-dzs(k), ebot_mlt/zqsn(k)) - - mass = smicetot(k) + smliqtot(k) - massi = c0 - if (dzs(k) > puny) massi = max(c0, c1 + dhs/dzs(k)) - smicetot(k) = smicetot(k) * massi - smliqtot(k) = mass - smicetot(k) ! conserve mass - - dzs(k) = dzs(k) + dhs ! zqsn < 0, dhs < 0 - ebot_mlt = ebot_mlt - dhs*zqsn(k) - ebot_mlt = max(ebot_mlt, c0) - - ! bug fix added by Andrew Roberts, August 5, 2020 - melts = melts - dhs - - enddo ! nslyr - - !----------------------------------------------------------------- - ! Compute heat flux used by the ice (<=0). - ! fhocn is the available ocean heat that is left after use by ice - !----------------------------------------------------------------- - - fhocnn = fbot & - + (esub + etop_mlt + ebot_mlt)/dt - -!---!----------------------------------------------------------------- -!---! Add new snowfall at top surface. -!---!----------------------------------------------------------------- - - !---------------------------------------------------------------- - ! NOTE: If heat flux diagnostics are to work, new snow should - ! have T = 0 (i.e. q = -rhos*Lfresh) and should not be - ! converted to rain. - !---------------------------------------------------------------- - !NJ: for bulk conservation fix - !fsnw = fsnow - fsloss - !if (fsnw > c0) then - - if (fsnow > c0) then - - !NJ: for bulk conservation fix - !fhocnn = fhocnn - Lfresh * fsloss - !hsn_new = fsnw/rhos * dt - hsn_new = fsnow/rhos * dt - zqsnew = -rhos*Lfresh - hstot = dzs(1) + hsn_new - - if (hstot > c0) then - zqsn(1) = (dzs(1) * zqsn(1) & - + hsn_new * zqsnew) / hstot - ! avoid roundoff errors - zqsn(1) = min(zqsn(1), -rhos*Lfresh) - - if (tr_rsnw) then - - smtot = c0 - if (abs(dzs(1)) > c0) smtot = smicetot(1)/dzs(1) !smice(1) ! save for now - - ! ice mass in snow due to snowfall (precs) - ! new snow density = rhos for now - smice_precs = hsn_new * rhos ! kg/m^2 - - ! update ice mass tracer due to snowfall - !NJ: for bulk conservation fix - !smicetot(1) = smicetot(1) + fsnw * dt - smicetot(1) = smicetot(1) + smice_precs - - ! mass fraction of ice due to snowfall - smtot = c0 - do k = 1, nslyr - ! smtot = smtot + smice(k) + smliq(k) - smtot = smtot + smicetot(k) + smliqtot(k) - enddo - if (smtot > c0) then - smice_precs = smice_precs / smtot - else - smice_precs = c1 - endif - - endif - - dzs(1) = hstot - - endif - endif - -!---!----------------------------------------------------------------- -!---! Add rain at top surface (only to liquid tracer) -!---!----------------------------------------------------------------- - - smliqtot(1) = smliqtot(1) + frain*dt - - !----------------------------------------------------------------- - ! Find the new ice and snow thicknesses. - !----------------------------------------------------------------- - - hin = c0 - hsn = c0 - - do k = 1, nilyr - hin = hin + dzi(k) - enddo ! k - - do k = 1, nslyr - hsn = hsn + dzs(k) - dsnow = dsnow + dzs(k) - hslyr - enddo ! k - - !------------------------------------------------------------------- - ! Incorporate new snow for snow grain radius - !------------------------------------------------------------------- - if (tr_rsnw .and. hsn_new > c0) & - call add_new_snow_radius (nslyr, dzs(1), & - hsn_new, rsnw(1), & - rsnw_fall, rsnw_tmax) - - !------------------------------------------------------------------- - ! Convert snow to ice if snow lies below freeboard. - !------------------------------------------------------------------- - - if (ktherm /= 2) & - call freeboard (nslyr, dt, & - snoice, iage, & - hin, hsn, & - zqin, zqsn, & - dzi, dzs, & - dsnow, & - smicetot(:), & - smliqtot(:)) - - !------------------------------------------------------------------- - ! Update snow mass tracers, smice and smliq, for uneven layers - !------------------------------------------------------------------- - if (tr_rsnw) then - do k = 1, nslyr - meltsliq = meltsliq + smliqtot(k) ! total liquid (in case all snow melted) - if (dzs(k) > c0) then - smice(k) = smicetot(k) / dzs(k) - smliq(k) = smliqtot(k) / dzs(k) - else - smice(k) = c0 - smliq(k) = c0 - endif - enddo - endif - -!---!------------------------------------------------------------------- -!---! Repartition the ice and snow into equal-thickness layers, -!---! conserving energy. -!---!------------------------------------------------------------------- - - !----------------------------------------------------------------- - ! Compute desired layer thicknesses. - !----------------------------------------------------------------- - - if (hin > c0) then - hilyr = hin / real(nilyr,kind=dbl_kind) - else - hin = c0 - hilyr = c0 - endif - if (hsn > c0) then - hslyr = hsn / real(nslyr,kind=dbl_kind) - else - hsn = c0 - hslyr = c0 - endif - - !----------------------------------------------------------------- - ! Compute depths zi1 of old layers (unequal thickness). - ! Compute depths zi2 of new layers (equal thickness). - !----------------------------------------------------------------- - - zi1(1) = c0 - zi1(1+nilyr) = hin - - zi2(1) = c0 - zi2(1+nilyr) = hin - - if (heat_capacity) then - - do k = 1, nilyr-1 - zi1(k+1) = zi1(k) + dzi(k) - zi2(k+1) = zi2(k) + hilyr - enddo - - !----------------------------------------------------------------- - ! Conserving energy, compute the enthalpy of the new equal layers. - !----------------------------------------------------------------- - - call adjust_enthalpy (nilyr, & - zi1, zi2, & - hilyr, hin, & - zqin) - - if (ktherm == 2) & - call adjust_enthalpy (nilyr, & - zi1, zi2, & - hilyr, hin, & - zSin) - - else ! zero layer (nilyr=1) - - zqin(1) = -rhoi * Lfresh - zqsn(1) = -rhos * Lfresh - - endif - - if (nslyr > 1) then - - !----------------------------------------------------------------- - ! Compute depths zs1 of old layers (unequal thickness). - ! Compute depths zs2 of new layers (equal thickness). - !----------------------------------------------------------------- - - zs1(1) = c0 - zs1(1+nslyr) = hsn - - zs2(1) = c0 - zs2(1+nslyr) = hsn - - do k = 1, nslyr-1 - zs1(k+1) = zs1(k) + dzs(k) - zs2(k+1) = zs2(k) + hslyr - enddo - - !----------------------------------------------------------------- - ! Conserving energy, compute the enthalpy of the new equal layers. - !----------------------------------------------------------------- - - call adjust_enthalpy (nslyr, & - zs1, zs2, & - hslyr, hsn, & - zqsn) - - if (tr_rsnw) then - call adjust_enthalpy (nslyr, & - zs1(:), zs2(:), & - hslyr, hsn, & - rsnw(:)) - call adjust_enthalpy (nslyr, & - zs1(:), zs2(:), & - hslyr, hsn, & - smice(:)) - call adjust_enthalpy (nslyr, & - zs1(:), zs2(:), & - hslyr, hsn, & - smliq(:)) - - do k = 1, nslyr - smicetot(k) = smice(k) * hslyr - smliqtot(k) = smliq(k) * hslyr - end do - endif - - endif ! nslyr > 1 - - !----------------------------------------------------------------- - ! Remove very thin snow layers (ktherm = 2) - !----------------------------------------------------------------- - - if (ktherm == 2) then - if (hsn <= puny .or. hin <= c0) then - do k = 1, nslyr - fhocnn = fhocnn & - + zqsn(k)*hsn/(real(nslyr,kind=dbl_kind)*dt) - zqsn(k) = -rhos*Lfresh - if (tr_rsnw) then - meltsliq = meltsliq + smicetot(k) ! add to meltponds - smice(k) = rhos - smliq(k) = c0 - endif - if (tr_rsnw) rsnw(k) = rsnw_fall - enddo - melts = melts + hsn - hsn = c0 - hslyr = c0 - endif - endif - - !----------------------------------------------------------------- - ! Compute final ice-snow energy, including the energy of - ! sublimated/condensed ice. - !----------------------------------------------------------------- - - efinal = -evapn*Lvap - evapn = evapn/dt - - do k = 1, nslyr - efinal = efinal + hslyr*zqsn(k) - enddo - - do k = 1, nilyr - efinal = efinal + hilyr*zqin(k) - enddo ! k - - if (ktherm < 2) then - emlt_atm = c0 - emlt_ocn = c0 - endif - - ! melt water is no longer zero enthalpy with ktherm=2 - fhocnn = fhocnn + emlt_ocn/dt - efinal = efinal + emlt_atm ! for conservation check - - end subroutine thickness_changes - -!======================================================================= -! -! If there is enough snow to lower the ice/snow interface below -! sea level, convert enough snow to ice to bring the interface back -! to sea level. -! -! authors William H. Lipscomb, LANL -! Elizabeth C. Hunke, LANL - - subroutine freeboard (nslyr, dt, & - snoice, & - iage, & - hin, hsn, & - zqin, zqsn, & - dzi, dzs, & - dsnow, smicetot, & - smliqtot) - - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), & - intent(inout) :: & - snoice , & ! snow-ice formation (m/step-->cm/day) - dsnow , & ! change in snow thickness after snow-ice formation (m) - iage ! ice age (s) - - real (kind=dbl_kind), & - intent(inout) :: & - hin , & ! ice thickness (m) - hsn ! snow thickness (m) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - zqsn ! snow layer enthalpy (J m-3) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - dzi , & ! ice layer thicknesses (m) - dzs , & ! snow layer thicknesses (m) - smicetot, & ! snow ice mass per layer (kg/m^2) - smliqtot ! snow liquid mass per layer (kg/m^2) - - ! local variables - - integer (kind=int_kind) :: & - k ! vertical index - - real (kind=dbl_kind) :: & - dhin , & ! change in ice thickness (m) - dhsn , & ! change in snow thickness (m) - hqs ! sum of h*q for snow (J m-2) - - real (kind=dbl_kind) :: & - wk1 , & ! temporary variable - dhs ! snow to remove from layer (m) - - !----------------------------------------------------------------- - ! Determine whether snow lies below freeboard. - !----------------------------------------------------------------- - - dhin = c0 - dhsn = c0 - hqs = c0 - - wk1 = hsn - hin*(rhow-rhoi)/rhos ! not yet consistent with smice/smliq - - if (wk1 > puny .and. hsn > puny) then ! snow below freeboard - dhsn = min(wk1*rhoi/rhow, hsn) ! snow to remove - dhin = dhsn * rhos/rhoi ! ice to add - endif - - !----------------------------------------------------------------- - ! Adjust snow layer thickness. - ! Compute energy to transfer from snow to ice. - !----------------------------------------------------------------- - - do k = nslyr, 1, -1 - if (dhin > puny) then - dhs = min(dhsn, dzs(k)) ! snow to remove from layer - smicetot(k) = max(c0,smicetot(k) - dhs * smicetot(k) / dzs(k)) !smice(k) - smliqtot(k) = max(c0,smliqtot(k) - dhs * smliqtot(k) / dzs(k)) !smliq(k) - hsn = hsn - dhs - dsnow = dsnow -dhs !new snow addition term - dzs(k) = dzs(k) - dhs - dhsn = dhsn - dhs - dhsn = max(dhsn,c0) - hqs = hqs + dhs * zqsn(k) - endif ! dhin > puny - enddo - - !----------------------------------------------------------------- - ! Transfer volume and energy from snow to top ice layer. - !----------------------------------------------------------------- - - if (dhin > puny) then - ! update ice age due to freezing (new ice age = dt) - ! if (tr_iage) & - ! iage = (iage*hin+dt*dhin)/(hin+dhin) - - wk1 = dzi(1) + dhin - hin = hin + dhin - zqin(1) = (dzi(1)*zqin(1) + hqs) / wk1 - dzi(1) = wk1 - - ! history diagnostic - snoice = snoice + dhin - endif ! dhin > puny - - end subroutine freeboard - -!======================================================================= -! -! Conserving energy, compute the new enthalpy of equal-thickness ice -! or snow layers. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine adjust_enthalpy (nlyr, & - z1, z2, & - hlyr, hn, & - qn) - - integer (kind=int_kind), intent(in) :: & - nlyr ! number of layers (nilyr or nslyr) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - z1 , & ! interface depth for old, unequal layers (m) - z2 ! interface depth for new, equal layers (m) - - real (kind=dbl_kind), intent(in) :: & - hlyr ! new layer thickness (m) - - real (kind=dbl_kind), intent(in) :: & - hn ! total thickness (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - qn ! layer quantity (enthalpy, salinity...) - - ! local variables - - integer (kind=int_kind) :: & - k, k1, k2 ! vertical indices - - real (kind=dbl_kind) :: & - hovlp ! overlap between old and new layers (m) - - real (kind=dbl_kind) :: & - rhlyr, & ! 1./hlyr - qtot ! total h*q in the column - - real (kind=dbl_kind), dimension (nlyr) :: & - hq ! h * q for a layer - - !----------------------------------------------------------------- - ! Compute reciprocal layer thickness. - !----------------------------------------------------------------- - - rhlyr = c0 - if (hn > puny) then - rhlyr = c1 / hlyr - - !----------------------------------------------------------------- - ! Compute h*q for new layers (k2) given overlap with old layers (k1) - !----------------------------------------------------------------- - - do k2 = 1, nlyr - hq(k2) = c0 - enddo ! k - k1 = 1 - k2 = 1 - do while (k1 <= nlyr .and. k2 <= nlyr) - hovlp = min (z1(k1+1), z2(k2+1)) & - - max (z1(k1), z2(k2)) - hovlp = max (hovlp, c0) - hq(k2) = hq(k2) + hovlp*qn(k1) - if (z1(k1+1) > z2(k2+1)) then - k2 = k2 + 1 - else - k1 = k1 + 1 - endif - enddo ! while - - !----------------------------------------------------------------- - ! Compute new enthalpies. - !----------------------------------------------------------------- - - do k = 1, nlyr - qn(k) = hq(k) * rhlyr - enddo ! k - else - qtot = c0 - do k = 1, nlyr - qtot = qtot + qn(k) * (z1(k+1)-z1(k)) - enddo - if (hn > c0) then - do k = 1, nlyr - qn(k) = qtot/hn - enddo - else - do k = 1, nlyr - qn(k) = c0 - enddo - endif - - endif - - end subroutine adjust_enthalpy - -!======================================================================= -! -! Check for energy conservation by comparing the change in energy -! to the net energy input. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW -! Adrian K. Turner, LANL - - subroutine conservation_check_vthermo(dt, & - fsurfn, flatn, & - fhocnn, fswint, & - fsnow, & - einit, einter, & - efinal, & - fcondtopn,fcondbot, & - fadvocn, fbot, & - l_stop, stop_label) - !NJ: for bulk conservation fix - !l_stop, stop_label, fsloss) - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), intent(in) :: & - fsurfn , & ! net flux to top surface, excluding fcondtopn - flatn , & ! surface downward latent heat (W m-2) - fhocnn , & ! fbot, corrected for any surplus energy - fswint , & ! SW absorbed in ice interior, below surface (W m-2) - fsnow , & ! snowfall rate (kg m-2 s-1) - fcondtopn , & - fadvocn , & - fbot - !NJ: for bulk conservation fix - !fbot , & - !fsloss ! snow loss factor for wind redistribution - - real (kind=dbl_kind), intent(in) :: & - einit , & ! initial energy of melting (J m-2) - einter , & ! intermediate energy of melting (J m-2) - efinal , & ! final energy of melting (J m-2) - fcondbot - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort model - - character (len=*), intent(out) :: & - stop_label ! abort error message - - ! local variables - - real (kind=dbl_kind) :: & - einp , & ! energy input during timestep (J m-2) - ferr , & ! energy conservation error (W m-2) - ftop ! surface flux error: fcondtopn-fsurfn - - character(len=char_len_long) :: & - warning ! warning message - - !---------------------------------------------------------------- - ! If energy is not conserved, print diagnostics and exit. - !---------------------------------------------------------------- - - !----------------------------------------------------------------- - ! Note that fsurf - flat = fsw + flw + fsens; i.e., the latent - ! heat is not included in the energy input, since (efinal - einit) - ! is the energy change in the system ice + vapor, and the latent - ! heat lost by the ice is equal to that gained by the vapor. - !----------------------------------------------------------------- - - einp = (fsurfn - flatn + fswint - fhocnn & - - fsnow*Lfresh - fadvocn) * dt - ferr = abs(efinal-einit-einp) / dt - - if (ferr > ferrmax) then - l_stop = .true. - stop_label = "conservation_check_vthermo: Thermo energy conservation error" - - write(warning,*) 'Thermo energy conservation error' - call add_warning(warning) - write(warning,*) 'Flux error (W/m^2) =', ferr - call add_warning(warning) - write(warning,*) 'Energy error (J) =', ferr*dt - call add_warning(warning) - write(warning,*) 'Initial energy =', einit - call add_warning(warning) - write(warning,*) 'Final energy =', efinal - call add_warning(warning) - write(warning,*) 'efinal - einit =', efinal-einit - call add_warning(warning) - write(warning,*) 'fsurfn,flatn,fswint,fhocn, fsnow*Lfresh:' - !NJ: for bulk conservation fix - !write(warning,*) 'fsurfn,flatn,fswint,fhocn, fsnow*Lfresh, fsloss*Lfresh:' - call add_warning(warning) - write(warning,*) fsurfn,flatn,fswint,fhocnn, fsnow*Lfresh - !NJ: for bulk conservation fix - !write(warning,*) fsurfn,flatn,fswint,fhocnn, fsnow*Lfresh, fsloss*Lfresh - call add_warning(warning) - write(warning,*) 'Input energy =', einp - call add_warning(warning) - write(warning,*) 'fbot,fcondbot:' - call add_warning(warning) - write(warning,*) fbot,fcondbot - call add_warning(warning) - write(warning,*) 'fsurfn,fcondtopn:' - call add_warning(warning) - write(warning,*) fsurfn,fcondtopn - call add_warning(warning) - - ! if (ktherm == 2) then - write(warning,*) 'Intermediate energy =', einter - call add_warning(warning) - write(warning,*) 'efinal - einter =', & - efinal-einter - call add_warning(warning) - write(warning,*) 'einter - einit =', & - einter-einit - call add_warning(warning) - ftop = c0 - if (ktherm == 2) then - if (fcondtopn > fsurfn) ftop = (fcondtopn-fsurfn) - end if - write(warning,*) 'Conduction Error =', (einter-einit) & - - (fcondtopn*dt - fcondbot*dt + fswint*dt) + ftop*dt - call add_warning(warning) - write(warning,*) 'Melt/Growth Error =', (einter-einit) & - + ferr*dt - (fcondtopn*dt - fcondbot*dt + fswint*dt)-ftop*dt - call add_warning(warning) - write(warning,*) 'Advection Error =', fadvocn*dt - call add_warning(warning) - ! endif - - ! write(warning,*) fsurfn,flatn,fswint,fhocnn - ! call add_warning(warning) - - write(warning,*) 'dt*(fsurfn, flatn, fswint, fhocn, fsnow*Lfresh, fadvocn):' - !NJ: for bulk conservation fix - !write(warning,*) 'dt*(fsurfn, flatn, fswint, fhocn, fsnow*Lfresh, fadvocn, fsloss*Lfresh):' - call add_warning(warning) - write(warning,*) fsurfn*dt, flatn*dt, & - fswint*dt, fhocnn*dt, & - fsnow*Lfresh*dt, fadvocn*dt - !NJ: for bulk conservation fix - ! fsnow*Lfresh*dt, fadvocn*dt, fsloss*Lfresh*dt - call add_warning(warning) - return - endif - - end subroutine conservation_check_vthermo - -!======================================================================= -! -! Given the vertical thermo state variables (hin, hsn), -! compute the new ice state variables (vicen, vsnon). -! Zero out state variables if ice has melted entirely. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW -! Elizabeth C. Hunke, LANL - - subroutine update_state_vthermo(nilyr, nslyr, & - Tf, Tsf, & - hin, hsn, & - zqin, zSin, & - zqsn, & - aicen, vicen, & - vsnon) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - Tf ! freezing temperature (C) - - real (kind=dbl_kind), intent(inout) :: & - Tsf ! ice/snow surface temperature, Tsfcn - - real (kind=dbl_kind), intent(in) :: & - hin , & ! ice thickness (m) - hsn ! snow thickness (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - zSin , & ! ice salinity (ppt) - zqsn ! snow layer enthalpy (J m-3) - - real (kind=dbl_kind), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - ! local variables - - integer (kind=int_kind) :: & - k ! ice layer index - - if (hin <= c0) then - aicen = c0 - vicen = c0 - vsnon = c0 - Tsf = Tf - do k = 1, nilyr - zqin(k) = c0 - enddo - if (ktherm == 2) then - do k = 1, nilyr - zSin(k) = c0 - enddo - endif - do k = 1, nslyr - zqsn(k) = c0 - enddo - else - ! aicen is already up to date - vicen = aicen * hin - vsnon = aicen * hsn - endif - - end subroutine update_state_vthermo - -!======================================================================= - -! Modify snow grain radius in upper layer due to fallen snow - - subroutine add_new_snow_radius (nslyr, dzs, hsn_new, rsnw, & - rsnw_fall, rsnw_tmax) - - use ice_constants_colpkg, only: c0, puny - - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - real (kind=dbl_kind), intent(in) :: & - dzs , & ! upper snow layer thickness (m) - hsn_new , & ! new snow fall thickness (m) - rsnw_fall , & ! radius of new snow (10^-6 m) - rsnw_tmax ! maximum radius (10^-6 m) - - real (kind=dbl_kind), & - intent(inout) :: & - rsnw ! upper layer snow radius (10^-6 m) - - rsnw = (hsn_new * rsnw_fall + max(c0,dzs-hsn_new) * rsnw)/ & - (max(hsn_new + max(c0,dzs-hsn_new),puny)) - - rsnw = max(rsnw_fall,min(rsnw_tmax, rsnw)) - - end subroutine add_new_snow_radius - -!======================================================================= - - end module ice_therm_vertical - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_warnings.F90 b/components/mpas-seaice/src/column/ice_warnings.F90 deleted file mode 100644 index 091c8b2be944..000000000000 --- a/components/mpas-seaice/src/column/ice_warnings.F90 +++ /dev/null @@ -1,132 +0,0 @@ -module ice_warnings - - use ice_kinds_mod - - implicit none - - private - save - - ! private warning messages - character(len=char_len_long), dimension(:), allocatable :: & - warnings - - integer :: & - nWarnings - - public :: & - add_warning, & - reset_warnings, & - get_number_warnings, & - get_warning - -!======================================================================= - -contains - -!======================================================================= - - subroutine add_warning(warning) - - character(len=*), intent(in) :: & - warning ! warning to add to array of warnings - - ! number of array elements to increase size of warnings array if that array has run out of space - integer, parameter :: & - nWarningsBuffer = 100 - - ! temporary array to store previous warnings while warning array is increased in size - character(len=char_len_long), dimension(:), allocatable :: & - warningsTmp - - integer :: & - nWarningsArray, & ! size of warnings array at start - iWarning ! warning index - !$omp critical (ice_warnings_add_warning_critical) - ! check if warnings array is not allocated - if (.not. allocated(warnings)) then - - ! allocate warning array with number of buffer elements - allocate(warnings(nWarningsBuffer)) - - ! set initial number of nWarnings - nWarnings = 0 - - ! already allocated - else - - ! find the size of the warnings array at the start - nWarningsArray = size(warnings) - - ! check to see if need more space in warnings array - if (nWarnings + 1 > nWarningsArray) then - - ! allocate the temporary warning storage - allocate(warningsTmp(nWarningsArray)) - - ! copy the warnings to temporary storage - do iWarning = 1, nWarningsArray - warningsTmp(iWarning) = trim(warnings(iWarning)) - enddo ! iWarning - - ! increase the size of the warning array by the buffer size - deallocate(warnings) - allocate(warnings(nWarningsArray + nWarningsBuffer)) - - ! copy back the temporary stored warnings - do iWarning = 1, nWarningsArray - warnings(iWarning) = trim(warningsTmp(iWarning)) - enddo ! iWarning - - ! deallocate the temporary storage - deallocate(warningsTmp) - - endif - - endif - - ! increase warning number - nWarnings = nWarnings + 1 - - ! add the new warning - warnings(nWarnings) = trim(warning) - !$omp end critical (ice_warnings_add_warning_critical) - end subroutine add_warning - -!======================================================================= - - subroutine reset_warnings() - - nWarnings = 0 - - end subroutine reset_warnings - -!======================================================================= - - function get_number_warnings() result(nWarningsOut) - - integer :: nWarningsOut - - nWarningsOut = nWarnings - - end function get_number_warnings - -!======================================================================= - - function get_warning(iWarning) result(warning) - - integer, intent(in) :: iWarning - - character(len=char_len_long) :: warning - - if (iWarning <= nWarnings) then - warning = warnings(iWarning) - else - warning = "" - endif - - end function get_warning - -!======================================================================= - -end module ice_warnings diff --git a/components/mpas-seaice/src/column/ice_zbgc.F90 b/components/mpas-seaice/src/column/ice_zbgc.F90 deleted file mode 100644 index b537fa0140aa..000000000000 --- a/components/mpas-seaice/src/column/ice_zbgc.F90 +++ /dev/null @@ -1,857 +0,0 @@ -! SVN:$Id: ice_zbgc.F90 1175 2017-03-02 19:53:26Z akt $ -!======================================================================= -! -! Biogeochemistry driver -! -! authors: Nicole Jeffery, LANL -! Scott Elliot, LANL -! Elizabeth C. Hunke, LANL -! - module ice_zbgc - - use ice_kinds_mod - use ice_zbgc_shared ! everything - use ice_warnings, only: add_warning - - implicit none - - private - public :: add_new_ice_bgc, lateral_melt_bgc, & - merge_bgc_fluxes, merge_bgc_fluxes_skl - -!======================================================================= - - contains - -!======================================================================= - -! Adjust biogeochemical tracers when new frazil ice forms - - subroutine add_new_ice_bgc (dt, nblyr, & - ncat, nilyr, nbtrcr, & - bgrid, cgrid, igrid, & - aicen_init, vicen_init, vi0_init, & - aicen, vicen, vsnon1, & - vi0new, & - ntrcr, trcrn, & - sss, ocean_bio, flux_bio, & - hsurp, l_stop, & - stop_label, l_conservation_check) - - use ice_constants_colpkg, only: c0, c1, puny, depressT, p5 - use ice_itd, only: column_sum, & - column_conservation_check - use ice_colpkg_tracers, only: tr_brine, nt_fbri, nt_sice, nt_qice, nt_Tsfc, bio_index - use ice_colpkg_shared, only: solve_zsal - use ice_therm_shared, only: calculate_Tin_from_qin - - integer (kind=int_kind), intent(in) :: & - nblyr , & ! number of bio layers - ncat , & ! number of thickness categories - nilyr , & ! number of ice layers - nbtrcr , & ! number of biology tracers - ntrcr ! number of tracers in use - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), dimension (:), & - intent(in) :: & - aicen_init , & ! initial concentration of ice - vicen_init , & ! intiial volume per unit area of ice (m) - aicen , & ! concentration of ice - vicen ! volume per unit area of ice (m) - - real (kind=dbl_kind), intent(in) :: & - vsnon1 ! category 1 snow volume per unit area (m) - - real (kind=dbl_kind), dimension (:,:), & - intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), intent(in) :: & - sss !sea surface salinity (ppt) - - real (kind=dbl_kind), intent(in) :: & - vi0_init , & ! volume of new ice added to cat 1 (intial) - vi0new ! volume of new ice added to cat 1 - - real (kind=dbl_kind), intent(in) :: & - hsurp ! thickness of new ice added to each cat - - real (kind=dbl_kind), dimension (:), & - intent(inout) :: & - flux_bio ! tracer flux to ocean from biology (mmol/m^2/s) - - real (kind=dbl_kind), dimension (:), & - intent(in) :: & - ocean_bio ! ocean concentration of biological tracer - - logical (kind=log_kind), intent(in) :: & - l_conservation_check - - logical (kind=log_kind), intent(inout) :: & - l_stop - - character (char_len), intent(inout) :: stop_label - -! local - - integer (kind=int_kind) :: & - location , & ! 1 (add frazil to bottom), 0 (add frazil throughout) - n , & ! ice category index - k , & ! ice layer index - m , & - nbiolayer - - real (kind=dbl_kind) :: & - vbri1 , & ! starting volume of existing brine - vbri_init , & ! brine volume summed over categories - vbri_final ! brine volume summed over categories - - real (kind=dbl_kind) :: & - vsurp , & ! volume of new ice added to each cat - vtmp ! total volume of new and old ice - - real (kind=dbl_kind), dimension (ncat) :: & - vbrin , & ! trcrn(nt_fbri,n)*vicen(n) - brine_frac_init ! initial trcrn(nt_fbri,n) - - real (kind=dbl_kind) :: & - vice_new , & ! vicen_init + vsurp - bio0new ! ocean_bio * zbgc_init_fac - - real (kind=dbl_kind) :: & - Tmlts ! melting temperature (oC) - - character (len=char_len) :: & - fieldid ! field identifier - - character(len=char_len_long) :: & - warning - - real (kind=dbl_kind), dimension (nblyr+1) :: & - zspace ! vertical grid spacing - - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5*zspace(1) - zspace(nblyr+1) = p5*zspace(nblyr+1) - - !----------------------------------------------------------------- - ! brine - !----------------------------------------------------------------- - vbrin(:) = c0 - do n = 1, ncat - vbrin(n) = vicen_init(n) - if (tr_brine) vbrin(n) = trcrn(nt_fbri,n)*vicen_init(n) - enddo - - call column_sum (ncat, vbrin, vbri_init) - - vbri_init = vbri_init + vi0_init - - do k = 1, nbtrcr - flux_bio(k) = flux_bio(k) - vi0_init/dt*ocean_bio(k)*zbgc_init_frac(k) - enddo - !----------------------------------------------------------------- - ! Distribute bgc in new ice volume among all ice categories by - ! increasing ice thickness, leaving ice area unchanged. - !----------------------------------------------------------------- - - ! Diffuse_bio handles concentration changes from ice growth/melt - ! ice area does not change - ! add salt to the bottom , location = 1 - - vsurp = c0 - vtmp = c0 - - do n = 1,ncat - brine_frac_init(n) = c1 - if (hsurp > c0) then ! add ice to all categories - - vtmp = vbrin(n) - vsurp = hsurp * aicen_init(n) - vbrin(n) = vbrin(n) + vsurp - vice_new = vicen_init(n) + vsurp - if (tr_brine .and. vice_new > c0) then ! NJvicen(n) > c0) then - brine_frac_init(n) = trcrn(nt_fbri,n) !NJ - trcrn(nt_fbri,n) = vbrin(n)/vice_new !NJ vicen(n) - elseif (tr_brine .and. vicen(n) <= c0) then - trcrn(nt_fbri,n) = c1 - endif - - if (nbtrcr > 0) then - do m = 1, nbtrcr - bio0new = ocean_bio(m)*zbgc_init_frac(m) - nbiolayer = nblyr+1 - call update_vertical_bio_tracers(nbiolayer, trcrn(bio_index(m):bio_index(m) + nblyr,n), & - vtmp, vbrin(n), bio0new,zspace(:)) - enddo !nbtrcr - if (l_stop) return - endif ! nbtrcr - endif ! hsurp > 0 - enddo ! n - - !----------------------------------------------------------------- - ! Combine bgc in new ice grown in open water with category 1 ice. - !----------------------------------------------------------------- - - if (vi0new > c0) then - - vbri1 = vbrin(1) - vbrin(1) = vbrin(1) + vi0new - if (tr_brine .and. vicen(1) > c0) then - trcrn(nt_fbri,1) = vbrin(1)/vicen(1) - elseif (tr_brine .and. vicen(1) <= c0) then - trcrn(nt_fbri,1) = c1 - endif - - ! Diffuse_bio handles concentration changes from ice growth/melt - ! ice area changes - ! add salt throughout, location = 0 - - if (nbtrcr > 0 .and. vbrin(1) > c0) then - do m = 1, nbtrcr - bio0new = ocean_bio(m)*zbgc_init_frac(m) - do k = 1, nblyr+1 - trcrn(bio_index(m) + k-1,1) = & - (trcrn(bio_index(m) + k-1,1)*vbri1 + bio0new * vi0new)/vbrin(1) - enddo - enddo - - if (l_stop) return - - if (solve_zsal .and. vsnon1 .le. c0) then - Tmlts = -trcrn(nt_sice,1)*depressT - trcrn(nt_Tsfc,1) = calculate_Tin_from_qin(trcrn(nt_qice,1),Tmlts) - endif ! solve_zsal - endif ! nbtrcr > 0 - endif ! vi0new > 0 - - if (tr_brine .and. l_conservation_check) then - call column_sum (ncat, vbrin, vbri_final) - - fieldid = 'vbrin, add_new_ice_bgc' - call column_conservation_check (fieldid, & - vbri_init, vbri_final, & - puny, l_stop) - - if (l_stop) then - stop_label = 'add_new_ice_bgc: Column conservation error' - return - endif - endif ! l_conservation_check - - end subroutine add_new_ice_bgc - -!======================================================================= - -! When sea ice melts laterally, flux bgc to ocean - - subroutine lateral_melt_bgc (dt, & - ncat, nblyr, & - rside, vicen, & - trcrn, fzsal, & - flux_bio, nbtrcr, & - vicen_init) - - use ice_colpkg_tracers, only: nt_fbri, nt_bgc_S, bio_index - use ice_colpkg_shared, only: solve_zsal, rhosi - use ice_constants_colpkg, only: c1, p001, p5, c0 - - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of thickness categories - nblyr , & ! number of bio layers - nbtrcr ! number of biology tracers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), dimension(:), intent(in) :: & - vicen , & ! volume per unit area of ice (m) - vicen_init - - real (kind=dbl_kind), dimension (:,:), intent(in) :: & - trcrn ! tracer array - - real (kind=dbl_kind), intent(in) :: & - rside ! fraction of ice that melts laterally - - real (kind=dbl_kind), intent(inout) :: & - fzsal ! salt flux from layer Salinity (kg/m^2/s) - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - flux_bio ! biology tracer flux from layer bgc (mmol/m^2/s) - - ! local variables - - integer (kind=int_kind) :: & - k , & ! layer index - m , & ! - n ! category index - - real (kind=dbl_kind), dimension (nblyr+1) :: & - zspace ! vertical grid spacing - - character(len=char_len_long) :: & - warning - - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5*zspace(2) - zspace(nblyr+1) = p5*zspace(nblyr) - - if (solve_zsal) then - do n = 1, ncat - do k = 1,nblyr - fzsal = fzsal + rhosi*trcrn(nt_fbri,n) & - * vicen(n)*p001*zspace(2)*trcrn(nt_bgc_S+k-1,n) & - * rside/dt - enddo - enddo - endif - - do m = 1, nbtrcr - do n = 1, ncat - do k = 1, nblyr+1 - flux_bio(m) = flux_bio(m) + trcrn(nt_fbri,n) & - * vicen_init(n)*zspace(k)*trcrn(bio_index(m)+k-1,n) & - * rside/dt - enddo - enddo - enddo - - end subroutine lateral_melt_bgc - -!======================================================================= -! -! Add new ice tracers to the ice bottom and adjust the vertical profile -! -! author: Nicole Jeffery, LANL - - subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & - aicen, vbrin, & - vicen, trcrn, & - vtmp, & - vsurp, sss, & - nilyr, nblyr, & - solve_zsal, bgrid, & - cgrid, ocean_bio, & - igrid, location, & - l_stop, stop_label) - - use ice_constants_colpkg, only: c1, c0 - use ice_colpkg_tracers, only: nt_sice, nt_bgc_S, bio_index - use ice_colpkg_shared, only: min_salin, salt_loss - - integer (kind=int_kind), intent(in) :: & - location , & ! 1 (add frazil to bottom), 0 (add frazil throughout) - ntrcr , & ! number of tracers in use - nilyr , & ! number of ice layers - nbtrcr , & ! number of biology tracers - nblyr ! number of biology layers - - real (kind=dbl_kind), intent(in) :: & - dt ! timestep (s) - - real (kind=dbl_kind), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume of ice - sss , & ! ocean salinity (ppt) - ! hsurp , & ! flags new ice added to each cat - vsurp , & ! volume of new ice added to each cat - vtmp ! total volume of new and old ice - - real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: & - ocean_bio - - real (kind=dbl_kind), intent(in) :: & - vbrin ! fbri*volume per unit area of ice (m) - - logical (kind=log_kind), intent(in) :: & - solve_zsal - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! zbio grid - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! zsal grid - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE grid - - real (kind=dbl_kind), dimension (ntrcr), & - intent(inout) :: & - trcrn ! ice tracers - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len), intent(inout) :: stop_label - - ! local variables - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0, & ! temporary, remapped tracers - trtmp ! temporary, remapped tracers - - real (kind=dbl_kind) :: & - hin , & ! ice height - hinS_new, & ! brine height - temp_S - - integer (kind=int_kind) :: & - k, m - - real (kind=dbl_kind), dimension (nblyr+1) :: & - C_stationary ! stationary bulk concentration*h (mmol/m^2) - - real (kind=dbl_kind), dimension (nblyr) :: & - S_stationary ! stationary bulk concentration*h (ppt*m) - - real(kind=dbl_kind) :: & - top_conc , & ! salinity or bgc ocean concentration of frazil - fluxb , & ! needed for regrid (set to zero here) - hbri_old , & ! previous timestep brine height - hbri ! brine height - - trtmp0(:) = c0 - trtmp(:) = c0 - fluxb = c0 - - if (location == 1 .and. vbrin > c0) then ! add frazil to bottom - - hbri = vbrin - hbri_old = vtmp - if (solve_zsal) then - top_conc = sss * salt_loss - do k = 1, nblyr - S_stationary(k) = trcrn(nt_bgc_S+k-1)* hbri_old - enddo - call regrid_stationary (S_stationary, hbri_old, & - hbri, dt, & - ntrcr, & - nblyr-1, top_conc, & - bgrid(2:nblyr+1), fluxb,& - l_stop, stop_label) - if (l_stop) return - do k = 1, nblyr - trcrn(nt_bgc_S+k-1) = S_stationary(k)/hbri - trtmp0(nt_sice+k-1) = trcrn(nt_bgc_S+k-1) - enddo - endif ! solve_zsal - - do m = 1, nbtrcr - top_conc = ocean_bio(m)*zbgc_init_frac(m) - do k = 1, nblyr+1 - C_stationary(k) = trcrn(bio_index(m) + k-1)* hbri_old - enddo !k - call regrid_stationary (C_stationary, hbri_old, & - hbri, dt, & - ntrcr, & - nblyr, top_conc, & - igrid, fluxb, & - l_stop, stop_label) - if (l_stop) return - do k = 1, nblyr+1 - trcrn(bio_index(m) + k-1) = C_stationary(k)/hbri - enddo !k - enddo !m - - if (solve_zsal) then - if (aicen > c0) then - hinS_new = vbrin/aicen - hin = vicen/aicen - else - hinS_new = c0 - hin = c0 - endif ! aicen - temp_S = min_salin ! bio to cice - call remap_zbgc(ntrcr, nilyr, & - nt_sice, & - trtmp0(1:ntrcr), trtmp, & - 1, nblyr, & - hin, hinS_new, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1), temp_S, & - l_stop, stop_label) - do k = 1, nilyr - trcrn(nt_sice+k-1) = trtmp(nt_sice+k-1) - enddo ! k - endif ! solve_zsal - - elseif (vbrin > c0) then ! add frazil throughout location == 0 .and. - - do k = 1, nblyr+1 - if (solve_zsal .and. k < nblyr + 1) then - trcrn(nt_bgc_S+k-1) = (trcrn(nt_bgc_S+k-1) * vtmp & - + sss*salt_loss * vsurp) / vbrin - trtmp0(nt_sice+k-1) = trcrn(nt_bgc_S+k-1) - endif ! solve_zsal - do m = 1, nbtrcr - trcrn(bio_index(m) + k-1) = (trcrn(bio_index(m) + k-1) * vtmp & - + ocean_bio(m)*zbgc_init_frac(m) * vsurp) / vbrin - enddo - enddo - - if (solve_zsal) then - if (aicen > c0) then - hinS_new = vbrin/aicen - hin = vicen/aicen - else - hinS_new = c0 - hin = c0 - endif !aicen - temp_S = min_salin ! bio to cice - call remap_zbgc(ntrcr, nilyr, & - nt_sice, & - trtmp0(1:ntrcr), trtmp, & - 1, nblyr, & - hin, hinS_new, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1),temp_S, & - l_stop, stop_label) - do k = 1, nilyr - trcrn(nt_sice+k-1) = trtmp(nt_sice+k-1) - enddo !k - endif ! solve_zsal - - endif ! location - - end subroutine adjust_tracer_profile - -!======================================================================= -! -! Aggregate flux information from all ice thickness categories -! for z layer biogeochemistry -! - subroutine merge_bgc_fluxes (dt, nblyr, & - bio_index, n_algae, & - nbtrcr, aicen, & - vicen, vsnon, & - ntrcr, iphin, & - trcrn, aice_init, & - flux_bion, flux_bio, & - upNOn, upNHn, & - upNO, upNH, & - zbgc_snown, zbgc_atmn, & - zbgc_snow, zbgc_atm, & - PP_net, ice_bio_net,& - snow_bio_net, grow_alg, & - grow_net, totalChla, & - nslyr, iTin, & - iSin, & - bioPorosityIceCell, & - bioSalinityIceCell, & - bioTemperatureIceCell) - - use ice_constants_colpkg, only: c1, c0, p5, secday, puny - use ice_colpkg_shared, only: solve_zbgc, max_nbtrcr, hs_ssl, R_C2N, & - fr_resp, R_chl2N - use ice_colpkg_tracers, only: nt_bgc_N, nt_fbri, nlt_bgc_N - - real (kind=dbl_kind), intent(in) :: & - dt ! timestep (s) - - integer (kind=int_kind), intent(in) :: & - nblyr, & - nslyr, & ! number of snow layers - n_algae, & ! - ntrcr, & ! number of tracers - nbtrcr ! number of biology tracer tracers - - integer (kind=int_kind), dimension(:), intent(in) :: & - bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N - - real (kind=dbl_kind), dimension (:), intent(in) :: & - trcrn , & ! input tracer fields - iphin , & ! porosity - iTin , & ! temperature per cat on vertical bio interface points (oC) - iSin ! salinity per cat on vertical bio interface points (ppt) - - real (kind=dbl_kind), intent(in):: & - aicen , & ! concentration of ice - vicen , & ! volume of ice (m) - vsnon , & ! volume of snow(m) - aice_init ! initial concentration of ice - - ! single category rates - real (kind=dbl_kind), dimension(:), intent(in):: & - zbgc_snown , & ! bio flux from snow to ice per cat (mmol/m^3*m) - zbgc_atmn , & ! bio flux from atm to ice per cat (mmol/m^3*m) - flux_bion - - ! single category rates - real (kind=dbl_kind), dimension(:,:), intent(in):: & - upNOn , & ! nitrate uptake rate per cat (mmol/m^3/s) - upNHn , & ! ammonium uptake rate per cat (mmol/m^3/s) - grow_alg ! algal growth rate per cat (mmolN/m^3/s) - - ! cumulative fluxes - real (kind=dbl_kind), dimension(:), intent(inout):: & - flux_bio , & ! - zbgc_snow , & ! bio flux from snow to ice per cat (mmol/m^2/s) - zbgc_atm , & ! bio flux from atm to ice per cat (mmol/m^2/s) - ice_bio_net, & ! integrated ice tracers mmol or mg/m^2) - snow_bio_net, &! integrated snow tracers mmol or mg/m^2) - bioPorosityIceCell, & ! average cell porosity on interface points - bioSalinityIceCell, & ! average cell salinity on interface points (ppt) - bioTemperatureIceCell ! average cell temperature on interface points (oC) - - ! cumulative variables and rates - real (kind=dbl_kind), intent(inout):: & - PP_net , & ! net PP (mg C/m^2/d) times aice - grow_net , & ! net specific growth (m/d) times vice - upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice - upNH , & ! tot ammonium uptake rate (mmol/m^2/d) times aice - totalChla ! total Chla (mg chla/m^2) - - ! local variables - - real (kind=dbl_kind) :: & - tmp , & ! temporary - dvssl , & ! volume of snow surface layer (m) - dvint ! volume of snow interior (m) - - integer (kind=int_kind) :: & - k, mm ! tracer indice - - real (kind=dbl_kind), dimension (nblyr+1) :: & - zspace - - !----------------------------------------------------------------- - ! Column summation - !----------------------------------------------------------------- - zspace(:) = c1/real(nblyr,kind=dbl_kind) - zspace(1) = p5/real(nblyr,kind=dbl_kind) - zspace(nblyr+1) = p5/real(nblyr,kind=dbl_kind) - - do mm = 1, nbtrcr - do k = 1, nblyr+1 - ice_bio_net(mm) = ice_bio_net(mm) & - + trcrn(bio_index(mm)+k-1) & - * trcrn(nt_fbri) & - * vicen*zspace(k) - enddo ! k - - !----------------------------------------------------------------- - ! Merge fluxes - !----------------------------------------------------------------- - dvssl = min(p5*vsnon/real(nslyr,kind=dbl_kind), hs_ssl*aicen) ! snow surface layer - dvint = vsnon - dvssl ! snow interior - snow_bio_net(mm) = snow_bio_net(mm) & - + trcrn(bio_index(mm)+nblyr+1)*dvssl & - + trcrn(bio_index(mm)+nblyr+2)*dvint - flux_bio (mm) = flux_bio (mm) + flux_bion (mm)*aicen - zbgc_snow (mm) = zbgc_snow(mm) + zbgc_snown(mm)*aicen/dt - zbgc_atm (mm) = zbgc_atm (mm) + zbgc_atmn (mm)*aicen/dt - - enddo ! mm - ! diagnostics : mean cell bio interface grid profiles - do k = 1, nblyr+1 - bioPorosityIceCell(k) = bioPorosityIceCell(k) + iphin(k)*vicen - bioSalinityIceCell(k) = bioSalinityIceCell(k) + iSin(k)*vicen - bioTemperatureIceCell(k) = bioTemperatureIceCell(k) + iTin(k)*vicen - end do - if (solve_zbgc) then - do mm = 1, n_algae - totalChla = totalChla + ice_bio_net(nlt_bgc_N(mm))*R_chl2N(mm) - do k = 1, nblyr+1 - tmp = iphin(k)*trcrn(nt_fbri)*vicen*zspace(k)*secday - PP_net = PP_net + grow_alg(k,mm)*tmp & - * (c1-fr_resp)* R_C2N(mm)*R_gC2molC - grow_net = grow_net + grow_alg(k,mm)*tmp & - / (trcrn(nt_bgc_N(mm)+k-1)+puny) - upNO = upNO + upNOn (k,mm)*tmp - upNH = upNH + upNHn (k,mm)*tmp - enddo ! k - enddo ! mm - endif - - end subroutine merge_bgc_fluxes - -!======================================================================= - -! Aggregate flux information from all ice thickness categories -! for skeletal layer biogeochemistry -! -! author: Elizabeth C. Hunke and William H. Lipscomb, LANL - - subroutine merge_bgc_fluxes_skl (ntrcr, & - nbtrcr, n_algae, & - aicen, trcrn, & - flux_bion, flux_bio, & - PP_net, upNOn, & - upNHn, upNO, & - upNH, grow_net, & - grow_alg, totalChla) - - use ice_constants_colpkg, only: c1, secday, puny, sk_l - use ice_colpkg_tracers, only: nt_bgc_N - use ice_colpkg_shared, only: R_C2N, fr_resp, R_chl2N - - integer (kind=int_kind), intent(in) :: & - ntrcr , & ! number of cells with aicen > puny - nbtrcr , & ! number of bgc tracers - n_algae ! number of autotrophs - - ! single category fluxes - real (kind=dbl_kind), intent(in):: & - aicen ! category ice area fraction - - real (kind=dbl_kind), dimension (:), intent(in) :: & - trcrn ! Bulk tracer concentration (mmol N or mg/m^3) - - real (kind=dbl_kind), dimension(:), intent(in):: & - flux_bion ! all bio fluxes to ocean, on categories - - real (kind=dbl_kind), dimension(:), intent(inout):: & - flux_bio ! all bio fluxes to ocean, aggregated - - real (kind=dbl_kind), dimension(:), intent(in):: & - grow_alg, & ! algal growth rate (mmol/m^3/s) - upNOn , & ! nitrate uptake rate per cat (mmol/m^3/s) - upNHn ! ammonium uptake rate per cat (mmol/m^3/s) - - ! history output - real (kind=dbl_kind), intent(inout):: & - PP_net , & ! Bulk net PP (mg C/m^2/s) - grow_net, & ! net specific growth (/s) - upNO , & ! tot nitrate uptake rate (mmol/m^2/s) - upNH , & ! tot ammonium uptake rate (mmol/m^2/s) - totalChla ! total algal chla (mg chla/m^2) - - ! local variables - - integer (kind=int_kind) :: & - k, mm ! tracer indices - - real (kind=dbl_kind) :: & - tmp ! temporary - - !----------------------------------------------------------------- - ! Merge fluxes - !----------------------------------------------------------------- - - do k = 1,nbtrcr - flux_bio (k) = flux_bio(k) + flux_bion(k)*aicen - enddo - - do mm = 1, n_algae - tmp = phi_sk * sk_l * aicen * secday - PP_net = PP_net & - + grow_alg(mm) * tmp & - * R_C2N(mm) * R_gC2molC * (c1-fr_resp) - grow_net = grow_net & - + grow_alg(mm) * tmp & - / (trcrn(nt_bgc_N(mm))+puny) - totalChla = totalChla + trcrn(nt_bgc_N(mm))* sk_l * aicen * & - R_chl2N(mm) - upNO = upNO + upNOn(mm) * tmp - upNH = upNH + upNHn(mm) * tmp - enddo - - end subroutine merge_bgc_fluxes_skl -!======================================================================= -! -! Given some added new ice to the base of the existing ice, recalculate -! vertical bio tracer so that new grid cells are all the same size. -! -! author: N. Jeffery, LANL -! - subroutine update_vertical_bio_tracers(nbiolyr, trc, h1, h2, trc0, zspace) - - use ice_constants_colpkg, only: c0, puny - - integer (kind=int_kind), intent(in) :: & - nbiolyr ! number of bio layers nblyr+1 - - real (kind=dbl_kind), dimension(:), intent(inout) :: & - trc ! vertical tracer - - real (kind=dbl_kind), intent(in) :: & - h1, & ! old thickness - h2, & ! new thickness - trc0 ! tracer value of added ice on ice bottom - - real (kind=dbl_kind), dimension(nbiolyr), intent(in) :: & - zspace - - ! local variables - - real(kind=dbl_kind), dimension(nbiolyr) :: trc2 ! updated tracer temporary - - ! vertical indices for old and new grid - integer :: k1, k2 - - real (kind=dbl_kind) :: & - z1a, z1b, & ! upper, lower boundary of old cell/added new ice at bottom - z2a, z2b, & ! upper, lower boundary of new cell - overlap , & ! overlap between old and new cell - rnilyr - - !rnilyr = real(nilyr,dbl_kind) - z2a = c0 - z2b = c0 - - if (h2 > puny) then - ! loop over new grid cells - do k2 = 1, nbiolyr - - ! initialize new tracer - trc2(k2) = c0 - - ! calculate upper and lower boundary of new cell - z2a = z2b !((k2 - 1) * h2) * zspace(k2)+z2b ! / rnilyr - z2b = z2b + h2 * zspace(k2) !(k2 * h2) * zspace(k2)+z2a !/ rnilyr - - z1a = c0 - z1b = c0 - ! loop over old grid cells - do k1 = 1, nbiolyr - - ! calculate upper and lower boundary of old cell - z1a = z1b !((k1 - 1) * h1) * zspace(k1)+z1b !/ rnilyr - z1b = z1b + h1 * zspace(k1) !(k1 * h1) * zspace(k1)+z1a !/ rnilyr - - ! calculate overlap between old and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - - ! aggregate old grid cell contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc(k1) - - enddo ! k1 - - ! calculate upper and lower boundary of added new ice at bottom - z1a = h1 - z1b = h2 - - ! calculate overlap between added ice and new cell - overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - ! aggregate added ice contribution to new cell - trc2(k2) = trc2(k2) + overlap * trc0 - ! renormalize new grid cell - trc2(k2) = trc2(k2)/zspace(k2)/h2 !(rnilyr * trc2(k2)) / h2 - - enddo ! k2 - else - trc2 = trc - endif ! h2 > 0 - ! update vertical tracer array with the adjusted tracer - trc = trc2 - - end subroutine update_vertical_bio_tracers - -!======================================================================= - - end module ice_zbgc - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_zbgc_shared.F90 b/components/mpas-seaice/src/column/ice_zbgc_shared.F90 deleted file mode 100644 index 130f03168736..000000000000 --- a/components/mpas-seaice/src/column/ice_zbgc_shared.F90 +++ /dev/null @@ -1,534 +0,0 @@ -! SVN:$Id: ice_zbgc_shared.F90 1166 2017-02-12 22:56:19Z njeffery $ -!======================================================================= -! -! Biogeochemistry variables -! -! authors: Nicole Jeffery, LANL -! Scott Elliot, LANL -! Elizabeth C. Hunke, LANL -! - module ice_zbgc_shared - - use ice_kinds_mod - use ice_constants_colpkg, only: p01, p1, p5, c0, c1 - use ice_colpkg_shared, only: max_nbtrcr, max_algae, max_doc, & - max_dic, max_aero, max_don, max_fe - - implicit none - - private - public :: calculate_qin_from_Sin, remap_zbgc, & - zap_small_bgc, regrid_stationary - - ! bio parameters for algal_dyn - - real (kind=dbl_kind), dimension(max_algae), public :: & - R_Si2N , & ! algal Sil to N (mole/mole) - R_S2N , & ! algal S to N (mole/mole) - ! Marchetti et al 2006, 3 umol Fe/mol C for iron limited Pseudo-nitzschia - R_Fe2C , & ! algal Fe to carbon (umol/mmol) - R_Fe2N ! algal Fe to N (umol/mmol) - - real (kind=dbl_kind), dimension(max_don), public :: & - R_Fe2DON ! Fe to N of DON (nmol/umol) - - real (kind=dbl_kind), dimension(max_doc), public :: & - R_Fe2DOC ! Fe to C of DOC (nmol/umol) - - ! polysaccharids, lipids, proteins+nucleic acids (Lonborg et al. 2020) - real (kind=dbl_kind), dimension(max_doc), parameter, public :: & - doc_pool_fractions = (/0.26_dbl_kind, 0.17_dbl_kind, 0.57_dbl_kind/) - - real (kind=dbl_kind), parameter, public :: & - R_gC2molC = 12.01_dbl_kind ! mg/mmol C - - ! scavenging coefficient for tracers in snow - ! bottom to last 6 are from Flanner et al., 2007 - ! very last one is for humic material - real (kind=dbl_kind), parameter, dimension(max_nbtrcr), public :: & - kscavz = (/ 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & - 0.03_dbl_kind, & - 0.03_dbl_kind, 0.20_dbl_kind, 0.02_dbl_kind, & - 0.02_dbl_kind, 0.01_dbl_kind, 0.01_dbl_kind, & - 0.03_dbl_kind /) - - !----------------------------------------------------------------- - ! skeletal layer biogeochemistry - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter, public :: & - phi_sk = 0.30_dbl_kind ! skeletal layer porosity - - !----------------------------------------------------------------- - ! general biogeochemistry - !----------------------------------------------------------------- - - real (kind=dbl_kind), dimension(max_nbtrcr), public :: & - zbgc_frac_init,&! initializes mobile fraction - bgc_tracer_type ! described tracer in mobile or stationary phases - ! < 0 is purely mobile (eg. nitrate) - ! > 0 has timescales for transitions between - ! phases based on whether the ice is melting or growing - - real (kind=dbl_kind), dimension(max_nbtrcr), public :: & - zbgc_init_frac, & ! fraction of ocean tracer concentration in new ice - tau_ret, & ! retention timescale (s), mobile to stationary phase - tau_rel ! release timescale (s), stationary to mobile phase - - !----------------------------------------------------------------- - ! From algal_dyn in ice_algae.F90 but not in namelist - !----------------------------------------------------------------- - - real (kind=dbl_kind), dimension(max_algae), public :: & - chlabs , & ! chla absorption 1/m/(mg/m^3) - alpha2max_low , & ! light limitation (1/(W/m^2)) - beta2max , & ! light inhibition (1/(W/m^2)) - mu_max , & ! maximum growth rate (1/d) - grow_Tdep , & ! T dependence of growth (1/C) - fr_graze , & ! fraction of algae grazed - mort_pre , & ! mortality (1/day) - mort_Tdep , & ! T dependence of mortality (1/C) - k_exude , & ! algal carbon exudation rate (1/d) - K_Nit , & ! nitrate half saturation (mmol/m^3) - K_Am , & ! ammonium half saturation (mmol/m^3) - K_Sil , & ! silicon half saturation (mmol/m^3) - K_Fe ! iron half saturation or micromol/m^3 - - real (kind=dbl_kind), dimension(max_DON), public :: & - f_don , & ! fraction of spilled grazing to DON - kn_bac , & ! Bacterial degredation of DON (1/d) - f_don_Am ! fraction of remineralized DON to Am - - real (kind=dbl_kind), dimension(max_DOC), public :: & - f_doc , & ! fraction of mort_N that goes to each doc pool - f_exude , & ! fraction of exuded carbon to each DOC pool - k_bac ! Bacterial degredation of DOC (1/d) - - !----------------------------------------------------------------- - ! brine - !----------------------------------------------------------------- - - integer (kind=int_kind), parameter, public :: & - exp_h = 3 ! power law for hierarchical model - - real (kind=dbl_kind), parameter, public :: & - k_o = 3.e-8_dbl_kind, & ! permeability scaling factor (m^2) - thinS = 0.05_dbl_kind ! minimum ice thickness for brine - - real (kind=dbl_kind), public :: & - flood_frac ! fraction of ocean/meltwater that floods !***** - - real (kind=dbl_kind), parameter, public :: & - bphimin = 0.03_dbl_kind ! minimum porosity for zbgc only - -!----------------------------------------------------------------------- -! Parameters for zsalinity -!----------------------------------------------------------------------- - - real (kind=dbl_kind), parameter, public :: & - viscos_dynamic = 2.2_dbl_kind , & ! 1.8e-3_dbl_kind (pure water at 0^oC) (kg/m/s) - Dm = 1.0e-9_dbl_kind, & ! molecular diffusion (m^2/s) - Ra_c = 0.05_dbl_kind ! critical Rayleigh number for bottom convection - -!======================================================================= - - contains - -!======================================================================= -! -! Compute the internal ice enthalpy using new salinity and Tin -! - - function calculate_qin_from_Sin (Tin, Tmltk) & - result(qin) - - use ice_constants_colpkg, only: c1, rhoi, cp_ocn, cp_ice, Lfresh - - real (kind=dbl_kind), intent(in) :: & - Tin ,& ! internal temperature - Tmltk ! melting temperature at one level - - ! local variables - - real (kind=dbl_kind) :: & - qin ! melting temperature at one level - - qin =-rhoi*(cp_ice*(Tmltk-Tin) + Lfresh*(c1-Tmltk/Tin) - cp_ocn*Tmltk) - - end function calculate_qin_from_Sin - -!======================================================================= -! -! Remaps tracer fields in a given category from one set of layers to another. -! Grids can be very different and so can vertical spaces. - - subroutine remap_zbgc(ntrcr, nlyrn, & - it, & - trcrn, trtmp, & - nr0, nbyrn, & - hice, hinS, & - ice_grid, bio_grid, & - S_min, l_stop, & - stop_label) - - integer (kind=int_kind), intent(in) :: & - ntrcr , & ! number of tracers in use - it , & ! tracer index in top layer - nr0 , & ! receiver category - nlyrn , & ! number of ice layers - nbyrn ! number of biology layers - - real (kind=dbl_kind), dimension (:), intent(in) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - trtmp ! temporary, remapped ice tracers - - real (kind=dbl_kind), dimension (:), intent(in) :: & - ice_grid ! CICE grid cgrid(2:nilyr+1) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - bio_grid ! CICE grid grid(2:nbyrn+1) - - real(kind=dbl_kind), intent(in) :: & - hice , & ! CICE ice thickness - hinS , & ! brine height - S_min ! for salinity on CICE grid - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len), intent(inout) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - kd, kr, kdr , & ! more indices - kdi , & ! more indices - n_nd , & ! number of layers in donor - n_nr, n_plus ! number of layers in receiver - - real (kind=dbl_kind), dimension (nbyrn+3+nlyrn) :: & - trdr , & ! combined tracer - trgrid ! combined grid - - real (kind=dbl_kind), dimension (nbyrn+nlyrn+3) :: & - tracer , & ! temporary, ice tracers values - dgrid , & ! temporary, donor grid dimensional - rgrid ! temporary, receiver grid dimensional - - if ((hinS < c0) .OR. (hice < c0)) then - l_stop = .true. - stop_label = 'ice: remap_layers_bgc error' - return - endif - - if (nr0 == 0) then ! cice to bio - - n_nd = nlyrn - n_nr = nbyrn - n_plus = 2 - dgrid (1) = min(-hice+hinS, -hinS+hice, c0) - dgrid (nlyrn+2) = min(hinS, hice) - tracer(1) = trcrn(it) - tracer(nlyrn+2) = trcrn(it+nlyrn-1) - rgrid (nbyrn+2) = min(hinS, hice) - if (hice > hinS) then - rgrid(1) = c0 - do kr = 1,n_nr - rgrid(kr+1) = bio_grid(kr)*hinS - enddo - do kd = 1,n_nd - dgrid(kd+1) = (ice_grid(kd)-c1)*hice+hinS - tracer(kd+1) = trcrn(it+kd-1) - enddo - else - rgrid(1) = -hinS + hice - do kr = 1,n_nr - rgrid(kr+1) = (bio_grid(kr)-c1)*hinS + hice - enddo - do kd = 1,n_nd - dgrid(kd+1) = ice_grid(kd)*hice - tracer(kd+1) = trcrn(it+kd-1) - enddo - endif - - else ! bio to cice - - n_nd = nbyrn - n_nr = nlyrn - if (hice > hinS) then ! add S_min to top layer - n_plus = 3 - tracer(1) = S_min - tracer(2) = S_min - rgrid (1) = -hice + hinS - rgrid (nlyrn+n_plus-1) = hinS - do kr = 1,n_nr - rgrid(kr+1) = (ice_grid(kr)-c1)*hice+ hinS - enddo - dgrid (1) = -hice+hinS - dgrid (2) = (hinS-hice)*p5 - dgrid (nbyrn+n_plus) = hinS - tracer(nbyrn+n_plus) = trcrn(it+nbyrn-1) - do kd = 1,n_nd - dgrid(kd+2) = bio_grid(kd)*hinS - tracer(kd+2) = trcrn(it+kd-1) - enddo - tracer(n_plus) = (S_min*(hice-hinS) + & - tracer(n_plus)*p5*(dgrid(n_plus+1)-dgrid(n_plus)))/ & - (hice-hinS+ p5*(dgrid(n_plus+1)-dgrid(n_plus))) - tracer(1) = tracer(n_plus) - tracer(2) = tracer(n_plus) - else - n_plus = 2 - tracer(1) = trcrn(it) - tracer(nbyrn+2) = trcrn(it+nbyrn-1) - dgrid (1) = hice-hinS - dgrid (nbyrn+2) = hice - rgrid (nlyrn+2) = hice - rgrid (1) = c0 - do kd = 1,n_nd - dgrid(kd+1) = (bio_grid(kd)-c1)*hinS + hice - tracer(kd+1) = trcrn(it+kd-1) - enddo - do kr = 1,n_nr - rgrid(kr+1) = ice_grid(kr)*hice - enddo - endif - - endif - - kdr = 0 ! combined indices - kdi = 1 - - do kr = 1, n_nr - do kd = kdi, n_nd+n_plus - if (dgrid(kd) < rgrid(kr+1)) then - kdr = kdr+1 - trgrid(kdr) = dgrid(kd) - trdr (kdr) = tracer(kd) - elseif (dgrid(kd) > rgrid(kr+1)) then - kdr = kdr + 1 - kdi = kd - trgrid(kdr) = rgrid(kr+1) - trtmp (it+kr-1) = trdr(kdr-1) & - + (rgrid(kr+1) - trgrid(kdr-1)) & - * (tracer(kd) - trdr(kdr-1)) & - / (dgrid(kd) - trgrid(kdr-1)) - trdr(kdr) = trtmp(it+kr-1) - EXIT - else - kdr = kdr+1 - kdi = kd+1 - trgrid(kdr) = rgrid(kr+1) - trtmp (it+kr-1) = tracer(kd) - trdr (kdr) = tracer(kd) - EXIT - endif - enddo - enddo - - end subroutine remap_zbgc - -!======================================================================= - -! remove tracer for very small fractional areas - - subroutine zap_small_bgc (zlevels, dflux_bio, & - dt, zvol, btrcr) - - integer (kind=int_kind), intent(in) :: & - zlevels ! number of vertical levels in ice - - real (kind=dbl_kind), intent(in) :: & - dt ! time step (s) - - real (kind=dbl_kind), intent(inout) :: & - dflux_bio ! zapped bio tracer flux from biology (mmol/m^2/s) - - real (kind=dbl_kind), dimension (zlevels), intent(in) :: & - btrcr , & ! zapped bio tracer flux from biology (mmol/m^2/s) - zvol ! ice volume (m) - - ! local variables - - integer (kind=int_kind) :: & - k ! layer index - - do k = 1, zlevels - dflux_bio = dflux_bio + btrcr(k)*zvol(k)/dt - enddo - - end subroutine zap_small_bgc - -!======================================================================= -! -! authors Nicole Jeffery, LANL - - subroutine regrid_stationary (C_stationary, hbri_old, & - hbri, dt, & - ntrcr, nblyr, & - top_conc, igrid, & - flux_bio, & - l_stop, stop_label, & - melt_b, con_gel) - - use ice_constants_colpkg, only: c0, c1, p5, puny - - integer (kind=int_kind), intent(in) :: & - ntrcr, & ! number of tracers - nblyr ! number of bio layers - - real (kind=dbl_kind), intent(inout) :: & - flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - C_stationary ! stationary bulk concentration*h (mmol/m^2) - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! CICE bio grid - - real(kind=dbl_kind), intent(in) :: & - dt , & ! time step - top_conc , & ! c0 or frazil concentration - hbri_old , & ! previous timestep brine height - hbri ! brine height - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len), intent(inout) :: stop_label - - real(kind=dbl_kind), intent(in), optional :: & - melt_b, & ! bottom melt (m) - con_gel ! bottom growth (m) - - ! local variables - - integer (kind=int_kind) :: k, n, nt, nr - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0, & ! temporary, remapped tracers - trtmp - - real (kind=dbl_kind):: & - meltb, & ! ice bottom melt (m) - congel, & ! ice bottom growth (m) - htemp, & ! ice thickness after melt (m) - dflux, & ! regrid flux correction (mmol/m^2) - sum_i, & ! total tracer before melt loss - sum_f, & ! total tracer after melt - neg_flux, & - hice, & - hbio - - real (kind=dbl_kind), dimension(nblyr+1):: & - zspace - - ! initialize - - zspace(:) = c1/(real(nblyr,kind=dbl_kind)) - zspace(1) = p5*zspace(1) - zspace(nblyr+1) = zspace(1) - trtmp0(:) = c0 - trtmp(:) = c0 - meltb = c0 - nt = 1 - nr = 0 - sum_i = c0 - sum_f = c0 - meltb = c0 - congel = c0 - dflux = c0 - - !--------------------- - ! compute initial sum - !---------------------- - - do k = 1, nblyr+1 - sum_i = sum_i + C_stationary(k)*zspace(k) - - enddo - - if (present(melt_b)) then - meltb = melt_b - endif - if (present(con_gel)) then - congel = con_gel - endif - - if (hbri_old > c0) then - do k = 1, nblyr+1 - trtmp0(nblyr+2-k) = C_stationary(k)/hbri_old ! reverse order - enddo ! k - endif - - htemp = c0 - - if (meltb > c0) then - htemp = hbri_old-meltb - nr = 0 - hice = hbri_old - hbio = htemp - elseif (congel > c0) then - htemp = hbri_old+congel - nr = 1 - hice = htemp - hbio = hbri_old - elseif (hbri .gt. hbri_old) then - htemp = hbri - nr = 1 - hice = htemp - hbio = hbri_old - endif - - !----------------------------------------------------------------- - ! Regrid C_stationary to add or remove bottom layer(s) - !----------------------------------------------------------------- - if (htemp > c0) then - call remap_zbgc (ntrcr, nblyr+1, & - nt, & - trtmp0(1:ntrcr), & - trtmp, & - nr, nblyr+1, & - hice, hbio, & - igrid(1:nblyr+1), & - igrid(1:nblyr+1), top_conc, & - l_stop, stop_label) - if (l_stop) return - - trtmp0(:) = c0 - do k = 1,nblyr+1 - trtmp0(nblyr+2-k) = trtmp(nt + k-1) - enddo !k - - do k = 1, nblyr+1 - C_stationary(k) = trtmp0(k)*htemp - sum_f = sum_f + C_stationary(k)*zspace(k) - enddo ! k - - if (congel > c0 .and. top_conc .le. c0 .and. abs(sum_i-sum_f) > puny) then - dflux = sum_i - sum_f - sum_f = c0 - do k = 1,nblyr+1 - C_stationary(k) = max(c0,C_stationary(k) + dflux) - sum_f = sum_f + C_stationary(k)*zspace(k) - enddo - endif - - flux_bio = flux_bio + (sum_i -sum_f)/dt - endif - - end subroutine regrid_stationary - -!======================================================================= - - end module ice_zbgc_shared - -!======================================================================= diff --git a/components/mpas-seaice/src/column/ice_zsalinity.F90 b/components/mpas-seaice/src/column/ice_zsalinity.F90 deleted file mode 100644 index 67381c7e14ca..000000000000 --- a/components/mpas-seaice/src/column/ice_zsalinity.F90 +++ /dev/null @@ -1,1183 +0,0 @@ -!======================================================================= -! -! Vertical salinity (trcrn(nt_bgc_S)) is solved on the bio grid (bgrid and igrid) -! with domain defined by the dynamic brine height (trcrn(nt_fbri) * vicen/aicen). -! The CICE Bitz and Lipscomb thermodynamics is solved on the cgrid with height -! vicen/aicen. -! Gravity drainage is parameterized as nonlinear advection -! Flushing is incorporated in the boundary changes and a darcy flow. -! (see Jeffery et al., JGR, 2011). -! -! authors: Nicole Jeffery, LANL -! Elizabeth C. Hunke, LANL -! - module ice_zsalinity - - use ice_kinds_mod - use ice_constants_colpkg - use ice_zbgc_shared - use ice_warnings, only: add_warning - - implicit none - - private - public :: zsalinity - - real (kind=dbl_kind), parameter :: & - max_salin = 200.0_dbl_kind, & !(ppt) maximum bulk salinity - lapidus_g = 0.3_dbl_kind , & ! constant for artificial - ! viscosity/diffusion during growth - lapidus_m = 0.007_dbl_kind ! constant for artificial diffusion during melt - -!======================================================================= - - contains - -!======================================================================= - - subroutine zsalinity (n_cat, dt, & - nilyr, bgrid, & - cgrid, igrid, & - trcrn_S, trcrn_q, & - trcrn_Si, ntrcr, & - fbri, & - bSin, bTin, & - bphin, iphin, & - ikin, hbr_old, & - hbrin, hin, & - hin_old, iDin, & - darcy_V, brine_sal, & - brine_rho, ibrine_sal, & - ibrine_rho, dh_direct, & - Rayleigh_criteria, & - first_ice, sss, & - sst, dh_top, & - dh_bot, & - l_stop, stop_label, & - fzsal, & - fzsal_g, bphi_min, & - nblyr, vicen, & - aicen, zsal_tot) - - use ice_constants_colpkg, only: c0, c1, puny - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nblyr , & ! number of bio layers - ntrcr , & ! number of tracers - n_cat ! category number - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), intent(in) :: & - sss , & ! ocean salinity (ppt) - sst , & ! ocean temperature (oC) - hin_old , & ! old ice thickness (m) - dh_top , & ! brine change in top and bottom for diagnostics (m) - dh_bot , & ! minimum porosity - darcy_V , & ! darcy velocity (m/s) - dt , & ! time step - fbri , & ! ratio of brine height to ice thickness - hbr_old , & ! old brine height (m) - hin , & ! new ice thickness (m) - hbrin , & ! new brine height (m) - vicen , & ! ice volume (m) - aicen , & ! ice area (m) - bphi_min , & ! - dh_direct ! flooded or runoff amount (m) - - real (kind=dbl_kind), intent(inout) :: & - zsal_tot , & ! tot salinity (psu*rhosi*total vol ice) - fzsal , & ! total flux of salt out of ice over timestep(kg/m^2/s) - fzsal_g ! gravity drainage flux of salt over timestep(kg/m^2/s) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bTin , & ! Ice Temperature ^oC (on bio grid) - bphin ! Ice porosity (on bio grid) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bSin , & ! Ice salinity ppt (on bio grid) - brine_sal , & ! brine salinity (ppt) - brine_rho ! brine density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr), & - intent(inout) :: & - trcrn_S ! salinity tracer ppt (on bio grid) - - real (kind=dbl_kind), dimension (nilyr), & - intent(inout) :: & - trcrn_q , & ! enthalpy tracer - trcrn_Si ! salinity on CICE grid - - logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. if minimun ice thickness (Ra_c) was reached - - logical (kind=log_kind), intent(in) :: & - first_ice ! for first category ice only .true. - !initialized values should be used - - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & - iDin , & ! Diffusivity on the igrid (1/s) - ikin ! permeability on the igrid - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal ! brine sal on interface - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k , & ! vertical index - n, mm ! thickness category index - - real (kind=dbl_kind) :: & - fzsaln , & ! category flux of salt out of ice over timestep(kg/m^2/s) - fzsaln_g , & ! category gravity drainage flux of salt over timestep(kg/m^2/s) - zsal_totn ! total salt content - - call solve_zsalinity (nilyr, nblyr, n_cat, dt, & - bgrid, cgrid, igrid, & - trcrn_S, trcrn_q, & - trcrn_Si, ntrcr, & - bSin, bTin, & - bphin, iphin, & - ikin, hbr_old, & - hbrin, hin, & - hin_old, iDin, & - darcy_V, brine_sal, & - brine_rho, ibrine_sal, & - ibrine_rho, dh_direct, & - Rayleigh_criteria, & - first_ice, sss, & - sst, dh_top, & - dh_bot, & - l_stop, stop_label, & - fzsaln, & - fzsaln_g, bphi_min) - - zsal_totn = c0 - - call column_sum_zsal (zsal_totn, nblyr, & - vicen, trcrn_S, & - fbri) - - call merge_zsal_fluxes (aicen, & - zsal_totn, zsal_tot, & - fzsal, fzsaln, & - fzsal_g, fzsaln_g) - - end subroutine zsalinity - -!======================================================================= -! -! update vertical salinity -! - subroutine solve_zsalinity (nilyr, nblyr, & - n_cat, dt, & - bgrid, cgrid, igrid, & - trcrn_S, trcrn_q, & - trcrn_Si, ntrcr, & - bSin, bTin, & - bphin, iphin, & - ikin, hbr_old, & - hbrin, hin, & - hin_old, iDin, & - darcy_V, brine_sal, & - brine_rho, ibrine_sal, & - ibrine_rho, dh_direct, & - Rayleigh_criteria, & - first_ice, sss, & - sst, dh_top, & - dh_bot, & - l_stop, stop_label, & - fzsaln, & - fzsaln_g, bphi_min) - - use ice_colpkg_tracers, only: nt_sice - use ice_colpkg_shared, only: solve_zsal, min_salin, dts_b, rhosi - use ice_therm_shared, only: calculate_Tin_from_qin - - integer (kind=int_kind), intent(in) :: & - nilyr, & ! number of ice layers - nblyr, & ! number of bio layers - ntrcr, & ! number of tracers - n_cat ! category number - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - bgrid ! biology nondimensional vertical grid points - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate - - real (kind=dbl_kind), intent(in) :: & - sss , & ! ocean salinity (ppt) - sst , & ! ocean temperature (oC) - hin_old , & ! old ice thickness (m) - dh_top , & ! brine change in top and bottom for diagnostics (m) - dh_bot , & - darcy_V - - real (kind=dbl_kind), intent(in) :: & - hbr_old , & ! old brine height (m) - hin , & ! new ice thickness (m) - hbrin , & ! new brine height (m) - bphi_min , & ! - dh_direct ! flooded or runoff amount (m) - - real (kind=dbl_kind), intent(out) :: & - fzsaln , & ! total flux of salt out of ice over timestep(kg/m^2/s) - fzsaln_g ! gravity drainage flux of salt over timestep(kg/m^2/s) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bTin , & ! Ice Temperature ^oC (on bio grid) - bphin ! Ice porosity (on bio grid) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bSin , & ! Ice salinity ppt (on bio grid) - brine_sal , & ! brine salinity (ppt) - brine_rho ! brine density (kg/m^3) - - real (kind=dbl_kind), dimension (nblyr), & - intent(inout) :: & - trcrn_S ! salinity tracer ppt (on bio grid) - - real (kind=dbl_kind), dimension (nilyr), & - intent(inout) :: & - trcrn_q , & ! enthalpy tracer - trcrn_Si ! salinity on CICE grid - - logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. if minimun ice thickness (Ra_c) was reached - - logical (kind=log_kind), intent(in) :: & - first_ice ! for first category ice only .true. - !initialized values should be used - - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & - iDin , & ! Diffusivity on the igrid (1/s) - ikin ! permeability on the igrid - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal ! brine sal on interface - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k, m, nint ! vertical biology layer index - - real (kind=dbl_kind) :: & - surface_S ! salinity of ice above hin > hbrin - - real (kind=dbl_kind), dimension(2) :: & - S_bot - - real (kind=dbl_kind) :: & - Tmlts , & ! melting temperature - dts ! local timestep (s) - - logical (kind=log_kind) :: & - Rayleigh - - real (kind=dbl_kind):: & - Ttemp ! initial temp profile on the CICE grid - - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0 , & ! temporary, remapped tracers !need extra - trtmp ! temporary, remapped tracers ! - - logical (kind=log_kind) :: & - cflag - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - dts = dts_b - nint = max(1,INT(dt/dts)) - dts = dt/nint - - l_stop = .false. - - !---------------------------------------------------------------- - ! Update boundary conditions - !---------------------------------------------------------------- - - surface_S = min_salin - - Rayleigh = .true. - if (n_cat == 1 .AND. hbr_old < Ra_c) then - Rayleigh = Rayleigh_criteria ! only category 1 ice can be false - endif - - if (dh_bot + darcy_V*dt > c0) then - - bSin (nblyr+2) = sss - bTin (nblyr+2) = sst - brine_sal(nblyr+2) = sss - brine_rho(nblyr+2) = rhow - bphin (nblyr+2) = c1 - S_bot (1) = c0 - S_bot (2) = c1 - - ! bottom melt - else - bSin (nblyr+2) = bSin(nblyr+1) - Tmlts = -bSin(nblyr+2)* depressT - bTin (nblyr+2) = bTin(nblyr+1) - bphin(nblyr+2) = iphin(nblyr+1) - S_bot(1) = c1 - S_bot(2) = c0 - endif - - if (abs(dh_top) > puny .AND. abs(darcy_V) > puny) then - bSin(1) = max(min_salin,-(brine_rho(2)*brine_sal(2)/rhosi & - * darcy_V*dt - (dh_top + darcy_V*dt/bphi_min - dh_direct)*min_salin & - + max(c0,-dh_direct) * sss )/dh_top) - brine_sal(1) = brine_sal(2) - brine_rho(1) = brine_rho(2) - bphin(1) = bphi_min - else - bSin(1) = min_salin - endif - - !----------------------------------------------------------------- - ! Solve for S using CICE T. If solve_zsal = .true., then couple back - ! to the thermodynamics - !----------------------------------------------------------------- - - call solve_S_dt (cflag, nblyr, & - nint , dts , & - bSin , bTin , & - bphin , iphin , & - igrid , bgrid , & - ikin , & - hbr_old , hbrin , & - hin , hin_old , & - iDin , darcy_V , & - brine_sal , Rayleigh , & - first_ice , sss , & - dt , dh_top , & - dh_bot , brine_rho , & - ibrine_sal , ibrine_rho , & - fzsaln , fzsaln_g , & - S_bot , l_stop , & - stop_label) - - if (l_stop) return - - if (n_cat == 1) Rayleigh_criteria = Rayleigh - - trtmp0(:) = c0 - trtmp (:) = c0 - - do k = 1,nblyr ! back to bulk quantity - trcrn_S(k) = bSin(k+1) - trtmp0(nt_sice+k-1) = trcrn_S(k) - enddo ! k - - call remap_zbgc (ntrcr, nilyr, & - nt_sice, & - trtmp0(1:ntrcr), & - trtmp, & - 1, nblyr, & - hin, hbrin, & - cgrid(2:nilyr+1), & - bgrid(2:nblyr+1), & - surface_S, l_stop,& - stop_label) - - do k = 1, nilyr - Tmlts = -trcrn_Si(k)*depressT - Ttemp = min(-(min_salin+puny)*depressT, & - calculate_Tin_from_qin(trcrn_q(k),Tmlts)) - trcrn_Si(k) = min(-Ttemp/depressT, max(min_salin, & - trtmp(nt_sice+k-1))) - Tmlts = - trcrn_Si(k)*depressT - ! if (cflag) trcrn_q(k) = calculate_qin_from_Sin(Ttemp,Tmlts) - enddo ! k - - end subroutine solve_zsalinity - -!======================================================================= -! -! solves salt continuity explicitly using -! Lax-Wendroff-type scheme (MacCormack) -! (Mendez-Nunez and Carroll, Monthly Weather Review, 1993) -! -! authors Nicole Jeffery, LANL -! - subroutine solve_S_dt (cflag, nblyr, nint, & - dts, bSin, bTin, & - bphin, iphin, igrid, & - bgrid, ikin, hbri_old, & - hbrin, hice, hice_old, & - iDin, darcy_V, & - brine_sal, Rayleigh, & - first_ice, sss, & - dt, dht, & - dhb, brine_rho, & - ibrine_sal, ibrine_rho, & - fzsaln, fzsaln_g, & - S_bot, l_stop, & - stop_label) - - use ice_brine, only: calculate_drho - use ice_colpkg_shared, only: l_skS, grid_oS, l_sk, min_salin, rhosi, salt_loss - - integer (kind=int_kind), intent(in) :: & - nblyr , & ! number of bio layers - nint ! number of interations - - logical (kind=log_kind), intent(out) :: & - cflag ! thin or not - - real (kind=dbl_kind), intent(in) :: & - dt , & ! timestep (s) - dts , & ! local timestep (s) - sss , & ! sea surface salinity - dht , & ! change in the ice top (positive for melting) - dhb , & ! change in the ice bottom (positive for freezing) - hice_old , & ! old ice thickness (m) - hbri_old , & ! brine thickness (m) - hbrin , & ! new brine thickness (m) - hice , & ! ice thickness (m - darcy_V ! Darcy velocity due to a pressure head (m/s) or melt - - real (kind=dbl_kind), intent(out) :: & - fzsaln , & ! salt flux +ive to ocean (kg/m^2/s) - fzsaln_g ! gravity drainage salt flux +ive to ocean (kg/m^2/s) - - logical (kind=log_kind), intent(inout) :: & - Rayleigh ! if .true. convection is allowed; if .false. not yet - - logical (kind=log_kind), intent(in) :: & - first_ice - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - brine_sal , & ! Internal brine salinity (ppt) - brine_rho , & ! Internal brine density (kg/m^3) - bgrid , & ! biology nondimensional grid layer points - bTin ! Temperature of ice layers on bio grid for history (C) - - real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bphin , & ! Porosity of layers - bSin ! Bulk Salinity (ppt) contains previous timestep - ! and ocean ss - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - ibrine_rho , & ! brine rho on interface - ibrine_sal , & ! brine sal on interface - igrid ! biology grid interface points - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin ! Porosity of layers on interface - - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & - iDin , & ! Diffusivity on the igrid (1/s) with minimum bphi condition - ikin ! permeability on interface - - real (kind=dbl_kind), dimension (2), intent(in) :: & - S_bot - - logical (kind=log_kind), intent(out) :: & - l_stop ! if true, print diagnostics and abort on return - - character (char_len) :: stop_label - - ! local variables - - integer (kind=int_kind) :: & - k, m , mm ! vertical biology layer index - - real (kind=dbl_kind), dimension (nblyr+1) :: & - iDin_p , & ! Diffusivity on the igrid (1/s)/bphi^3 - dSbdx , & ! gradient of brine rho on grid - drho , & ! brine difference rho_a-rho_b (kg/m^3) - Ci_s , & ! - Ui_s , & ! interface function - Vi_s , & ! for conservation check - ivel - - real (kind=dbl_kind), dimension (nblyr+2) :: & - Din_p , & ! Diffusivity on the igrid (1/s)/bphi^3 - Sintemp , & ! initial salinity - pre_sin , & ! estimate of salinity of layers - pre_sinb , & ! estimate of salinity of layers - bgrid_temp , & ! biology nondimensional grid layer points - ! with boundary values - Q_s, C_s , & ! Functions in continuity equation - V_s, U_s, F_s - - real (kind=dbl_kind) :: & - dh , & ! (m) change in hbrine over dts - dbgrid , & ! ratio of grid space to spacing across boundary - ! i.e. 1/nilyr/(dbgrid(2)-dbgrid(1)) - lapidus , & ! artificial viscosity: use lapidus_g for growth - Ssum_old,Ssum_new, & ! depth integrated salt before and after timestep - fluxcorr, & ! flux correction to prevent S < min_salin - Ssum_corr, & ! numerical boundary flux correction - fluxb , & ! bottom, top and total boundary flux (g/kg/m^2) - fluxg , & ! bottom, top and total gravity drainage flux (g/kg/m^2) - fluxm , & ! bottom, top and total molecular diffusion flux (g/kg/m^2) - sum_old,sum_new , & ! integrated salinity at t and t+dt - dh_dt, dS_dt , & - Ssum_tmp - - real (kind=dbl_kind), dimension (nblyr) :: & - vel , & ! advective velocity times dt (m) - lapidus_diff , & ! lapidus term and - flux_corr , & - lapA , & - lapB - - logical (kind=log_kind) :: & - write_flag , & ! set to true at each timestep - test_conservation ! test that salt change is balanced by fluxes - - !----------------------------------------------------------------- - ! Initialize - !----------------------------------------------------------------- - - l_stop = .false. - cflag = .false. - write_flag = .true. - test_conservation = .false. - iDin_p(:) = c0 - Din_p(:) = c0 - lapA(:) = c1 - lapB(:) = c1 - lapA(nblyr) = c0 - lapB(1) = c0 - V_s(:) = c0 - U_s(:) = c0 - Q_s(:) = c0 - C_s(:) = c0 - Ci_s(:) = c0 - F_s(:) = c0 - Ui_s(:) = c0 - Vi_s(:) = c0 - ivel(:) = c0 - vel(:) = c0 - dh = c0 - dbgrid = c2 - fzsaln = c0 - fzsaln_g = c0 - - !----------------------------------------------------------------- - ! Find brine density gradient for gravity drainage parameterization - !----------------------------------------------------------------- - - call calculate_drho(nblyr, igrid, bgrid,& - brine_rho, ibrine_rho, drho) - - !----------------------------------------------------------------- - ! Calculate bphi diffusivity on the grid points - ! rhosi = 919-974 kg/m^2 set in bio_in - ! rhow = 1026.0 density of sea water: uses kinematic viscosity (m^2/s) in Q18 - ! dynamic viscosity divided by density = kinematic. - !----------------------------------------------------------------- - - do k = 2, nblyr+1 - iDin_p(k) = k_o*gravit*l_skS/viscos_dynamic*drho(k)/(hbri_old**2) - Din_p(k) = (iDin_p(k)*(igrid(k)-bgrid(k)) & - + iDin_p(k-1)*(bgrid(k)-igrid(k-1)))/(igrid(k)-igrid(k-1)) - enddo !k - - !----------------------------------------------------------------- - ! Critical Ra_c value is only for the onset of convection in thinS - ! ice and not throughout, therefore I need a flag to indicate the - ! Ra_c was reached for a particular ice block. - ! Using a thickness minimum (Ra_c) for simplicity. - !----------------------------------------------------------------- - - bgrid_temp(:) = bgrid(:) - Din_p(nblyr+2) = iDin_p(nblyr+1) - if (.NOT. Rayleigh .AND. hbrin < Ra_c) then - Din_p(:) = c0 - iDin_p(:) = c0 - else - Rayleigh = .true. - endif - - if (hbri_old > thinS .AND. hbrin > thinS .and. & - hice_old > thinS .AND. .NOT. first_ice) then - - cflag = .true. - - bgrid_temp(1) = c0 - bgrid_temp(nblyr+2) = c1 - dbgrid = igrid(2)/(bgrid_temp(2)-bgrid_temp(1)) - - !----------------------------------- - ! surface boundary terms - !----------------------------------- - - lapidus = lapidus_g/real(nblyr,kind=dbl_kind)**2 - ivel(1) = dht/hbri_old - U_s (1) = ivel(1)/dt*dts - Ui_s(1) = U_s(1) - Ci_s(1) = c0 - F_s (1) = brine_rho(2)*brine_sal(2)/rhosi*darcy_V*dts/hbri_old/bSin(1) - - !----------------------------------- - ! bottom boundary terms - !----------------------------------- - - ivel(nblyr+1) = dhb/hbri_old - Ui_s(nblyr+1) = ivel(nblyr+1)/dt*dts - dSbdx(nblyr) = (ibrine_sal(nblyr+1)*ibrine_rho(nblyr+1) & - - ibrine_sal(nblyr)*ibrine_rho(nblyr)) & - / (igrid(nblyr+1)-igrid(nblyr)) - C_s(nblyr+1) = Dm/brine_sal(nblyr+1)/brine_rho(nblyr+1)*dts/hbri_old**2 & - * (ibrine_sal(nblyr+1)*ibrine_rho(nblyr+1) & - - ibrine_sal(nblyr)*ibrine_rho(nblyr)) & - / (igrid(nblyr+1)-igrid(nblyr)) - F_s(nblyr+1) = darcy_V*dts/hbri_old/bphin(nblyr+1) - F_s(nblyr+2) = darcy_V*dts/hbri_old/bphin(nblyr+2) - vel(nblyr) =(bgrid(nblyr+1)*(dhb) -(bgrid(nblyr+1) - c1)*dht)/hbri_old - U_s(nblyr+1) = vel(nblyr)/dt*dts - V_s(nblyr+1) = Din_p(nblyr+1)/rhosi & - * (rhosi/brine_sal(nblyr+1)/brine_rho(nblyr+1))**exp_h & - * dts*dSbdx(nblyr) - dSbdx(nblyr+1) = (brine_sal(nblyr+2)*brine_rho(nblyr+2) & - - brine_sal(nblyr+1)*brine_rho(nblyr+1)) & - / (bgrid(nblyr+2)-bgrid(nblyr+1)+ grid_oS/hbri_old ) - C_s( nblyr+2) = Dm/brine_sal(nblyr+2)/brine_rho(nblyr+2)*dts/hbri_old**2 & - * (brine_sal(nblyr+2)*brine_rho(nblyr+2) & - - brine_sal(nblyr+1)*brine_rho(nblyr+1)) & - / (bgrid(nblyr+2)-bgrid(nblyr+1) + grid_oS/hbri_old ) - U_s(nblyr+2) = ivel(nblyr+1)/dt*dts - V_s(nblyr+2) = Din_p(nblyr+2)/rhosi & - * (bphin(nblyr+1)/bSin(nblyr+2))**exp_h & - * dts*dSbdx(nblyr+1) - Ci_s(nblyr+1) = C_s(nblyr+2) - Vi_s(nblyr+1) = V_s(nblyr+2) - dh = (dhb-dht)/dt*dts - - do k = 2, nblyr - ivel(k) = (igrid(k)*dhb - (igrid(k)-c1)*dht)/hbri_old - Ui_s(k) = ivel(k)/dt*dts - Vi_s(k) = iDin_p(k)/rhosi & - *(rhosi/ibrine_rho(k)/ibrine_sal(k))**exp_h*dts & - * (brine_sal(k+1)*brine_rho(k+1) & - - brine_sal(k)*brine_rho(k)) & - / (bgrid(k+1)-bgrid(k)) - dSbdx(k-1) = (ibrine_sal(k)*ibrine_rho(k) & - - ibrine_sal(k-1)*ibrine_rho(k-1))/(igrid(k)-igrid(k-1)) - F_s(k) = darcy_V*dts/hbri_old/bphin(k) - C_s(k) = Dm/brine_sal(k)/brine_rho(k)*dts/hbri_old**2 & - * (ibrine_sal(k)*ibrine_rho(k) & - - ibrine_sal(k-1)*ibrine_rho(k-1))/(igrid(k)-igrid(k-1)) - Ci_s(k) = Dm/ibrine_sal(k)/ibrine_rho(k)*dts/hbri_old**2 & - * (brine_sal(k+1)*brine_rho(k+1) & - - brine_sal(k)*brine_rho(k))/(bgrid(k+1)-bgrid(k)) - vel(k-1) = (bgrid(k)*(dhb) - (bgrid(k) - c1)* dht)/hbri_old - U_s(k) = vel(k-1)/dt*dts - V_s(k) = Din_p(k)/rhosi & - * (rhosi/brine_sal(k)/brine_rho(k))**exp_h*dts*dSbdx(k-1) - C_s(2) = c0 - V_s(2) = c0 - enddo !k - - !----------------------------------------------------------------- - ! Solve - !----------------------------------------------------------------- - - do m = 1, nint - - Sintemp(:) = bSin(:) - pre_sin(:) = bSin(:) - pre_sinb(:) = bSin(:) - Ssum_old = bSin(nblyr+1)*(igrid(nblyr+1)-igrid(nblyr)) - - ! forward-difference - - do k = 2, nblyr - Ssum_old = Ssum_old + bSin(k)*(igrid(k)-igrid(k-1)) - - pre_sin(k) =bSin(k) + (Ui_s(k)*(bSin(k+1) - bSin(k)) + & - V_s(k+1)*bSin(k+1)**3 - V_s(k)*bSin(k)**3 + & - (C_s(k+1)+F_s(k+1))*bSin(k+1)-& - (C_s(k)+F_s(k))*bSin(k))/(bgrid_temp(k+1)-bgrid_temp(k)) - enddo !k - - pre_sin(nblyr+1) = bSin(nblyr+1) + (Ui_s(nblyr+1)*(bSin(nblyr+2) - & - bSin(nblyr+1)) + V_s(nblyr+2)*bSin(nblyr+2)**3 - & - V_s(nblyr+1)*bSin(nblyr+1)**3+ (C_s(nblyr+2)+F_s(nblyr+2))*& - bSin(nblyr+2)-(C_s(nblyr+1)+F_s(nblyr+1))*bSin(nblyr+1) )/& - (bgrid_temp(nblyr+2)- bgrid_temp(nblyr+1)) - - ! backward-difference - - pre_sinb(2) = p5*(bSin(2) + pre_sin(2) + (Ui_s(1)& - *(pre_sin(2) -pre_sin(1)) + & - V_s(2)*pre_sin(2)**3 - & - V_s(1)*pre_sin(1)**3 + (C_s(2)+F_s(2))*pre_sin(2)-& - (C_s(1)+F_s(1))*pre_sin(1) )/(bgrid_temp(2)-bgrid_temp(1)) ) - - do k = nblyr+1, 3, -1 !nblyr+1 - pre_sinb(k) =p5*(bSin(k) + pre_sin(k) + (Ui_s(k-1)& - *(pre_sin(k) - pre_sin(k-1)) + & - V_s(k)*pre_sin(k)**3 - & - V_s(k-1)*pre_sin(k-1)**3 + (C_s(k)+F_s(k))*pre_sin(k)-& - (C_s(k-1)+F_s(k-1))*pre_sin(k-1))/(bgrid_temp(k)-bgrid_temp(k-1)) ) - - Q_s(k) = V_s(k)*pre_sin(k)**2 + U_s(k) + C_s(k) + F_s(k) - enddo !k - - Q_s(2) = V_s(2)*pre_sin(2)**2 + U_s(2) + C_s(2) + F_s(2) - Q_s(1) = V_s(1)*pre_sin(2)**2 + Ui_s(1) + C_s(1)+ F_s(1) - Q_s(nblyr+2) = V_s(nblyr+2)*pre_sin(nblyr+1)**2 + & - Ui_s(nblyr+1) + C_s(nblyr+2) + F_s(nblyr+2) - - !----------------------------------------------------------------- - ! Add artificial viscosity [Lapidus,1967] [Lohner et al, 1985] - ! * more for melting ice - !----------------------------------------------------------------- - - lapidus_diff(:) = c0 - flux_corr(:) = c0 - Ssum_new = c0 - Ssum_corr = c0 - fluxcorr = c0 - fluxg = c0 - fluxb = c0 - fluxm = c0 - - do k = 2, nblyr+1 - - lapidus_diff(k-1) = lapidus/& ! lapidus/real(nblyr,kind=dbl_kind)**2/& - (igrid(k)-igrid(k-1))* & - ( lapA(k-1)*ABS(Q_s(k+1)-Q_s(k))*(abs(pre_sinb(k+1))-abs(pre_sinb(k)))/& - (bgrid_temp(k+1)-bgrid_temp(k) )**2 - & - lapB(k-1)*ABS(Q_s(k)-Q_s(k-1))*(abs(pre_sinb(k))-abs(pre_sinb(k-1)))/& - (bgrid_temp(k)-bgrid_temp(k-1))**2) - - bSin(k) = pre_sinb(k) + lapidus_diff(k-1) - - if (bSin(k) < min_salin) then - flux_corr(k-1) = min_salin - bSin(k) ! flux into the ice - bSin(k) = min_salin - elseif (bSin(k) > -bTin(k)/depressT) then - flux_corr(k-1) = bSin(k)+bTin(k)/depressT ! flux into the ice - bSin(k) = -bTin(k)/depressT - elseif (bSin(k) > max_salin) then - l_stop = .true. - stop_label = 'bSin(k) > max_salin' - endif - - if (k == nblyr+1) bSin(nblyr+2) = S_bot(1)*bSin(nblyr+1) & - + S_bot(2)*bSin(nblyr+2) - - Ssum_new = Ssum_new + bSin(k)*(igrid(k)-igrid(k-1)) - fluxcorr = fluxcorr + (flux_corr(k-1) & - + lapidus_diff(k-1))*(igrid(k)-igrid(k-1)) - - enddo !k - - Ssum_tmp = Ssum_old - - call calc_salt_fluxes (nint, m, nblyr, igrid, & - Ui_s, dh,dbgrid,hbri_old,Sintemp, & - pre_sin, fluxb,fluxg,fluxm,V_s, & - C_s, F_s, Ssum_corr,fzsaln_g,fzsaln, & - Ssum_tmp,fluxcorr,dts, Ssum_new) - - if (test_conservation) then - call check_conserve_salt(nint, m, dt, dts,& - Ssum_tmp, Ssum_new, Ssum_corr,& - fluxcorr, fluxb, fluxg, fluxm, & - hbrin, hbri_old, l_stop) - stop_label = 'check_conserve_salt fails' - if (l_stop) return - endif ! test_conservation - - enddo !m - - else ! add/melt ice only - - sum_old = c0 - sum_new = c0 - dh_dt = hbrin-hbri_old - dS_dt = c0 - if (dh_dt > c0) then - dS_dt = sss*dh_dt*salt_loss - do k = 2, nblyr+1 - bSin(k) = max(min_salin,(bSin(k)*hbri_old + dS_dt)/hbrin) - enddo !k - else - do k = 2, nblyr+1 - sum_old = sum_old + bSin(k)*hbri_old*(igrid(k)-igrid(k-1)) - bSin(k) = max(min_salin,bSin(k) * (c1-abs(dh_dt)/hbri_old)) - sum_new = sum_new + bSin(k)*hbrin*(igrid(k)-igrid(k-1)) - enddo !k - endif - fzsaln = rhosi*(sum_old-sum_new + dS_dt)*p001/dt !kg/m^2/s - fzsaln_g = c0 - - endif ! (hbri_old > thinS .AND. hbrin > thinS & - ! .and. hice_old > thinS .AND. .NOT. first_ice) - - !----------------------------------------------------------------- - ! Move this to bgc calculation if using tr_salinity - ! Calculate bphin, iphin, ikin, iDin and iDin_N - !----------------------------------------------------------------- - - iDin(:) = c0 - iphin(:) = c1 - ikin(:) = c0 - - do k = 1, nblyr+1 - if (k < nblyr+1) bphin(k+1) = min(c1,max(puny, & - bSin(k+1)*rhosi/(brine_sal(k+1)*brine_rho(k+1)))) - if (k == 1) then - bphin(k) = min(c1,max(puny, bSin(k)*rhosi/(brine_sal(k)*brine_rho(k)))) - iphin(k) = bphin(2) - elseif (k == nblyr+1) then - iphin(nblyr+1) = bphin(nblyr+1) - else - iphin(k) = min(c1, max(c0,(bphin(k+1) - bphin(k))/(bgrid(k+1) & - - bgrid(k))*(igrid(k)-bgrid(k)) + bphin(k))) - endif - ikin(k) = k_o*iphin(k)**exp_h - enddo !k - - if (cflag) then - - do k = 2, nblyr+1 - iDin(k) = iphin(k)*Dm/hbri_old**2 - if (Rayleigh .AND. hbrin .GE. Ra_c) & - iDin(k) = iDin(k) + l_sk*ikin(k)*gravit/viscos_dynamic & - * drho(k)/hbri_old**2 - enddo !k - else ! .not. cflag - do k = 2, nblyr+1 - iDin(k) = iphin(k)*Dm/hbri_old**2 - enddo !k - endif - - end subroutine solve_S_dt - -!======================================================================= -! -! Calculate salt fluxes -! - subroutine calc_salt_fluxes (mmax, mint, nblyr, igrid, & - Ui_s,dh,dbgrid,hbri_old,Sintemp,pre_sin,& - fluxb,fluxg,fluxm,V_s,& - C_s,F_s,Ssum_corr,fzsaln_g,fzsaln,Ssum_old, & - fluxcorr,dts, Ssum_new) - - use ice_colpkg_shared, only: rhosi - - integer(kind=int_kind), intent(in) :: & - nblyr, & ! number of bio layers - mint , & ! current iteration - mmax ! total number of iterations - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! biology vertical interface points - - real (kind=dbl_kind), intent(in) :: & - dts , & ! halodynamic timesteps (s) - ! hbrin , & ! new brine height after all iterations (m) - dh , & ! (m) change in hbrine over dts - dbgrid , & ! ratio of grid space to spacing across boundary - ! ie. 1/nilyr/(dbgrid(2)-dbgrid(1)) - fluxcorr , & ! flux correction to ensure S >= min_salin - hbri_old ! initial brine height (m) - - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - Ui_s ! interface function - - real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - Sintemp , & ! initial salinity - pre_sin , & ! estimate of salinity of layers - C_s , & ! Functions in continuity equation - F_s , & - V_s - - real (kind=dbl_kind), intent(in) :: & - Ssum_old , & ! initial integrated salt content (ppt)/h - Ssum_new ! next integrated salt content(ppt)/h - - real (kind=dbl_kind), intent(inout) :: & - fzsaln , & ! total salt flux out of ice over timestep(kg/m^2/s) - fzsaln_g , & ! gravity drainage flux of salt over timestep(kg/m^2/s) - Ssum_corr, & ! boundary flux correction due to numerics - fluxb , & ! total boundary salt flux into the ice (+ into ice) - fluxg , & ! total gravity drainage salt flux into the ice (+ into ice) - fluxm ! total molecular diffusive salt flux into the ice (+ into ice) - - ! local variables - - real (kind=dbl_kind) :: & - Ssum_corr_flux , & ! numerical boundary flux correction - fluxb_b, fluxb_t, & ! bottom, top and total boundary flux (g/kg/m^2) - fluxg_b, fluxg_t, & ! bottom, top and total gravity drainage flux (g/kg/m^2) - fluxm_b, fluxm_t ! bottom, top and total molecular diffusion flux (g/kg/m^2) - - real (kind=dbl_kind) :: hin_old, hin_next, dhtmp !, dh - - dhtmp = c1-dh/hbri_old - hin_next = hbri_old + real(mint,kind=dbl_kind)*dh - hin_old = hbri_old + (real(mint,kind=dbl_kind)-c1)*dh - - !----------------------------------------------------------------- - ! boundary fluxes (positive into the ice) - !--------------------------------------------- - ! without higher order numerics corrections - ! fluxb = (Ui_s(nblyr+1) + F_s(nblyr+2))*Sintemp(nblyr+2) - (Ui_s(1) + F_s(1))*Sintemp(1) - !----------------------------------------------------------------- - - fluxb_b = p5* Ui_s(nblyr+1) * (dhtmp*Sintemp(nblyr+2)*dbgrid & - + pre_sin(nblyr+1) & - + dhtmp*Sintemp(nblyr+1)*(c1-dbgrid)) & - + p5*(F_s(nblyr+2) * dhtmp*Sintemp(nblyr+2)*dbgrid & - + F_s(nblyr+1) * (pre_sin(nblyr+1) & - + dhtmp*Sintemp(nblyr+1)*(c1-dbgrid))) - - fluxb_t = -p5*Ui_s(1)*(pre_sin(1)*dbgrid + & - dhtmp*Sintemp(2) - & - (dbgrid-c1)*pre_sin(2)) - & - p5*(dbgrid*F_s(1)*pre_sin(1) + & - F_s(2)*(dhtmp*Sintemp(2) & - +(c1-dbgrid)*pre_sin(2))) - - fluxb = fluxb_b + fluxb_t - - !----------------------------------------------------------------- - ! gravity drainage fluxes (positive into the ice) - ! without higher order numerics corrections - ! fluxg = V_s(nblyr+2)*Sintemp(nblyr+1)**3 - !----------------------------------------------------------------- - - fluxg_b = p5*(dhtmp* dbgrid* & - V_s(nblyr+2)*Sintemp(nblyr+1)**3 + & - V_s(nblyr+1)*(pre_sin(nblyr+1)**3 - & - dhtmp*(dbgrid - c1)* & - Sintemp(nblyr+1)**3)) - - fluxg_t = -p5*(dbgrid*V_s(1)*pre_sin(1)**3 + & - V_s(2)*(dhtmp*Sintemp(2)**3- & - (dbgrid-c1)*pre_sin(2)**3)) - - fluxg = fluxg_b + fluxg_t - - !----------------------------------------------------------------- - ! diffusion fluxes (positive into the ice) - ! without higher order numerics corrections - ! fluxm = C_s(nblyr+2)*Sintemp(nblyr+2) - !----------------------------------------------------------------- - - fluxm_b = p5*(dhtmp*C_s(nblyr+2)* Sintemp(nblyr+2)*dbgrid & - + C_s(nblyr+1)*(pre_sin(nblyr+1) & - + dhtmp * Sintemp(nblyr+1)*(c1-dbgrid))) - - fluxm_t = -p5 * (C_s(1) * pre_sin(1)*dbgrid & - + C_s(2) * (pre_sin(2)*(c1-dbgrid) + dhtmp*Sintemp(2))) - - fluxm = fluxm_b + fluxm_t - - Ssum_corr = (-dh/hbri_old + p5*(dh/hbri_old)**2)*Ssum_old - Ssum_corr_flux = dh*Ssum_old/hin_next + Ssum_corr - Ssum_corr = Ssum_corr_flux - - fzsaln_g = fzsaln_g - hin_next * fluxg_b & - * rhosi*p001/dts - - !approximate fluxes - !fzsaln = fzsaln - hin_next * (fluxg & - ! + fluxb + fluxm + fluxcorr + Ssum_corr_flux) & - ! * rhosi*p001/dts - - fzsaln = fzsaln + (Ssum_old*hin_old - Ssum_new*hin_next) & - * rhosi*p001/dts ! positive into the ocean - - end subroutine calc_salt_fluxes - -!======================================================================= -! -! Test salt conservation: flux conservative form d(hSin)/dt = -dF(x,Sin)/dx -! - subroutine check_conserve_salt (mmax, mint, dt, dts, & - Ssum_old, Ssum_new, Ssum_corr, & - fluxcorr, fluxb, fluxg, fluxm, & - hbrin, hbri_old, l_stop) - - use ice_colpkg_shared, only: rhosi - - integer(kind=int_kind), intent(in) :: & - mint , & ! current iteration - mmax ! maximum number of iterations - - real (kind=dbl_kind), intent(in) :: & - dt, dts , & ! thermodynamic and halodynamic timesteps (s) - hbrin , & ! (m) final brine height - hbri_old , & ! (m) initial brine height - Ssum_old , & ! initial integrated salt content - Ssum_new , & ! final integrated salt content - fluxcorr , & ! flux correction to ensure S >= min_salin - Ssum_corr , & ! boundary flux correction due to numerics - fluxb , & ! total boundary salt flux into the ice (+ into ice) - fluxg , & ! total gravity drainage salt flux into the ice (+ into ice) - fluxm ! - - logical (kind=log_kind), intent(inout) :: & - l_stop ! if false, conservation satisfied within error - - ! local variables - - real (kind=dbl_kind):: & - diff2 , & ! - dsum_flux , & ! salt change in kg/m^2/s - flux_tot , & ! fluxg + fluxb - order , & ! - dh - - real (kind=dbl_kind), parameter :: & - accuracy = 1.0e-7_dbl_kind ! g/kg/m^2/s difference between boundary fluxes - - character(len=char_len_long) :: & - warning ! warning message - - dh = (hbrin-hbri_old)/real(mmax,kind=dbl_kind) - - flux_tot = (fluxb + fluxg + fluxm + fluxcorr + Ssum_corr)*& - (hbri_old + (real(mint,kind=dbl_kind))*dh)/dt - dsum_flux =(Ssum_new*(hbri_old + (real(mint,kind=dbl_kind))*dh) - & - Ssum_old*(hbri_old + (real(mint,kind=dbl_kind)-c1)* & - dh) )/dt - order = abs(dh/min(hbri_old,hbrin)) - if (abs(dsum_flux) > accuracy) then - diff2 = abs(dsum_flux - flux_tot) - if (diff2 > puny .AND. diff2 > order ) then - l_stop = .true. - write(warning,*) 'Poor salt conservation: check_conserve_salt' - call add_warning(warning) - write(warning,*) 'mint:', mint - call add_warning(warning) - write(warning,*) 'Ssum_corr',Ssum_corr - call add_warning(warning) - write(warning,*) 'fluxb,fluxg,fluxm,flux_tot,fluxcorr:' - call add_warning(warning) - write(warning,*) fluxb,fluxg,fluxm,flux_tot,fluxcorr - call add_warning(warning) - write(warning,*) 'fluxg,',fluxg - call add_warning(warning) - write(warning,*) 'dsum_flux,',dsum_flux - call add_warning(warning) - write(warning,*) 'Ssum_new,Ssum_old,hbri_old,dh:' - call add_warning(warning) - write(warning,*) Ssum_new,Ssum_old,hbri_old,dh - call add_warning(warning) - write(warning,*) 'diff2,order,puny',diff2,order,puny - call add_warning(warning) - endif - endif - - end subroutine check_conserve_salt - -!======================================================================= -! -! Aggregate flux information from all ice thickness categories -! - subroutine merge_zsal_fluxes(aicenS, & - zsal_totn, zsal_tot, & - fzsal, fzsaln, & - fzsal_g, fzsaln_g) - - ! single category fluxes - real (kind=dbl_kind), intent(in):: & - aicenS , & ! concentration of ice - fzsaln , & ! salt flux (kg/m**2/s) - fzsaln_g ! gravity drainage salt flux (kg/m**2/s) - - real (kind=dbl_kind), intent(in):: & - zsal_totn ! tot salinity in category (psu*volume*rhosi) - - real (kind=dbl_kind), intent(inout):: & - zsal_tot, & ! tot salinity (psu*rhosi*total vol ice) - fzsal , & ! salt flux (kg/m**2/s) - fzsal_g ! gravity drainage salt flux (kg/m**2/s) - - !----------------------------------------------------------------- - ! Merge fluxes - !----------------------------------------------------------------- - - zsal_tot = zsal_tot + zsal_totn ! already *aicenS - - ! ocean tot and gravity drainage salt fluxes - fzsal = fzsal + fzsaln * aicenS - fzsal_g = fzsal_g + fzsaln_g * aicenS - - end subroutine merge_zsal_fluxes - -!========================================================================== -! -! For each grid cell, sum field over all ice layers. "Net" refers to the column -! integration while "avg" is normalized by the ice thickness - - subroutine column_sum_zsal (zsal_totn, nblyr, & - vicenS, trcrn_S, fbri) - - use ice_colpkg_shared, only: rhosi - - integer (kind=int_kind), intent(in) :: & - nblyr ! number of layers - - real (kind=dbl_kind), intent(in):: & - vicenS , & ! volume of ice (m) - fbri ! brine height to ice thickness ratio - - real (kind=dbl_kind), dimension (nblyr), intent(in) :: & - trcrn_S ! input field - - real (kind=dbl_kind), intent(inout) :: & - zsal_totn ! avg salinity (psu*rhosi*vol of ice) - - ! local variables - - integer (kind=int_kind) :: & - k ! layer index - - do k = 1, nblyr - zsal_totn = zsal_totn & - + rhosi * trcrn_S(k) & - * fbri & - * vicenS/real(nblyr,kind=dbl_kind) - enddo ! k - - end subroutine column_sum_zsal - -!======================================================================= - - end module ice_zsalinity - -!======================================================================= diff --git a/components/mpas-seaice/src/model_forward/mpas_seaice_core.F b/components/mpas-seaice/src/model_forward/mpas_seaice_core.F index 634c6ebf0546..0191f43014eb 100644 --- a/components/mpas-seaice/src/model_forward/mpas_seaice_core.F +++ b/components/mpas-seaice/src/model_forward/mpas_seaice_core.F @@ -38,6 +38,9 @@ function seaice_core_init(domain, startTimeStamp) result(iErr) use seaice_diagnostics, only: & seaice_initialize_time_diagnostics + use seaice_forcing, only: & + use_restart_ic + implicit none type (domain_type), intent(inout) :: domain @@ -90,11 +93,15 @@ function seaice_core_init(domain, startTimeStamp) result(iErr) ! Regardless of which stream we read for initial conditions, reset the ! input alarms for both input and restart before reading any remaining input streams. ! + ! tracks if restart_ic was used to properly initialize new forcing files + use_restart_ic = .false. + if (config_do_restart) then call MPAS_stream_mgr_read(domain % streamManager, streamID='restart', ierr=ierr) else if (trim(config_initial_condition_type) == "restart") then call MPAS_stream_mgr_read(domain % streamManager, streamID='restart_ic', ierr=ierr) + use_restart_ic = .true. else call MPAS_stream_mgr_read(domain % streamManager, streamID='input', ierr=ierr) end if @@ -416,8 +423,6 @@ function seaice_core_finalize(domain) result(iErr) use mpas_decomp use seaice_icepack, only: & seaice_icepack_finalize - use seaice_column, only: & - seaice_column_finalize use seaice_mesh_pool, only: & seaice_mesh_pool_destroy @@ -436,11 +441,9 @@ function seaice_core_finalize(domain) result(iErr) ! finalize column call mpas_pool_get_config(domain % configs, "config_column_physics_type", config_column_physics_type) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_finalize(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_finalize(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type call seaice_analysis_finalize(domain, ierr) diff --git a/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F b/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F index 6240ea9f7057..4f8d28211c6a 100644 --- a/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F +++ b/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F @@ -238,12 +238,10 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ config_use_ice_age, & config_use_first_year_ice, & config_use_level_ice, & - config_use_cesm_meltponds, & config_use_level_meltponds, & config_use_topo_meltponds, & config_use_aerosols, & config_use_brine, & - config_use_vertical_zsalinity, & config_use_vertical_biochemistry, & config_use_vertical_tracers, & config_use_skeletal_biochemistry, & @@ -291,7 +289,6 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ pkgTracerVerticalDONActive, & pkgTracerVerticalIronActive, & pkgTracerZAerosolsActive, & - pkgTracerZSalinityActive, & pkgColumnTracerEffectiveSnowDensityActive, & pkgColumnTracerSnowGrainRadiusActive @@ -361,19 +358,16 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ !pkgTracerVerticalDON !pkgTracerVerticalIron !pkgTracerZAerosols - !pkgTracerZSalinity !pkgColumnTracerEffectiveSnowDensity !pkgColumnTracerSnowGrainRadius call MPAS_pool_get_config(configPool, "config_use_ice_age", config_use_ice_age) call MPAS_pool_get_config(configPool, "config_use_first_year_ice", config_use_first_year_ice) call MPAS_pool_get_config(configPool, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(configPool, "config_use_cesm_meltponds", config_use_cesm_meltponds) call MPAS_pool_get_config(configPool, "config_use_level_meltponds", config_use_level_meltponds) call MPAS_pool_get_config(configPool, "config_use_topo_meltponds", config_use_topo_meltponds) call MPAS_pool_get_config(configPool, "config_use_aerosols", config_use_aerosols) call MPAS_pool_get_config(configPool, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(configPool, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) call MPAS_pool_get_config(configPool, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(configPool, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) call MPAS_pool_get_config(configPool, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) @@ -419,11 +413,10 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ call MPAS_pool_get_package(packagePool, "pkgTracerVerticalDONActive", pkgTracerVerticalDONActive) call MPAS_pool_get_package(packagePool, "pkgTracerVerticalIronActive", pkgTracerVerticalIronActive) call MPAS_pool_get_package(packagePool, "pkgTracerZAerosolsActive", pkgTracerZAerosolsActive) - call MPAS_pool_get_package(packagePool, "pkgTracerZSalinityActive", pkgTracerZSalinityActive) call MPAS_pool_get_package(packagePool, "pkgColumnTracerEffectiveSnowDensityActive", pkgColumnTracerEffectiveSnowDensityActive) call MPAS_pool_get_package(packagePool, "pkgColumnTracerSnowGrainRadiusActive", pkgColumnTracerSnowGrainRadiusActive) - use_meltponds = (config_use_cesm_meltponds .or. config_use_level_meltponds .or. config_use_topo_meltponds) + use_meltponds = (config_use_level_meltponds .or. config_use_topo_meltponds) pkgColumnTracerIceAgeActive = config_use_ice_age pkgColumnTracerFirstYearIceActive = config_use_first_year_ice @@ -455,7 +448,6 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ pkgTracerVerticalDONActive = (config_use_vertical_tracers .and. config_use_DON) pkgTracerVerticalIronActive = (config_use_vertical_tracers .and. config_use_iron) pkgTracerZAerosolsActive = config_use_zaerosols - pkgTracerZSalinityActive = config_use_vertical_zsalinity pkgColumnTracerEffectiveSnowDensityActive = config_use_effective_snow_density pkgColumnTracerSnowGrainRadiusActive = config_use_snow_grain_radius @@ -490,7 +482,6 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ pkgTracerVerticalDONActive = .false. pkgTracerVerticalIronActive = .false. pkgTracerZAerosolsActive = .false. - pkgTracerZSalinityActive = .false. pkgColumnTracerEffectiveSnowDensityActive = .false. pkgColumnTracerSnowGrainRadiusActive = .false. endif @@ -516,7 +507,6 @@ subroutine setup_packages_column_physics(configPool, packagePool, ierr)!{{{ pkgTracerVerticalHumicsActive = .false. pkgTracerVerticalDONActive = .false. pkgTracerVerticalIronActive = .false. - pkgTracerZSalinityActive = .false. endif !pkgColumnTracerIceAgeActive = .true. diff --git a/components/mpas-seaice/src/seaice.cmake b/components/mpas-seaice/src/seaice.cmake index 708fb8271f29..e0291ac25587 100644 --- a/components/mpas-seaice/src/seaice.cmake +++ b/components/mpas-seaice/src/seaice.cmake @@ -47,41 +47,6 @@ list(APPEND RAW_SOURCES core_seaice/icepack/columnphysics/icepack_zbgc_shared.F90 ) -# column -list(APPEND RAW_SOURCES - core_seaice/column/ice_colpkg.F90 - core_seaice/column/ice_kinds_mod.F90 - core_seaice/column/ice_warnings.F90 - core_seaice/column/ice_colpkg_shared.F90 - core_seaice/column/constants/cesm/ice_constants_colpkg.F90 - core_seaice/column/ice_therm_shared.F90 - core_seaice/column/ice_orbital.F90 - core_seaice/column/ice_mushy_physics.F90 - core_seaice/column/ice_therm_mushy.F90 - core_seaice/column/ice_atmo.F90 - core_seaice/column/ice_age.F90 - core_seaice/column/ice_firstyear.F90 - core_seaice/column/ice_flux_colpkg.F90 - core_seaice/column/ice_meltpond_cesm.F90 - core_seaice/column/ice_meltpond_lvl.F90 - core_seaice/column/ice_meltpond_topo.F90 - core_seaice/column/ice_therm_vertical.F90 - core_seaice/column/ice_therm_bl99.F90 - core_seaice/column/ice_therm_0layer.F90 - core_seaice/column/ice_itd.F90 - core_seaice/column/ice_colpkg_tracers.F90 - core_seaice/column/ice_therm_itd.F90 - core_seaice/column/ice_shortwave.F90 - core_seaice/column/ice_mechred.F90 - core_seaice/column/ice_aerosol.F90 - core_seaice/column/ice_brine.F90 - core_seaice/column/ice_algae.F90 - core_seaice/column/ice_zbgc.F90 - core_seaice/column/ice_zbgc_shared.F90 - core_seaice/column/ice_zsalinity.F90 - core_seaice/column/ice_snow.F90 -) - # shared list(APPEND RAW_SOURCES core_seaice/shared/mpas_seaice_time_integration.F @@ -105,7 +70,6 @@ list(APPEND RAW_SOURCES core_seaice/shared/mpas_seaice_diagnostics.F core_seaice/shared/mpas_seaice_numerics.F core_seaice/shared/mpas_seaice_constants.F - core_seaice/shared/mpas_seaice_column.F core_seaice/shared/mpas_seaice_icepack.F core_seaice/shared/mpas_seaice_diagnostics.F core_seaice/shared/mpas_seaice_error.F diff --git a/components/mpas-seaice/src/shared/Makefile b/components/mpas-seaice/src/shared/Makefile index 948f5199bb99..6b119d24fb75 100644 --- a/components/mpas-seaice/src/shared/Makefile +++ b/components/mpas-seaice/src/shared/Makefile @@ -21,7 +21,6 @@ OBJS = mpas_seaice_time_integration.o \ mpas_seaice_diagnostics.o \ mpas_seaice_numerics.o \ mpas_seaice_constants.o \ - mpas_seaice_column.o \ mpas_seaice_icepack.o \ mpas_seaice_diagnostics.o \ mpas_seaice_error.o \ @@ -37,8 +36,6 @@ mpas_seaice_error.o: mpas_seaice_mesh_pool.o: -mpas_seaice_column.o: mpas_seaice_error.o - mpas_seaice_icepack.o: mpas_seaice_error.o mpas_seaice_diagnostics.o: mpas_seaice_constants.o @@ -51,7 +48,7 @@ mpas_seaice_testing.o: mpas_seaice_constants.o mpas_seaice_velocity_solver_constitutive_relation.o: mpas_seaice_constants.o mpas_seaice_testing.o -mpas_seaice_forcing.o: mpas_seaice_constants.o mpas_seaice_mesh.o mpas_seaice_column.o mpas_seaice_icepack.o +mpas_seaice_forcing.o: mpas_seaice_constants.o mpas_seaice_mesh.o mpas_seaice_icepack.o mpas_seaice_wachspress_basis.o: mpas_seaice_mesh.o @@ -67,7 +64,7 @@ mpas_seaice_velocity_solver_pwl.o: mpas_seaice_constants.o mpas_seaice_numerics. mpas_seaice_velocity_solver_variational.o: mpas_seaice_constants.o mpas_seaice_velocity_solver_constitutive_relation.o mpas_seaice_velocity_solver_wachspress.o mpas_seaice_velocity_solver_pwl.o mpas_seaice_mesh_pool.o mpas_seaice_mesh.o -mpas_seaice_velocity_solver.o: mpas_seaice_constants.o mpas_seaice_mesh.o mpas_seaice_testing.o mpas_seaice_velocity_solver_weak.o mpas_seaice_velocity_solver_constitutive_relation.o mpas_seaice_velocity_solver_variational.o mpas_seaice_diagnostics.o mpas_seaice_mesh_pool.o mpas_seaice_special_boundaries.o mpas_seaice_column.o mpas_seaice_icepack.o +mpas_seaice_velocity_solver.o: mpas_seaice_constants.o mpas_seaice_mesh.o mpas_seaice_testing.o mpas_seaice_velocity_solver_weak.o mpas_seaice_velocity_solver_constitutive_relation.o mpas_seaice_velocity_solver_variational.o mpas_seaice_diagnostics.o mpas_seaice_mesh_pool.o mpas_seaice_special_boundaries.o mpas_seaice_icepack.o mpas_seaice_advection_upwind.o: mpas_seaice_constants.o mpas_seaice_mesh.o @@ -77,13 +74,13 @@ mpas_seaice_advection_incremental_remap.o: mpas_seaice_constants.o mpas_seaice_m mpas_seaice_advection.o: mpas_seaice_advection_upwind.o mpas_seaice_advection_incremental_remap.o -mpas_seaice_prescribed.o: mpas_seaice_constants.o mpas_seaice_column.o mpas_seaice_icepack.o +mpas_seaice_prescribed.o: mpas_seaice_constants.o mpas_seaice_icepack.o -mpas_seaice_time_integration.o: mpas_seaice_constants.o mpas_seaice_velocity_solver.o mpas_seaice_forcing.o mpas_seaice_advection.o mpas_seaice_diagnostics.o mpas_seaice_column.o mpas_seaice_icepack.o mpas_seaice_prescribed.o mpas_seaice_special_boundaries.o +mpas_seaice_time_integration.o: mpas_seaice_constants.o mpas_seaice_velocity_solver.o mpas_seaice_forcing.o mpas_seaice_advection.o mpas_seaice_diagnostics.o mpas_seaice_icepack.o mpas_seaice_prescribed.o mpas_seaice_special_boundaries.o -mpas_seaice_initialize.o: mpas_seaice_constants.o mpas_seaice_mesh.o mpas_seaice_velocity_solver.o mpas_seaice_testing.o mpas_seaice_forcing.o mpas_seaice_advection.o mpas_seaice_column.o mpas_seaice_icepack.o mpas_seaice_forcing.o mpas_seaice_mesh_pool.o mpas_seaice_special_boundaries.o +mpas_seaice_initialize.o: mpas_seaice_constants.o mpas_seaice_mesh.o mpas_seaice_velocity_solver.o mpas_seaice_testing.o mpas_seaice_forcing.o mpas_seaice_advection.o mpas_seaice_icepack.o mpas_seaice_forcing.o mpas_seaice_mesh_pool.o mpas_seaice_special_boundaries.o -mpas_seaice_core.o: mpas_seaice_constants.o mpas_seaice_time_integration.o mpas_seaice_velocity_solver.o mpas_seaice_forcing.o mpas_seaice_initialize.o mpas_seaice_column.o mpas_seaice_icepack.o mpas_seaice_mesh_pool.o mpas_seaice_icepack.o +mpas_seaice_core.o: mpas_seaice_constants.o mpas_seaice_time_integration.o mpas_seaice_velocity_solver.o mpas_seaice_forcing.o mpas_seaice_initialize.o mpas_seaice_icepack.o mpas_seaice_mesh_pool.o mpas_seaice_icepack.o mpas_seaice_core_interface.o: mpas_seaice_core.o diff --git a/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap.F b/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap.F index d57d1ddd29b3..f693d0d2a026 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap.F @@ -8144,6 +8144,8 @@ subroutine check_tracer_conservation(dminfo, tracersHead, abortFlag) thisTracer => tracersHead + abortFlag = .false. + do while (associated(thisTracer)) if (thisTracer % ndims == 2) then diff --git a/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap_tracers.F b/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap_tracers.F index 398338a9a712..c00b96738aa9 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap_tracers.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_advection_incremental_remap_tracers.F @@ -192,8 +192,7 @@ subroutine seaice_add_tracers_to_linked_list(domain) pkgTracerVerticalHumicsActive, & pkgTracerVerticalDONActive, & pkgTracerVerticalIronActive, & - pkgTracerZAerosolsActive, & - pkgTracerZSalinityActive + pkgTracerZAerosolsActive logical, pointer :: & config_use_level_meltponds @@ -289,8 +288,6 @@ subroutine seaice_add_tracers_to_linked_list(domain) pkgTracerVerticalIronActive) call MPAS_pool_get_package(domain % blocklist % packages, 'pkgTracerZAerosolsActive', & pkgTracerZAerosolsActive) - call MPAS_pool_get_package(domain % blocklist % packages, 'pkgTracerZSalinityActive', & - pkgTracerZSalinityActive) configPool => domain % blocklist % configs call MPAS_pool_get_config(configPool, "config_use_level_meltponds", config_use_level_meltponds) @@ -470,10 +467,6 @@ subroutine seaice_add_tracers_to_linked_list(domain) call add_tracer_to_tracer_linked_list(tracersHead, 'verticalAerosolsSnow','snowVolumeCategory') endif - ! vertical salinity - if (pkgTracerZSalinityActive) & - call add_tracer_to_tracer_linked_list(tracersHead, 'verticalSalinity', 'brineFraction') - if (verboseTracers) then thisTracer => tracersHead call mpas_log_write(' ') diff --git a/components/mpas-seaice/src/shared/mpas_seaice_column.F b/components/mpas-seaice/src/shared/mpas_seaice_column.F deleted file mode 100644 index 80a00a154d99..000000000000 --- a/components/mpas-seaice/src/shared/mpas_seaice_column.F +++ /dev/null @@ -1,16565 +0,0 @@ -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 12th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - -module seaice_column - - use mpas_derived_types - use mpas_pool_routines - use mpas_timekeeping - use mpas_timer - use mpas_log, only: mpas_log_write - - use seaice_error - - use ice_kinds_mod, only: & - char_len_long - - implicit none - - private - save - - public :: & - seaice_init_column_physics_package_parameters, & - seaice_init_column_physics_package_variables, & - seaice_column_predynamics_time_integration, & - seaice_column_dynamics_time_integration, & - seaice_column_postdynamics_time_integration, & - seaice_init_column_shortwave, & - seaice_column_aggregate, & - seaice_column_aggregate_simple, & - seaice_column_initial_air_drag_coefficient, & - seaice_column_reinitialize_fluxes, & - seaice_column_reinitialize_diagnostics_thermodynamics, & - seaice_column_reinitialize_diagnostics_dynamics, & - seaice_column_reinitialize_diagnostics_bgc, & - seaice_column_coupling_prep, & - seaice_column_finalize, & - seaice_column_init_trcr, & - seaice_column_init_itd, & - seaice_column_init_ocean_conc, & - seaice_column_ice_strength, & - seaice_column_sea_freezing_temperature, & - seaice_column_liquidus_temperature, & - seaice_column_enthalpy_snow, & - seaice_column_enthalpy_ice, & - seaice_column_salinity_profile, & - seaice_init_column_constants - - ! tracer object - type, private :: ciceTracerObjectType - - !----------------------------------------------------------------------- - ! base tracer object - !----------------------------------------------------------------------- - - ! length of tracer array - integer :: nTracers !ntrcr - - ! number of base tracers - integer :: nBaseTracers = 3 - - ! maximum number of ancestor tracers - integer :: nMaxAncestorTracers = 2 - - ! index of the parent tracer - integer, dimension(:), allocatable :: parentIndex ! trcr_depend - - ! first ancestor type mask - real(kind=RKIND), dimension(:,:), allocatable :: firstAncestorMask !trcr_base - - ! indices of ancestor tracers excluding base tracer - integer, dimension(:,:), allocatable :: ancestorIndices ! nt_strata - - ! number of ancestor tracers excluding base tracer - integer, dimension(:), allocatable :: ancestorNumber ! n_trcr_strata - - !----------------------------------------------------------------------- - ! physics - !----------------------------------------------------------------------- - - ! indexes of physics tracers in tracer array - integer :: & - index_surfaceTemperature, & ! nt_Tsfc - index_iceEnthalpy, & ! nt_qice - index_snowEnthalpy, & ! nt_qsno - index_iceSalinity, & ! nt_sice - index_iceAge, & ! nt_iage - index_firstYearIceArea, & ! nt_FY - index_levelIceArea, & ! nt_alvl - index_levelIceVolume, & ! nt_vlvl - index_pondArea, & ! nt_apnd - index_pondDepth, & ! nt_hpnd - index_pondLidThickness, & ! nt_ipnd - index_aerosols, & ! nt_aero - index_snowIceMass, & ! nt_smice - index_snowLiquidMass, & ! nt_smliq - index_snowGrainRadius, & ! nt_rsnw - index_snowDensity ! nt_rhos - - !----------------------------------------------------------------------- - ! biogeochemistry - !----------------------------------------------------------------------- - - ! length of tracer array not including biology and biology related tracers - integer :: nTracersNotBio !ntrcr - ntrcr(bio) - - ! length of bio tracer array (does not include biology related tracers) - integer :: nBioTracers !nbtrcr - - ! number of bio tracers used (does not include brine or mobilefraction) - integer :: nBioTracersLayer !nltrcr - - ! length of shortwave bio tracer array (for aerosols and chlorophyll) - integer :: nBioTracersShortwave !nbtrcr_sw - - ! length of bio indices - integer :: & - nAlgaeIndex, & - nAlgalCarbonIndex, & - nAlgalChlorophyllIndex, & - nDOCIndex, & - nDONIndex, & - nDICIndex, & - nDissolvedIronIndex, & - nParticulateIronIndex, & - nzAerosolsIndex - - ! indexes of BGC tracers in tracer array - integer :: & - index_brineFraction, & ! nt_fbri - index_nitrateConc, & ! nt_bgc_Nit - index_ammoniumConc, & ! nt_bgc_Am - index_silicateConc, & ! nt_bgc_Sil - index_DMSPpConc, & ! nt_bgc_DMSPp - index_DMSPdConc, & ! nt_bgc_DMSPd - index_DMSConc, & ! nt_bgc_DMS - index_nonreactiveConc, & ! nt_bgc_PON - index_humicsConc, & ! nt_bgc_hum - index_mobileFraction, & ! nt_zbgc_frac - index_verticalSalinity, & ! nt_bgc_S - index_chlorophyllShortwave, & ! nlt_chl_sw - index_nitrateConcLayer, & ! nlt_bgc_Nit - index_ammoniumConcLayer, & ! nlt_bgc_Am - index_silicateConcLayer, & ! nlt_bgc_Sil - index_DMSPpConcLayer, & ! nlt_bgc_DMSPp - index_DMSPdConcLayer, & ! nlt_bgc_DMSPd - index_DMSConcLayer, & ! nlt_bgc_DMS - index_nonreactiveConcLayer, & ! nlt_bgc_PON - index_humicsConcLayer ! nlt_bgc_hum - - ! indexes of bio tracers with types in tracer array - integer, dimension(:), allocatable :: & - index_algaeConc, & ! nt_bgc_N - index_algalCarbon, & ! nt_bgc_C - index_algalChlorophyll, & ! nt_bgc_chl - index_DOCConc, & ! nt_bgc_DOC - index_DONConc, & ! nt_bgc_DON - index_DICConc, & ! nt_bgc_DIC - index_dissolvedIronConc, & ! nt_bgc_Fed - index_particulateIronConc, & ! nt_bgc_Fep - index_verticalAerosolsConc, & ! nt_zaero - index_algaeConcLayer, & ! nlt_bgc_N - index_algalCarbonLayer, & ! nlt_bgc_C - index_algalChlorophyllLayer, & ! nlt_bgc_chl - index_DOCConcLayer, & ! nlt_bgc_DOC - index_DONConcLayer, & ! nlt_bgc_DON - index_DICConcLayer, & ! nlt_bgc_DIC - index_dissolvedIronConcLayer, & ! nlt_bgc_Fed - index_particulateIronConcLayer, & ! nlt_bgc_Fep - index_verticalAerosolsConcLayer, & ! nlt_zaero - index_verticalAerosolsConcShortwave, & ! nlt_zaero_sw - index_LayerIndexToDataArray, & ! relates nlt to data array - index_LayerIndexToBioIndex ! relates nlt to nt - - end type ciceTracerObjectType - - type(ciceTracerObjectType), private :: ciceTracerObject - - real(kind=RKIND), dimension(:,:), allocatable :: & - tracerArrayCategory -!$omp threadprivate(tracerArrayCategory) - - real(kind=RKIND), dimension(:), allocatable :: & - tracerArrayCell - - ! warnings string kind - integer, parameter :: strKINDWarnings = char_len_long - -contains - -!----------------------------------------------------------------------- -! Initialize Column Physics Package -!----------------------------------------------------------------------- - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_init_column_physics_package_parameters -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 18th March 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_init_column_physics_package_parameters(domain) - - type(domain_type), intent(inout) :: domain - - logical, pointer :: & - config_use_column_physics - - call MPAS_pool_get_config(domain % configs, "config_use_column_physics", config_use_column_physics) - if (config_use_column_physics) then - - ! set non activated variable pointers to other memory - call init_column_non_activated_pointers(domain) - - ! initialize the column package tracer object - call init_column_tracer_object(domain, ciceTracerObject) - - ! initialize the column package parameters - call init_column_package_parameters(domain, ciceTracerObject) - - ! initialize active column processes - call init_column_active_processes(domain) - - endif - - end subroutine seaice_init_column_physics_package_parameters - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_init_column_physics_package_variables -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 18th March 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_init_column_physics_package_variables(domain, clock) - - type(domain_type), intent(inout) :: domain - - type (MPAS_Clock_type), intent(in) :: & - clock !< Input: - - logical, pointer :: & - config_use_column_physics, & - config_do_restart, & - config_use_column_biogeochemistry, & - config_use_column_shortwave, & - config_use_column_snow_tracers, & - config_use_zaerosols - - call MPAS_pool_get_config(domain % configs, "config_use_column_physics", config_use_column_physics) - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - - if (config_use_column_physics) then - - ! initialize level ice tracers - call init_column_level_ice_tracers(domain) - - ! initialize the itd thickness classes - call init_column_itd(domain) - - ! initialize thermodynamic tracer profiles - call init_column_thermodynamic_profiles(domain) - - ! initialize biogoechemistry profiles - if (config_use_column_biogeochemistry .or. config_use_zaerosols) & - call init_column_biogeochemistry_profiles(domain, ciceTracerObject) - - ! history variables - call init_column_history_variables(domain) - - ! snow - call MPAS_pool_get_config(domain % configs, "config_use_column_snow_tracers", config_use_column_snow_tracers) - if (config_use_column_snow_tracers) & - call init_column_snow_tracers(domain) - - ! shortwave - call MPAS_pool_get_config(domain % configs, "config_do_restart", config_do_restart) - call MPAS_pool_get_config(domain % configs, "config_use_column_shortwave", config_use_column_shortwave) - if (config_do_restart .and. config_use_column_shortwave) & - call seaice_init_column_shortwave(domain, clock) - - endif - - end subroutine seaice_init_column_physics_package_variables - -!----------------------------------------------------------------------- -! column package initialization routine wrappers -!----------------------------------------------------------------------- - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_itd -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_itd(domain) - - use ice_colpkg, only: colpkg_init_itd - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - initial - - real(kind=RKIND), dimension(:), pointer :: & - categoryThicknessLimits - - integer, pointer :: & - nCategories - - logical :: & - abortFlag - - character(len=strKIND) :: & - abortMessage - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nCategories", nCategories) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "initial", initial) - - call MPAS_pool_get_array(initial, "categoryThicknessLimits", categoryThicknessLimits) - - ! code abort - abortFlag = .false. - abortMessage = "" - - call colpkg_init_itd(& - nCategories, & - categoryThicknessLimits, & - abortFlag, & - abortMessage) - - ! code abort - if (abortFlag) then - call mpas_log_write("init_column_itd: "//trim(abortMessage), messageType=MPAS_LOG_CRIT) - endif - - block => block % next - end do - - end subroutine init_column_itd - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_thermo -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_thermodynamic_profiles(domain) - - use ice_colpkg, only: & - colpkg_init_thermo, & - colpkg_liquidus_temperature - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - initial - - integer, pointer :: & - nCellsSolve, & - nIceLayers - - integer :: & - iCell, & - iIceLayer - - real(kind=RKIND), dimension(:), allocatable :: & - initialSalinityProfileVertical - - real(kind=RKIND), dimension(:,:), pointer :: & - initialSalinityProfile, & - initialMeltingTemperatureProfile - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_dimension(block % dimensions, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - - allocate(initialSalinityProfileVertical(1:nIceLayers+1)) - - call colpkg_init_thermo(& - nIceLayers, & - initialSalinityProfileVertical) - - call MPAS_pool_get_subpool(block % structs, "initial", initial) - - call MPAS_pool_get_array(initial, "initialSalinityProfile", initialSalinityProfile) - call MPAS_pool_get_array(initial, "initialMeltingTemperatureProfile", initialMeltingTemperatureProfile) - - do iCell = 1, nCellsSolve - do iIceLayer = 1, nIceLayers + 1 - - ! these profiles are not used by mushy - initialSalinityProfile(iIceLayer,iCell) = initialSalinityProfileVertical(iIceLayer) - initialMeltingTemperatureProfile(iIceLayer,iCell) = & - colpkg_liquidus_temperature(initialSalinityProfileVertical(iIceLayer)) - - enddo ! iIceLayer - enddo ! iCell - - deallocate(initialSalinityProfileVertical) - - block => block % next - end do - - end subroutine init_column_thermodynamic_profiles - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_snow_tracers -! -!> \brief Initializes snow physics tracers -!> -!> \author Nicole Jeffery, LANL -!> \date 1 April 2017 -!> \details -!> -!> The following snow tracers are initialized: -!> 1) Snow liquid content (used to compute wet metamorphism of snow grain, modifies -!> liquid content of ponds, used in calculation of effective snow density due to content) -!> 2) Snow ice content (Used in calculation of effective snow density due to content) -!> 3) Effective snow density (both content and compaction are included. May be used for snow grain aging) -!> 4) Snow grain radius (used in radiative transfer calculations) -! -!----------------------------------------------------------------------- - - subroutine init_column_snow_tracers(domain) - - use seaice_constants, only: & - seaicePuny, & - seaiceDensitySnow - - type(domain_type), intent(in) :: & - domain - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - tracers_aggregate, & - snow - - logical, pointer :: & - config_use_effective_snow_density, & - config_use_snow_grain_radius, & - config_do_restart_snow_density, & - config_do_restart_snow_grain_radius - - real(kind=RKIND), dimension(:,:,:), pointer :: & - snowIceMass, & - snowLiquidMass, & - snowDensity, & - snowVolumeCategory, & - snowGrainRadius - - real(kind=RKIND), dimension(:,:), pointer :: & - snowMeltMassCategory - - real(kind=RKIND), dimension(:), pointer :: & - snowDensityViaContent, & - snowDensityViaCompaction, & - snowMeltMassCell, & - snowVolumeCell - - real(kind=RKIND), pointer :: & - config_fallen_snow_radius, & - config_new_snow_density - - integer, pointer :: & - nCellsSolve, & - nSnowLayers, & - nCategories - - integer :: & - iCell, & - iSnowLayer, & - iCategory - - call MPAS_pool_get_config(domain % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(domain % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - call MPAS_pool_get_config(domain % configs, "config_fallen_snow_radius", config_fallen_snow_radius) - call MPAS_pool_get_config(domain % configs, "config_new_snow_density", config_new_snow_density) - call MPAS_pool_get_config(domain % configs, "config_do_restart_snow_density", config_do_restart_snow_density) - call MPAS_pool_get_config(domain % configs, "config_do_restart_snow_grain_radius", config_do_restart_snow_grain_radius) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "snow", snow) - - call MPAS_pool_get_dimension(block % dimensions, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(block % dimensions, "nCategories", nCategories) - call MPAS_pool_get_dimension(block % dimensions, "nSnowLayers", nSnowLayers) - - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - call MPAS_pool_get_array(tracers_aggregate, "snowVolumeCell", snowVolumeCell) - call MPAS_pool_get_array(snow, "snowMeltMassCategory", snowMeltMassCategory) - call MPAS_pool_get_array(snow, "snowMeltMassCell", snowMeltMassCell) - call MPAS_pool_get_array(snow, "snowDensityViaContent", snowDensityViaContent) - - snowMeltMassCategory(:,:) = 0.0_RKIND - snowMeltMassCell(:) = 0.0_RKIND - snowDensityViaContent(:) = seaiceDensitySnow - - if (config_use_effective_snow_density) then - - call MPAS_pool_get_array(snow, "snowDensityViaCompaction", snowDensityViaCompaction) - call MPAS_pool_get_array(tracers, "snowDensity", snowDensity, 1) - - if (.not. config_do_restart_snow_density) then - - snowDensity(:,:,:) = config_new_snow_density !0.0_RKIND - do iCell = 1, nCellsSolve - if (snowVolumeCell(iCell) .gt. seaicePuny) then - snowDensityViaCompaction(iCell) = config_new_snow_density - else - snowDensityViaCompaction(iCell) = 0.0_RKIND - endif - enddo - else - snowDensityViaCompaction(:) = 0.0_RKIND - - do iCell = 1, nCellsSolve - - do iCategory = 1, nCategories - if (snowVolumeCategory(1,iCategory,iCell) .gt. 0.0_RKIND) then - do iSnowLayer = 1, nSnowLayers - snowDensityViaCompaction(iCell) = snowDensityViaCompaction(iCell) & - + snowVolumeCategory(1,iCategory,iCell) * & - snowDensity(iSnowLayer,iCategory,iCell) - enddo !iSnowLayer - endif !snowVolumeCategory - enddo !iCategory - if (snowVolumeCell(iCell) .gt. seaicePuny) then - snowDensityViaCompaction(iCell) = snowDensityViaCompaction(iCell)/ & - (snowVolumeCell(iCell) * real(nSnowLayers,kind=RKIND)) - else - snowDensityViaCompaction(iCell) = 0.0_RKIND - endif !snowVolumeCell - - enddo ! iCell - endif ! config_do_restart_snow_density - endif !config_use_effective_snow_density - - if (config_use_snow_grain_radius) then - - call MPAS_pool_get_array(tracers, "snowIceMass", snowIceMass, 1) - call MPAS_pool_get_array(tracers, "snowLiquidMass", snowLiquidMass, 1) - call MPAS_pool_get_array(tracers, "snowGrainRadius", snowGrainRadius, 1) - - if (.not. config_do_restart_snow_grain_radius) then - - snowGrainRadius(:,:,:) = config_fallen_snow_radius - snowIceMass(:,:,:) = seaiceDensitySnow - snowLiquidMass(:,:,:) = 0.0_RKIND - snowDensityViaContent(:) = seaiceDensitySnow - - else - do iCell = 1, nCellsSolve - snowDensityViaContent(iCell) = 0.0_RKIND - do iCategory = 1, nCategories - if (snowVolumeCategory(1,iCategory,iCell) .gt. 0.0_RKIND) then - do iSnowLayer = 1, nSnowLayers - snowDensityViaContent(iCell) = snowDensityViaContent(iCell) & - + snowVolumeCategory(1,iCategory,iCell) * & - (snowIceMass(iSnowLayer,iCategory,iCell) + & - snowLiquidMass(iSnowLayer,iCategory,iCell)) - enddo !iSnowLayer - endif !snowVolumeCategory - enddo !iCategory - if (snowVolumeCell(iCell) .gt. seaicePuny) then - snowDensityViaContent(iCell) = snowDensityViaContent(iCell)/ & - (snowVolumeCell(iCell) * real(nSnowLayers,kind=RKIND)) !!!CHECK THIS!!! - else - snowDensityViaContent(iCell) = seaiceDensitySnow - endif !snowVolumeCell - enddo ! iCell - endif ! config_do_restart_snow_grain_radius - endif ! config_use_snow_grain_radius - block => block % next - end do - - end subroutine init_column_snow_tracers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_shortwave -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_init_column_shortwave(domain, clock) - - use ice_colpkg, only: & - colpkg_init_orbit, & - colpkg_clear_warnings - - use seaice_constants, only: & - seaicePuny - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - logical :: & - abortFlag - - character(len=strKIND) :: & - abortMessage - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - shortwave, & - atmos_coupling - - real(kind=RKIND), dimension(:), pointer :: & - solarZenithAngleCosine, & - albedoVisibleDirectCell, & - albedoVisibleDiffuseCell, & - albedoIRDirectCell, & - albedoIRDiffuseCell, & - albedoVisibleDirectArea, & - albedoVisibleDiffuseArea, & - albedoIRDirectArea, & - albedoIRDiffuseArea, & - bareIceAlbedoCell, & - snowAlbedoCell, & - pondAlbedoCell, & - effectivePondAreaCell, & - shortwaveScalingFactor, & - shortwaveVisibleDirectDown, & - shortwaveVisibleDiffuseDown, & - shortwaveIRDirectDown, & - shortwaveIRDiffuseDown - - real(kind=RKIND), dimension(:,:), pointer :: & - albedoVisibleDirectCategory, & - albedoVisibleDiffuseCategory, & - albedoIRDirectCategory, & - albedoIRDiffuseCategory, & - bareIceAlbedoCategory, & - snowAlbedoCategory, & - pondAlbedoCategory, & - effectivePondAreaCategory - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory - - integer, pointer :: & - nCellsSolve, & - nCategories - - integer :: & - iCell, & - iCategory - - character(len=strKIND), pointer :: & - config_shortwave_type - - logical, pointer :: & - config_do_restart, & - config_use_snicar_ad - - call MPAS_pool_get_config(domain % configs, "config_shortwave_type", config_shortwave_type) - call MPAS_pool_get_config(domain % configs, "config_do_restart", config_do_restart) - call MPAS_pool_get_config(domain % configs, "config_use_snicar_ad", config_use_snicar_ad) - - if (trim(config_shortwave_type) == "dEdd") then - - ! code abort - abortFlag = .false. - abortMessage = "" - - call colpkg_clear_warnings() - call colpkg_init_orbit(& - abortFlag, & - abortMessage) - call column_write_warnings(abortFlag) - - ! code abort - if (abortFlag) then - call mpas_log_write("colpkg_init_orbit: "//trim(abortMessage), messageType=MPAS_LOG_CRIT) - endif - - endif - - call column_radiation(& - domain, & - clock, & - .true.) - - ! other shortwave initialization - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - - call MPAS_pool_get_array(shortwave, "solarZenithAngleCosine", solarZenithAngleCosine) - - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectCell", albedoVisibleDirectCell) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseCell", albedoVisibleDiffuseCell) - call MPAS_pool_get_array(shortwave, "albedoIRDirectCell", albedoIRDirectCell) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseCell", albedoIRDiffuseCell) - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectCategory", albedoVisibleDirectCategory) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseCategory", albedoVisibleDiffuseCategory) - call MPAS_pool_get_array(shortwave, "albedoIRDirectCategory", albedoIRDirectCategory) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseCategory", albedoIRDiffuseCategory) - - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectArea", albedoVisibleDirectArea) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseArea", albedoVisibleDiffuseArea) - call MPAS_pool_get_array(shortwave, "albedoIRDirectArea", albedoIRDirectArea) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseArea", albedoIRDiffuseArea) - - call MPAS_pool_get_array(shortwave, "bareIceAlbedoCell", bareIceAlbedoCell) - call MPAS_pool_get_array(shortwave, "snowAlbedoCell", snowAlbedoCell) - call MPAS_pool_get_array(shortwave, "pondAlbedoCell", pondAlbedoCell) - - call MPAS_pool_get_array(shortwave, "bareIceAlbedoCategory", bareIceAlbedoCategory) - call MPAS_pool_get_array(shortwave, "snowAlbedoCategory", snowAlbedoCategory) - call MPAS_pool_get_array(shortwave, "pondAlbedoCategory", pondAlbedoCategory) - - call MPAS_pool_get_array(shortwave, "effectivePondAreaCell", effectivePondAreaCell) - call MPAS_pool_get_array(shortwave, "effectivePondAreaCategory", effectivePondAreaCategory) - - call MPAS_pool_get_array(shortwave, "shortwaveScalingFactor", shortwaveScalingFactor) - - call MPAS_pool_get_array(atmos_coupling, "shortwaveVisibleDirectDown", shortwaveVisibleDirectDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveVisibleDiffuseDown", shortwaveVisibleDiffuseDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveIRDirectDown", shortwaveIRDirectDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveIRDiffuseDown", shortwaveIRDiffuseDown) - - do iCell = 1, nCellsSolve - - albedoVisibleDirectCell(iCell) = 0.0_RKIND - albedoVisibleDiffuseCell(iCell) = 0.0_RKIND - albedoIRDirectCell(iCell) = 0.0_RKIND - albedoIRDiffuseCell(iCell) = 0.0_RKIND - - do iCategory = 1, nCategories - - ! aggregate albedos - if (iceAreaCategory(1,iCategory,iCell) > seaicePuny) then - - albedoVisibleDirectCell(iCell) = albedoVisibleDirectCell(iCell) + & - albedoVisibleDirectCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - albedoVisibleDiffuseCell(iCell) = albedoVisibleDiffuseCell(iCell) + & - albedoVisibleDiffuseCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - albedoIRDirectCell(iCell) = albedoIRDirectCell(iCell) + & - albedoIRDirectCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - albedoIRDiffuseCell(iCell) = albedoIRDiffuseCell(iCell) + & - albedoIRDiffuseCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - - if (solarZenithAngleCosine(iCell) > seaicePuny) then ! sun above horizon - - bareIceAlbedoCell(iCell) = bareIceAlbedoCell(iCell) + & - bareIceAlbedoCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - snowAlbedoCell(iCell) = snowAlbedoCell(iCell) + & - snowAlbedoCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - pondAlbedoCell(iCell) = pondAlbedoCell(iCell) + & - pondAlbedoCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - - endif - - effectivePondAreaCell(iCell) = effectivePondAreaCell(iCell) + & - effectivePondAreaCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - - endif - - enddo ! iCategory - - ! Store grid box mean albedos and fluxes before scaling by aice - albedoVisibleDirectArea(iCell) = albedoVisibleDirectCell(iCell) - albedoVisibleDiffuseArea(iCell) = albedoVisibleDiffuseCell(iCell) - albedoIRDirectArea(iCell) = albedoIRDirectCell(iCell) - albedoIRDiffuseArea(iCell) = albedoIRDiffuseCell(iCell) - - ! Save net shortwave for scaling factor in scale_factor - if (.not. config_do_restart) then - shortwaveScalingFactor(iCell) = & - shortwaveVisibleDirectDown(iCell) * (1.0_RKIND - albedoVisibleDirectArea(iCell)) + & - shortwaveVisibleDiffuseDown(iCell) * (1.0_RKIND - albedoVisibleDiffuseArea(iCell)) + & - shortwaveIRDirectDown(iCell) * (1.0_RKIND - albedoIRDirectArea(iCell)) + & - shortwaveIRDiffuseDown(iCell) * (1.0_RKIND - albedoIRDiffuseArea(iCell)) - endif - - enddo ! iCell - - block => block % next - end do - - end subroutine seaice_init_column_shortwave - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_thermodynamic_tracers -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_thermodynamic_tracers(domain) - - use ice_colpkg, only: colpkg_init_trcr - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - atmos_coupling, & - ocean_coupling, & - initial - - real(kind=RKIND), dimension(:), pointer :: & - airTemperature, & - seaFreezingTemperature - - real(kind=RKIND), dimension(:,:), pointer :: & - initialSalinityProfile, & - initialMeltingTemperatureProfile - - real(kind=RKIND), dimension(:,:,:), pointer :: & - surfaceTemperature, & - iceEnthalpy, & - snowEnthalpy - - integer, pointer :: & - nCellsSolve, & - nIceLayers, & - nSnowLayers, & - nCategories - - integer :: & - iCell, & - iCategory - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - call MPAS_pool_get_subpool(block % structs, "initial", initial) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - - call MPAS_pool_get_array(atmos_coupling, "airTemperature", airTemperature) - - call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - - call MPAS_pool_get_array(initial, "initialSalinityProfile", initialSalinityProfile) - call MPAS_pool_get_array(initial, "initialMeltingTemperatureProfile", initialMeltingTemperatureProfile) - - call MPAS_pool_get_array(tracers, "surfaceTemperature", surfaceTemperature, 1) - call MPAS_pool_get_array(tracers, "iceEnthalpy", iceEnthalpy, 1) - call MPAS_pool_get_array(tracers, "snowEnthalpy", snowEnthalpy, 1) - - do iCell = 1, nCellsSolve - do iCategory = 1, nCategories - - call colpkg_init_trcr(& - airTemperature(iCell), & - seaFreezingTemperature(iCell), & - initialSalinityProfile(:,iCell), & - initialMeltingTemperatureProfile(:,iCell), & - surfaceTemperature(1,iCategory,iCell), & - nIceLayers, & - nSnowLayers, & - iceEnthalpy(:,iCategory,iCell), & - snowEnthalpy(:,iCategory,iCell)) - - enddo ! iCategory - enddo ! iCell - - block => block % next - end do - - end subroutine init_column_thermodynamic_tracers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_level_ice_tracers -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_level_ice_tracers(domain) - - type(domain_type), intent(inout) :: domain - - logical, pointer :: & - config_use_level_ice, & - config_do_restart - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - tracers - - real(kind=RKIND), dimension(:,:,:), pointer :: & - levelIceArea, & - levelIceVolume - - call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_do_restart", config_do_restart) - - if (config_use_level_ice .and. .not. config_do_restart) then - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_array(tracers, "levelIceArea", levelIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceVolume", levelIceVolume, 1) - - levelIceArea = 1.0_RKIND - levelIceVolume = 1.0_RKIND - - block => block % next - end do - - endif - - end subroutine init_column_level_ice_tracers - -!----------------------------------------------------------------------- -! finalize -!----------------------------------------------------------------------- -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_finalize -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 29th October 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_finalize(domain) - - type(domain_type), intent(inout) :: domain - - call finalize_column_non_activated_pointers(domain) - - end subroutine seaice_column_finalize - -!----------------------------------------------------------------------- -! runtime -!----------------------------------------------------------------------- -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_predynamics_time_integration -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_predynamics_time_integration(domain, clock) - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - logical, pointer :: & - config_use_column_physics, & - config_use_column_shortwave, & - config_use_column_vertical_thermodynamics, & - config_use_column_biogeochemistry, & - config_use_column_itd_thermodynamics, & - config_calc_surface_temperature, & - config_use_vertical_tracers, & - config_use_zaerosols - - real(kind=RKIND), pointer :: & - config_dt - - call MPAS_pool_get_config(domain % configs, "config_use_column_physics", config_use_column_physics) - - if (config_use_column_physics) then - - call MPAS_pool_get_config(domain % configs, "config_use_column_shortwave", config_use_column_shortwave) - call MPAS_pool_get_config(domain % configs, "config_use_column_vertical_thermodynamics", & - config_use_column_vertical_thermodynamics) - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(domain % configs, "config_use_column_itd_thermodynamics", config_use_column_itd_thermodynamics) - call MPAS_pool_get_config(domain % configs, "config_calc_surface_temperature", config_calc_surface_temperature) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - - call MPAS_pool_get_config(domain % configs, "config_dt", config_dt) - - !----------------------------------------------------------------- - ! Scale radiation fields - !----------------------------------------------------------------- - - call mpas_timer_start("Column shortwave prep") - if (config_use_column_shortwave .and. config_calc_surface_temperature) & - call column_prep_radiation(domain) - call mpas_timer_stop("Column shortwave prep") - - !----------------------------------------------------------------- - ! Vertical thermodynamics - !----------------------------------------------------------------- - - call mpas_timer_start("Column vertical thermodynamics") - if (config_use_column_vertical_thermodynamics) & - call column_vertical_thermodynamics(domain, clock) - call mpas_timer_stop("Column vertical thermodynamics") - - !----------------------------------------------------------------- - ! Biogeochemistry - !----------------------------------------------------------------- - - call mpas_timer_start("Column biogeochemistry") - if (config_use_column_biogeochemistry .or. config_use_zaerosols) & - call column_biogeochemistry(domain) - call mpas_timer_stop("Column biogeochemistry") - - !----------------------------------------------------------------- - ! ITD thermodynamics - !----------------------------------------------------------------- - - call mpas_timer_start("Column ITD thermodynamics") - if (config_use_column_itd_thermodynamics) & - call column_itd_thermodynamics(domain, clock) - call mpas_timer_stop("Column ITD thermodynamics") - - !----------------------------------------------------------------- - ! Update the aggregated state variables - !----------------------------------------------------------------- - - call mpas_timer_start("Column predyn update state") - call seaice_column_update_state(domain, "thermodynamics", config_dt, config_dt) - call mpas_timer_stop("Column predyn update state") - - !----------------------------------------------------------------- - ! Separate vertical snow and ice tracers for advection - !----------------------------------------------------------------- - - call mpas_timer_start("Column separate snow/ice tracers") - if (config_use_vertical_tracers) & - call column_separate_snow_ice_tracers(domain) - call mpas_timer_stop("Column separate snow/ice tracers") - - endif - - end subroutine seaice_column_predynamics_time_integration - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_dynamics_time_integration -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_dynamics_time_integration(domain, clock) - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - logical, pointer :: & - config_use_column_physics, & - config_use_column_ridging, & - config_use_vertical_tracers - - type(MPAS_pool_type), pointer :: & - velocitySolver - - real(kind=RKIND), pointer :: & - dynamicsTimeStep - - call MPAS_pool_get_config(domain % configs, "config_use_column_physics", config_use_column_physics) - - if (config_use_column_physics) then - - call MPAS_pool_get_config(domain % configs, "config_use_column_ridging", config_use_column_ridging) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - - call MPAS_pool_get_subpool(domain % blocklist % structs, "velocity_solver", velocitySolver) - call MPAS_pool_get_array(velocitySolver, "dynamicsTimeStep", dynamicsTimeStep) - - !----------------------------------------------------------------- - ! Combine vertical snow and ice tracers - !----------------------------------------------------------------- - - call mpas_timer_start("Column combine snow/ice tracers") - if (config_use_vertical_tracers) & - call column_combine_snow_ice_tracers(domain) - call mpas_timer_stop("Column combine snow/ice tracers") - - !----------------------------------------------------------------- - ! Ridging - !----------------------------------------------------------------- - - call mpas_timer_start("Column ridging") - if (config_use_column_ridging) & - call column_ridging(domain) - call mpas_timer_stop("Column ridging") - - !----------------------------------------------------------------- - ! Update the aggregated state variables - !----------------------------------------------------------------- - - call mpas_timer_start("Column update state") - call seaice_column_update_state(domain, "transport", dynamicsTimeStep, 0.0_RKIND) - call mpas_timer_stop("Column update state") - - else - - call mpas_timer_start("Column aggregate") - call seaice_column_aggregate_simple(domain) - call mpas_timer_stop("Column aggregate") - - endif - - end subroutine seaice_column_dynamics_time_integration - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_postdynamics_time_integration -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_postdynamics_time_integration(domain, clock) - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - logical, pointer :: & - config_use_column_physics, & - config_use_column_shortwave, & - config_use_column_snow_tracers - - type(block_type), pointer :: & - block - - call MPAS_pool_get_config(domain % configs, "config_use_column_physics", config_use_column_physics) - - if (config_use_column_physics) then - - call MPAS_pool_get_config(domain % configs, "config_use_column_shortwave", config_use_column_shortwave) - call MPAS_pool_get_config(domain % configs, "config_use_column_snow_tracers", config_use_column_snow_tracers) - - !----------------------------------------------------------------- - ! snow - !----------------------------------------------------------------- - - call mpas_timer_start("Column snow") - if (config_use_column_snow_tracers) & - call column_snow(domain) - call mpas_timer_stop("Column snow") - - !----------------------------------------------------------------- - ! Shortwave radiation - !----------------------------------------------------------------- - - call mpas_timer_start("Column shortwave") - if (config_use_column_shortwave) & - call column_radiation(domain, clock, .false.) - call mpas_timer_stop("Column shortwave") - - !----------------------------------------------------------------- - ! Coupling prep - !----------------------------------------------------------------- - - call mpas_timer_start("Column coupling prep") - call seaice_column_coupling_prep(domain) - call mpas_timer_stop("Column coupling prep") - - endif - - end subroutine seaice_column_postdynamics_time_integration - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_vertical_thermodynamics -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 20th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_vertical_thermodynamics(domain, clock) - - use ice_colpkg, only: & - colpkg_step_therm1, & - colpkg_clear_warnings - - use seaice_constants, only: & - seaicePuny - - use seaice_mesh, only: & - seaice_interpolate_vertex_to_cell - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - icestate, & - tracers, & - tracers_aggregate, & - velocity_solver, & - atmos_coupling, & - atmos_forcing, & - alternative_atmos_forcing, & - ocean_coupling, & - drag, & - melt_growth_rates, & - atmos_fluxes, & - ocean_fluxes, & - shortwave, & - ponds, & - aerosols, & - diagnostics, & - snow, & - boundary - - ! configs - real(kind=RKIND), pointer :: & - config_dt - - logical, pointer :: & - config_use_aerosols, & - config_use_prescribed_ice, & - config_use_snow_liquid_ponds, & - config_use_high_frequency_coupling - - ! dimensions - integer, pointer :: & - nCellsSolve, & - nCategories, & - nIceLayers, & - nSnowLayers, & - nAerosols - - ! variables - real(kind=RKIND), dimension(:), pointer :: & - latCell, & - iceAreaCellInitial, & - iceAreaCell, & - iceVolumeCell, & - snowVolumeCell, & - uVelocity, & - vvelocity, & - uVelocityCell, & - vvelocityCell, & - uAirVelocity, & - vAirVelocity, & - windSpeed, & - airLevelHeight, & - airSpecificHumidity, & - airDensity, & - airTemperature, & - atmosReferenceTemperature2m, & - atmosReferenceHumidity2m, & - atmosReferenceSpeed10m, & - airOceanDragCoefficientRatio, & - oceanDragCoefficient, & - oceanDragCoefficientSkin, & - oceanDragCoefficientFloe, & - oceanDragCoefficientKeel, & - airDragCoefficient, & - airDragCoefficientSkin, & - airDragCoefficientFloe, & - airDragCoefficientPond, & - airDragCoefficientRidge, & - dragFreeboard, & - dragIceSnowDraft, & - dragRidgeHeight, & - dragRidgeSeparation, & - dragKeelDepth, & - dragKeelSeparation, & - dragFloeLength, & - dragFloeSeparation, & - airStressForcingU, & - airStressForcingV, & - airStressCellU, & - airStressCellV, & - airPotentialTemperature, & - seaSurfaceTemperature, & - seaSurfaceSalinity, & - seaFreezingTemperature, & - oceanStressCellU, & - oceanStressCellV, & - freezingMeltingPotential, & - lateralIceMeltFraction, & - snowfallRate, & - rainfallRate, & - pondFreshWaterFlux, & - surfaceHeatFlux, & - surfaceConductiveFlux, & - absorbedShortwaveFlux, & - longwaveUp, & - longwaveDown, & - solarZenithAngleCosine, & - sensibleHeatFlux, & - latentHeatFlux, & - evaporativeWaterFlux, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFlux, & - oceanShortwaveFlux, & - surfaceIceMelt, & - basalIceMelt, & - lateralIceMelt, & - snowMelt, & - congelation, & - snowiceFormation, & - frazilFormation, & - meltOnset, & - freezeOnset, & - oceanHeatFluxIceBottom, & - openWaterArea, & - snowLossToLeads, & - snowMeltMassCell - - real(kind=RKIND), dimension(:,:), pointer :: & - iceAreaCategoryInitial, & - iceVolumeCategoryInitial, & - snowVolumeCategoryInitial, & - surfaceShortwaveFlux, & - interiorShortwaveFlux, & - penetratingShortwaveFlux, & - sensibleHeatFluxCategory, & - latentHeatFluxCategory, & - surfaceIceMeltCategory, & - basalIceMeltCategory, & - snowMeltCategory, & - congelationCategory, & - snowiceFormationCategory, & - atmosAerosolFlux, & - oceanAerosolFlux, & - pondSnowDepthDifference, & - pondLidMeltFluxFraction, & - surfaceHeatFluxCategory, & - surfaceConductiveFluxCategory, & - latentHeatFluxCouple, & - sensibleHeatFluxCouple, & - surfaceHeatFluxCouple, & - surfaceConductiveFluxCouple, & - snowThicknessChangeCategory, & - snowMeltMassCategory, & - snowRadiusInStandardRadiationSchemeCategory - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - iceVolumeCategory, & - snowVolumeCategory, & - surfaceTemperature, & - levelIceArea, & - levelIceVolume, & - pondArea, & - pondDepth, & - pondLidThickness, & - iceAge, & - firstYearIceArea, & - snowEnthalpy, & - iceEnthalpy, & - iceSalinity, & - absorbedShortwaveIceLayer, & - absorbedShortwaveSnowLayer, & - snowScatteringAerosol, & - snowBodyAerosol, & - iceScatteringAerosol, & - iceBodyAerosol, & - snowIceMass, & - snowLiquidMass, & - snowGrainRadius - - integer, dimension(:), pointer :: & - indexToCellID - - ! local - integer :: & - iCell, & - iCategory, & - iAerosol - - real(kind=RKIND), dimension(:,:,:), allocatable :: & - specificSnowAerosol, & - specificIceAerosol - - logical :: & - northernHemisphereMask, & - abortFlag, & - anyAbort - - character(len=strKIND) :: & - abortMessage, & - abortLocation - - real(kind=RKIND) :: & - dayOfYear - - ! day of year - call get_day_of_year(clock, dayOfYear) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "icestate", icestate) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "velocity_solver", velocity_solver) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - call MPAS_pool_get_subpool(block % structs, "atmos_forcing", atmos_forcing) - call MPAS_pool_get_subpool(block % structs, "alternative_atmos_forcing", alternative_atmos_forcing) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - call MPAS_pool_get_subpool(block % structs, "drag", drag) - call MPAS_pool_get_subpool(block % structs, "melt_growth_rates", melt_growth_rates) - call MPAS_pool_get_subpool(block % structs, "atmos_fluxes", atmos_fluxes) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", ocean_fluxes) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - call MPAS_pool_get_subpool(block % structs, "ponds", ponds) - call MPAS_pool_get_subpool(block % structs, "aerosols", aerosols) - call MPAS_pool_get_subpool(block % structs, "diagnostics", diagnostics) - call MPAS_pool_get_subpool(block % structs, "snow", snow) - call MPAS_pool_get_subpool(block % structs, "boundary", boundary) - - call MPAS_pool_get_config(block % configs, "config_dt", config_dt) - call MPAS_pool_get_config(block % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(block % configs, "config_use_prescribed_ice", config_use_prescribed_ice) - call MPAS_pool_get_config(block % configs, "config_use_snow_liquid_ponds", config_use_snow_liquid_ponds) - call MPAS_pool_get_config(block % configs, "config_use_high_frequency_coupling", config_use_high_frequency_coupling) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(mesh, "nAerosols", nAerosols) - - call MPAS_pool_get_array(mesh, "latCell", latCell) - call MPAS_pool_get_array(mesh, "indexToCellID", indexToCellID) - - call MPAS_pool_get_array(icestate, "iceAreaCellInitial", iceAreaCellInitial) - call MPAS_pool_get_array(icestate, "iceAreaCategoryInitial", iceAreaCategoryInitial) - call MPAS_pool_get_array(icestate, "iceVolumeCategoryInitial", iceVolumeCategoryInitial) - call MPAS_pool_get_array(icestate, "snowVolumeCategoryInitial", snowVolumeCategoryInitial) - call MPAS_pool_get_array(icestate, "openWaterArea", openWaterArea) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "iceVolumeCell", iceVolumeCell) - call MPAS_pool_get_array(tracers_aggregate, "snowVolumeCell", snowVolumeCell) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "surfaceTemperature", surfaceTemperature, 1) - call MPAS_pool_get_array(tracers, "snowEnthalpy", snowEnthalpy, 1) - call MPAS_pool_get_array(tracers, "iceEnthalpy", iceEnthalpy, 1) - call MPAS_pool_get_array(tracers, "iceSalinity", iceSalinity, 1) - call MPAS_pool_get_array(tracers, "levelIceArea", levelIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceVolume", levelIceVolume, 1) - call MPAS_pool_get_array(tracers, "pondArea", pondArea, 1) - call MPAS_pool_get_array(tracers, "pondDepth", pondDepth, 1) - call MPAS_pool_get_array(tracers, "pondLidThickness", pondLidThickness, 1) - call MPAS_pool_get_array(tracers, "iceAge", iceAge, 1) - call MPAS_pool_get_array(tracers, "firstYearIceArea", firstYearIceArea, 1) - call MPAS_pool_get_array(tracers, "snowScatteringAerosol", snowScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "snowBodyAerosol", snowBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "iceScatteringAerosol", iceScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "iceBodyAerosol", iceBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "snowIceMass", snowIceMass, 1) - call MPAS_pool_get_array(tracers, "snowLiquidMass", snowLiquidMass, 1) - call MPAS_pool_get_array(tracers, "snowGrainRadius", snowGrainRadius, 1) - - call MPAS_pool_get_array(velocity_solver, "uVelocity", uVelocity) - call MPAS_pool_get_array(velocity_solver, "vVelocity", vVelocity) - call MPAS_pool_get_array(velocity_solver, "uVelocityCell", uVelocityCell) - call MPAS_pool_get_array(velocity_solver, "vVelocityCell", vVelocityCell) - call MPAS_pool_get_array(velocity_solver, "airStressCellU", airStressCellU) - call MPAS_pool_get_array(velocity_solver, "airStressCellV", airStressCellV) - call MPAS_pool_get_array(velocity_solver, "oceanStressCellU", oceanStressCellU) - call MPAS_pool_get_array(velocity_solver, "oceanStressCellV", oceanStressCellV) - - call MPAS_pool_get_array(atmos_coupling, "uAirVelocity", uAirVelocity) - call MPAS_pool_get_array(atmos_coupling, "vAirVelocity", vAirVelocity) - call MPAS_pool_get_array(atmos_coupling, "airLevelHeight", airLevelHeight) - call MPAS_pool_get_array(atmos_coupling, "airSpecificHumidity", airSpecificHumidity) - call MPAS_pool_get_array(atmos_coupling, "airDensity", airDensity) - call MPAS_pool_get_array(atmos_coupling, "airTemperature", airTemperature) - call MPAS_pool_get_array(atmos_coupling, "airPotentialTemperature", airPotentialTemperature) - call MPAS_pool_get_array(atmos_coupling, "snowfallRate", snowfallRate) - call MPAS_pool_get_array(atmos_coupling, "rainfallRate", rainfallRate) - call MPAS_pool_get_array(atmos_coupling, "longwaveDown", longwaveDown) - call MPAS_pool_get_array(atmos_coupling, "atmosReferenceTemperature2m", atmosReferenceTemperature2m) - call MPAS_pool_get_array(atmos_coupling, "atmosReferenceHumidity2m", atmosReferenceHumidity2m) - call MPAS_pool_get_array(atmos_coupling, "atmosReferenceSpeed10m", atmosReferenceSpeed10m) - - call MPAS_pool_get_array(atmos_forcing, "windSpeed", windSpeed) - - call MPAS_pool_get_array(alternative_atmos_forcing, "latentHeatFluxCouple", latentHeatFluxCouple) - call MPAS_pool_get_array(alternative_atmos_forcing, "sensibleHeatFluxCouple", sensibleHeatFluxCouple) - call MPAS_pool_get_array(alternative_atmos_forcing, "surfaceHeatFluxCouple", surfaceHeatFluxCouple) - call MPAS_pool_get_array(alternative_atmos_forcing, "surfaceConductiveFluxCouple", surfaceConductiveFluxCouple) - call MPAS_pool_get_array(alternative_atmos_forcing, "airStressForcingU", airStressForcingU) - call MPAS_pool_get_array(alternative_atmos_forcing, "airStressForcingV", airStressForcingV) - - call MPAS_pool_get_array(ocean_coupling, "seaSurfaceTemperature", seaSurfaceTemperature) - call MPAS_pool_get_array(ocean_coupling, "seaSurfaceSalinity", seaSurfaceSalinity) - call MPAS_pool_get_array(ocean_coupling, "freezingMeltingPotential", freezingMeltingPotential) - call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - - call MPAS_pool_get_array(drag, "airOceanDragCoefficientRatio", airOceanDragCoefficientRatio) - call MPAS_pool_get_array(drag, "oceanDragCoefficient", oceanDragCoefficient) - call MPAS_pool_get_array(drag, "oceanDragCoefficientSkin", oceanDragCoefficientSkin) - call MPAS_pool_get_array(drag, "oceanDragCoefficientFloe", oceanDragCoefficientFloe) - call MPAS_pool_get_array(drag, "oceanDragCoefficientKeel", oceanDragCoefficientKeel) - call MPAS_pool_get_array(drag, "airDragCoefficient", airDragCoefficient) - call MPAS_pool_get_array(drag, "airDragCoefficientSkin", airDragCoefficientSkin) - call MPAS_pool_get_array(drag, "airDragCoefficientFloe", airDragCoefficientFloe) - call MPAS_pool_get_array(drag, "airDragCoefficientPond", airDragCoefficientPond) - call MPAS_pool_get_array(drag, "airDragCoefficientRidge", airDragCoefficientRidge) - call MPAS_pool_get_array(drag, "dragFreeboard", dragFreeboard) - call MPAS_pool_get_array(drag, "dragIceSnowDraft", dragIceSnowDraft) - call MPAS_pool_get_array(drag, "dragRidgeHeight", dragRidgeHeight) - call MPAS_pool_get_array(drag, "dragRidgeSeparation", dragRidgeSeparation) - call MPAS_pool_get_array(drag, "dragKeelDepth", dragKeelDepth) - call MPAS_pool_get_array(drag, "dragKeelSeparation", dragKeelSeparation) - call MPAS_pool_get_array(drag, "dragFloeLength", dragFloeLength) - call MPAS_pool_get_array(drag, "dragFloeSeparation", dragFloeSeparation) - - call MPAS_pool_get_array(melt_growth_rates, "lateralIceMeltFraction", lateralIceMeltFraction) - call MPAS_pool_get_array(melt_growth_rates, "surfaceIceMelt", surfaceIceMelt) - call MPAS_pool_get_array(melt_growth_rates, "surfaceIceMeltCategory", surfaceIceMeltCategory) - call MPAS_pool_get_array(melt_growth_rates, "basalIceMelt", basalIceMelt ) - call MPAS_pool_get_array(melt_growth_rates, "basalIceMeltCategory", basalIceMeltCategory) - call MPAS_pool_get_array(melt_growth_rates, "lateralIceMelt", lateralIceMelt) - call MPAS_pool_get_array(melt_growth_rates, "snowMelt", snowMelt) - call MPAS_pool_get_array(melt_growth_rates, "snowMeltCategory", snowMeltCategory) - call MPAS_pool_get_array(melt_growth_rates, "congelation", congelation) - call MPAS_pool_get_array(melt_growth_rates, "congelationCategory", congelationCategory) - call MPAS_pool_get_array(melt_growth_rates, "snowiceFormation", snowiceFormation) - call MPAS_pool_get_array(melt_growth_rates, "snowiceFormationCategory", snowiceFormationCategory) - call MPAS_pool_get_array(melt_growth_rates, "snowThicknessChangeCategory", snowThicknessChangeCategory) - call MPAS_pool_get_array(melt_growth_rates, "frazilFormation", frazilFormation) - - call MPAS_pool_get_array(atmos_fluxes, "surfaceHeatFlux", surfaceHeatFlux) - call MPAS_pool_get_array(atmos_fluxes, "surfaceHeatFluxCategory", surfaceHeatFluxCategory) - call MPAS_pool_get_array(atmos_fluxes, "surfaceConductiveFlux", surfaceConductiveFlux) - call MPAS_pool_get_array(atmos_fluxes, "surfaceConductiveFluxCategory", surfaceConductiveFluxCategory) - call MPAS_pool_get_array(atmos_fluxes, "longwaveUp", longwaveUp) - call MPAS_pool_get_array(atmos_fluxes, "sensibleHeatFlux", sensibleHeatFlux) - call MPAS_pool_get_array(atmos_fluxes, "sensibleHeatFluxCategory", sensibleHeatFluxCategory) - call MPAS_pool_get_array(atmos_fluxes, "latentHeatFlux", latentHeatFlux) - call MPAS_pool_get_array(atmos_fluxes, "latentHeatFluxCategory", latentHeatFluxCategory) - call MPAS_pool_get_array(atmos_fluxes, "evaporativeWaterFlux", evaporativeWaterFlux) - - call MPAS_pool_get_array(ocean_fluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanSaltFlux", oceanSaltFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanHeatFlux", oceanHeatFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanShortwaveFlux", oceanShortwaveFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanHeatFluxIceBottom", oceanHeatFluxIceBottom) - - call MPAS_pool_get_array(shortwave, "surfaceShortwaveFlux", surfaceShortwaveFlux) - call MPAS_pool_get_array(shortwave, "interiorShortwaveFlux", interiorShortwaveFlux) - call MPAS_pool_get_array(shortwave, "penetratingShortwaveFlux", penetratingShortwaveFlux) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveFlux", absorbedShortwaveFlux) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveIceLayer", absorbedShortwaveIceLayer) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveSnowLayer", absorbedShortwaveSnowLayer) - call MPAS_pool_get_array(shortwave, "solarZenithAngleCosine", solarZenithAngleCosine) - - call MPAS_pool_get_array(aerosols, "atmosAerosolFlux", atmosAerosolFlux) - call MPAS_pool_get_array(aerosols, "oceanAerosolFlux", oceanAerosolFlux) - - call MPAS_pool_get_array(ponds, "pondFreshWaterFlux", pondFreshWaterFlux) - call MPAS_pool_get_array(ponds, "pondSnowDepthDifference", pondSnowDepthDifference) - call MPAS_pool_get_array(ponds, "pondLidMeltFluxFraction", pondLidMeltFluxFraction) - - call MPAS_pool_get_array(diagnostics, "meltOnset", meltOnset) - call MPAS_pool_get_array(diagnostics, "freezeOnset", freezeOnset) - - call MPAS_pool_get_array(snow, "snowLossToLeads", snowLossToLeads) - call MPAS_pool_get_array(snow, "snowMeltMassCell", snowMeltMassCell) - call MPAS_pool_get_array(snow, "snowMeltMassCategory", snowMeltMassCategory) - - ! high frequency coupling needs to cell center velocity - if (config_use_high_frequency_coupling) then - call seaice_interpolate_vertex_to_cell(mesh, boundary, uVelocityCell, uVelocity) - call seaice_interpolate_vertex_to_cell(mesh, boundary, vVelocityCell, vVelocity) - endif - - ! aerosols - if (config_use_aerosols) then - - allocate(specificSnowAerosol(nAerosols, 2, nCategories)) - allocate(specificIceAerosol(nAerosols, 2, nCategories)) - - else - - allocate(specificSnowAerosol(1, 1, 1)) - allocate(specificIceAerosol(1, 1, 1)) - specificSnowAerosol = 0.0_RKIND - specificIceAerosol = 0.0_RKIND - - endif - - ! code abort - abortFlag = .false. - abortMessage = "" - anyAbort = .false. - - !$omp parallel do default(shared) private(iCategory,iAerosol,northernHemisphereMask,& - !$omp& abortMessage) firstprivate(specificSnowAerosol,specificIceAerosol) & - !$omp& reduction(.or.:abortFlag) - do iCell = 1, nCellsSolve - - ! initial state values - iceAreaCellInitial(iCell) = iceAreaCell(iCell) - - do iCategory = 1, nCategories - - iceAreaCategoryInitial(iCategory,iCell) = iceAreaCategory(1,iCategory,iCell) - iceVolumeCategoryInitial(iCategory,iCell) = iceVolumeCategory(1,iCategory,iCell) - snowVolumeCategoryInitial(iCategory,iCell) = snowVolumeCategory(1,iCategory,iCell) - - enddo ! iCategory - - ! aerosol - if (config_use_aerosols) then - - do iCategory = 1, nCategories - do iAerosol = 1, nAerosols - - specificSnowAerosol(iAerosol, 1, iCategory) = & - snowScatteringAerosol(iAerosol,iCategory,iCell) * snowVolumeCategoryInitial(iCategory,iCell) - specificSnowAerosol(iAerosol, 2, iCategory) = & - snowBodyAerosol(iAerosol,iCategory,iCell) * snowVolumeCategoryInitial(iCategory,iCell) - - specificIceAerosol(iAerosol, 1, iCategory) = & - iceScatteringAerosol(iAerosol,iCategory,iCell) * iceVolumeCategoryInitial(iCategory,iCell) - specificIceAerosol(iAerosol, 2, iCategory) = & - iceBodyAerosol(iAerosol,iCategory,iCell) * iceVolumeCategoryInitial(iCategory,iCell) - - enddo ! iAerosol - enddo ! iCategory - - end if - - ! hemisphere mask - if (latCell(iCell) > 0.0_RKIND) then - northernHemisphereMask = .true. - else - northernHemisphereMask = .false. - endif - - call colpkg_clear_warnings() - call colpkg_step_therm1(& - config_dt, & - nCategories, & - nIceLayers, & - nSnowLayers, & - nAerosols, & - openWaterArea(iCell), & - iceAreaCategoryInitial(:,iCell), & - iceVolumeCategoryInitial(:,iCell), & - snowVolumeCategoryInitial(:,iCell), & - iceAreaCell(iCell), & - iceAreaCategory(1,:,iCell), & - iceVolumeCell(iCell), & - iceVolumeCategory(1,:,iCell), & - snowVolumeCell(iCell), & - snowVolumeCategory(1,:,iCell), & - uVelocityCell(iCell), & - vVelocityCell(iCell), & - surfaceTemperature(1,:,iCell), & - snowEnthalpy(:,:,iCell), & - iceEnthalpy(:,:,iCell), & - iceSalinity(:,:,iCell), & - snowIceMass(:,:,iCell), & - snowLiquidMass(:,:,iCell), & - levelIceArea(1,:,iCell), & - levelIceVolume(1,:,iCell), & - pondArea(1,:,iCell), & - pondDepth(1,:,iCell), & - pondLidThickness(1,:,iCell), & - iceAge(1,:,iCell), & - firstYearIceArea(1,:,iCell), & - snowGrainRadius(:,:,iCell), & - config_use_snow_liquid_ponds, & - specificSnowAerosol(:,:,:), & - specificIceAerosol(:,:,:), & - uAirVelocity(iCell), & - vAirVelocity(iCell), & - windSpeed(iCell), & - airLevelHeight(iCell), & - airSpecificHumidity(iCell), & - airDensity(iCell), & - airTemperature(iCell), & - atmosReferenceTemperature2m(iCell), & - atmosReferenceHumidity2m(iCell), & - atmosReferenceSpeed10m(iCell), & - airOceanDragCoefficientRatio(iCell), & - oceanDragCoefficient(iCell), & - oceanDragCoefficientSkin(iCell), & - oceanDragCoefficientFloe(iCell), & - oceanDragCoefficientKeel(iCell), & - airDragCoefficient(iCell), & - airDragCoefficientSkin(iCell), & - airDragCoefficientFloe(iCell), & - airDragCoefficientPond(iCell), & - airDragCoefficientRidge(iCell), & - dragFreeboard(iCell), & - dragIceSnowDraft(iCell), & - dragRidgeHeight(iCell), & - dragRidgeSeparation(iCell), & - dragKeelDepth(iCell), & - dragKeelSeparation(iCell), & - dragFloeLength(iCell), & - dragFloeSeparation(iCell), & - airStressForcingU(iCell), & - airStressForcingV(iCell), & - airStressCellU(iCell), & - airStressCellV(iCell), & - airPotentialTemperature(iCell), & - seaSurfaceTemperature(iCell), & - seaSurfaceSalinity(iCell), & - seaFreezingTemperature(iCell), & - oceanStressCellU(iCell), & - oceanStressCellV(iCell), & - oceanHeatFluxIceBottom(iCell), & - freezingMeltingPotential(iCell), & - lateralIceMeltFraction(iCell), & - snowfallRate(iCell), & - rainfallRate(iCell), & - pondFreshWaterFlux(iCell), & - snowLossToLeads(iCell), & - surfaceHeatFlux(iCell), & - surfaceHeatFluxCategory(:,iCell), & - surfaceConductiveFlux(iCell), & - surfaceConductiveFluxCategory(:,iCell), & - surfaceShortwaveFlux(:,iCell), & - interiorShortwaveFlux(:,iCell), & - penetratingShortwaveFlux(:,iCell), & - absorbedShortwaveFlux(iCell), & - longwaveUp(iCell), & - absorbedShortwaveSnowLayer(:,:,iCell), & - absorbedShortwaveIceLayer(:,:,iCell), & - longwaveDown(iCell), & - solarZenithAngleCosine(iCell), & - sensibleHeatFlux(iCell), & - sensibleHeatFluxCategory(:,iCell), & - latentHeatFlux(iCell), & - latentHeatFluxCategory(:,iCell), & - evaporativeWaterFlux(iCell), & - oceanFreshWaterFlux(iCell), & - oceanSaltFlux(iCell), & - oceanHeatFlux(iCell), & - oceanShortwaveFlux(iCell), & - latentHeatFluxCouple(:,iCell), & - sensibleHeatFluxCouple(:,iCell), & - surfaceHeatFluxCouple(:,iCell), & - surfaceConductiveFluxCouple(:,iCell), & - atmosAerosolFlux(:,iCell), & - oceanAerosolFlux(:,iCell), & - pondSnowDepthDifference(:,iCell), & - pondLidMeltFluxFraction(:,iCell), & - surfaceIceMelt(iCell), & - surfaceIceMeltCategory(:,iCell), & - basalIceMelt(iCell), & - basalIceMeltCategory(:,iCell), & - lateralIceMelt(iCell), & - snowMelt(iCell), & - snowMeltCategory(:,iCell), & - snowMeltMassCell(iCell), & - snowMeltMassCategory(:,iCell), & - congelation(iCell), & - congelationCategory(:,iCell), & - snowiceFormation(iCell), & - snowiceFormationCategory(:,iCell), & - snowThicknessChangeCategory(:,iCell), & - frazilFormation(iCell), & - northernHemisphereMask, & - .not. northernHemisphereMask, & - meltOnset(iCell), & - freezeOnset(iCell), & - dayOfYear, & - abortFlag, & - abortMessage, & - config_use_prescribed_ice) - call column_write_warnings(abortFlag) - - ! code abort - if (abortFlag .and. .not. anyAbort) then - call mpas_log_write("column_vertical_thermodynamics: "//trim(abortMessage) , messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - - call mpas_log_write("config_dt: $r", messageType=MPAS_LOG_ERR, realArgs=(/config_dt/)) - call mpas_log_write("nCategories: $i", messageType=MPAS_LOG_ERR, intArgs=(/nCategories/)) - call mpas_log_write("nIceLayers: $i", messageType=MPAS_LOG_ERR, intArgs=(/nIceLayers/)) - call mpas_log_write("nSnowLayers: $i", messageType=MPAS_LOG_ERR, intArgs=(/nSnowLayers/)) - call mpas_log_write("nAerosols: $i", messageType=MPAS_LOG_ERR, intArgs=(/nAerosols/)) - call mpas_log_write("openWaterArea: $r", messageType=MPAS_LOG_ERR, realArgs=(/openWaterArea(iCell)/)) - call mpas_log_write("iceAreaCategoryInitial: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCategoryInitial(:,iCell)/)) - call mpas_log_write("iceVolumeCategoryInitial: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/iceVolumeCategoryInitial(:,iCell)/)) - call mpas_log_write("snowVolumeCategoryInitial: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/snowVolumeCategoryInitial(:,iCell)/)) - call mpas_log_write("iceAreaCell: $r", messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCell(iCell)/)) - call mpas_log_write("iceAreaCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCategory(1,:,iCell)/)) - call mpas_log_write("iceVolumeCell: $r", messageType=MPAS_LOG_ERR, realArgs=(/iceVolumeCell(iCell)/)) - call mpas_log_write("iceVolumeCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/iceVolumeCategory(1,:,iCell)/)) - call mpas_log_write("snowVolumeCell: $r", messageType=MPAS_LOG_ERR, realArgs=(/snowVolumeCell(iCell)/)) - call mpas_log_write("snowVolumeCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/snowVolumeCategory(1,:,iCell)/)) - call mpas_log_write("uVelocityCell: $r", messageType=MPAS_LOG_ERR, realArgs=(/uVelocityCell(iCell)/)) - call mpas_log_write("vVelocityCell: $r", messageType=MPAS_LOG_ERR, realArgs=(/vVelocityCell(iCell)/)) - call mpas_log_write("surfaceTemperature: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceTemperature(1,:,iCell)/)) - do iCategory = 1, nCategories - call mpas_log_write("snowEnthalpy: $i "//repeat("$r ", nSnowLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/snowEnthalpy(:,iCategory,iCell)/)) - enddo ! iCategory - do iCategory = 1, nCategories - call mpas_log_write("iceEnthalpy: $i "//repeat("$r ", nIceLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/iceEnthalpy(:,iCategory,iCell)/)) - enddo ! iCategory - do iCategory = 1, nCategories - call mpas_log_write("iceSalinity: $i "//repeat("$r ", nIceLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/iceSalinity(:,iCategory,iCell)/)) - enddo ! iCategory - do iCategory = 1, nCategories - call mpas_log_write("snowIceMass: $i "//repeat("$r ", nSnowLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/snowIceMass(:,iCategory,iCell)/)) - enddo ! iCategory - do iCategory = 1, nCategories - call mpas_log_write("snowLiquidMass: $i "//repeat("$r ", nSnowLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/snowLiquidMass(:,iCategory,iCell)/)) - enddo ! iCategory - call mpas_log_write("levelIceArea: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/levelIceArea(1,:,iCell)/)) - call mpas_log_write("levelIceVolume: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/levelIceVolume(1,:,iCell)/)) - call mpas_log_write("pondArea: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/pondArea(1,:,iCell)/)) - call mpas_log_write("pondDepth: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/pondDepth(1,:,iCell)/)) - call mpas_log_write("pondLidThickness: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/pondLidThickness(1,:,iCell)/)) - call mpas_log_write("iceAge: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/iceAge(1,:,iCell)/)) - call mpas_log_write("firstYearIceArea: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/firstYearIceArea(1,:,iCell)/)) - do iCategory = 1, nCategories - call mpas_log_write("snowGrainRadius: $i "//repeat("$r ", nSnowLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/snowGrainRadius(:,iCategory,iCell)/)) - enddo ! iCategory - call mpas_log_write("config_use_snow_liquid_ponds: $l", messageType=MPAS_LOG_ERR, logicArgs=(/config_use_snow_liquid_ponds/)) - if (config_use_aerosols) then - do iCategory = 1, nCategories - call mpas_log_write("specificSnowAerosol $i 1: "//repeat("$r ", nAerosols), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/specificSnowAerosol(:,1,iCategory)/)) - call mpas_log_write("specificSnowAerosol $i 2: "//repeat("$r ", nAerosols), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/specificSnowAerosol(:,2,iCategory)/)) - enddo ! iCategory - do iCategory = 1, nCategories - call mpas_log_write("specificIceAerosol $i 1: "//repeat("$r ", nAerosols), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/specificIceAerosol(:,1,iCategory)/)) - call mpas_log_write("specificIceAerosol $i 2: "//repeat("$r ", nAerosols), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/specificIceAerosol(:,2,iCategory)/)) - enddo ! iCategory - endif - call mpas_log_write("uAirVelocity: $r", messageType=MPAS_LOG_ERR, realArgs=(/uAirVelocity(iCell)/)) - call mpas_log_write("vAirVelocity: $r", messageType=MPAS_LOG_ERR, realArgs=(/vAirVelocity(iCell)/)) - call mpas_log_write("windSpeed: $r", messageType=MPAS_LOG_ERR, realArgs=(/windSpeed(iCell)/)) - call mpas_log_write("airLevelHeight: $r", messageType=MPAS_LOG_ERR, realArgs=(/airLevelHeight(iCell)/)) - call mpas_log_write("airSpecificHumidity: $r", messageType=MPAS_LOG_ERR, realArgs=(/airSpecificHumidity(iCell)/)) - call mpas_log_write("airDensity: $r", messageType=MPAS_LOG_ERR, realArgs=(/airDensity(iCell)/)) - call mpas_log_write("airTemperature: $r", messageType=MPAS_LOG_ERR, realArgs=(/airTemperature(iCell)/)) - call mpas_log_write("atmosReferenceTemperature2m: $r", messageType=MPAS_LOG_ERR, realArgs=(/atmosReferenceTemperature2m(iCell)/)) - call mpas_log_write("atmosReferenceHumidity2m: $r", messageType=MPAS_LOG_ERR, realArgs=(/atmosReferenceHumidity2m(iCell)/)) - call mpas_log_write("atmosReferenceSpeed10m: $r", messageType=MPAS_LOG_ERR, realArgs=(/atmosReferenceSpeed10m(iCell)/)) - call mpas_log_write("airOceanDragCoefficientRatio: $r", messageType=MPAS_LOG_ERR, realArgs=(/airOceanDragCoefficientRatio(iCell)/)) - call mpas_log_write("oceanDragCoefficient: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanDragCoefficient(iCell)/)) - call mpas_log_write("oceanDragCoefficientSkin: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanDragCoefficientSkin(iCell)/)) - call mpas_log_write("oceanDragCoefficientFloe: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanDragCoefficientFloe(iCell)/)) - call mpas_log_write("oceanDragCoefficientKeel: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanDragCoefficientKeel(iCell)/)) - call mpas_log_write("airDragCoefficient: $r", messageType=MPAS_LOG_ERR, realArgs=(/airDragCoefficient(iCell)/)) - call mpas_log_write("airDragCoefficientSkin: $r", messageType=MPAS_LOG_ERR, realArgs=(/airDragCoefficientSkin(iCell)/)) - call mpas_log_write("airDragCoefficientFloe: $r", messageType=MPAS_LOG_ERR, realArgs=(/airDragCoefficientFloe(iCell)/)) - call mpas_log_write("airDragCoefficientPond: $r", messageType=MPAS_LOG_ERR, realArgs=(/airDragCoefficientPond(iCell)/)) - call mpas_log_write("airDragCoefficientRidge: $r", messageType=MPAS_LOG_ERR, realArgs=(/airDragCoefficientRidge(iCell)/)) - call mpas_log_write("dragFreeboard: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragFreeboard(iCell)/)) - call mpas_log_write("dragIceSnowDraft: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragIceSnowDraft(iCell)/)) - call mpas_log_write("dragRidgeHeight: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragRidgeHeight(iCell)/)) - call mpas_log_write("dragRidgeSeparation: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragRidgeSeparation(iCell)/)) - call mpas_log_write("dragKeelDepth: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragKeelDepth(iCell)/)) - call mpas_log_write("dragKeelSeparation: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragKeelSeparation(iCell)/)) - call mpas_log_write("dragFloeLength: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragFloeLength(iCell)/)) - call mpas_log_write("dragFloeSeparation: $r", messageType=MPAS_LOG_ERR, realArgs=(/dragFloeSeparation(iCell)/)) - call mpas_log_write("airStressForcingU: $r", messageType=MPAS_LOG_ERR, realArgs=(/airStressForcingU(iCell)/)) - call mpas_log_write("airStressForcingV: $r", messageType=MPAS_LOG_ERR, realArgs=(/airStressForcingV(iCell)/)) - call mpas_log_write("airStressCellU: $r", messageType=MPAS_LOG_ERR, realArgs=(/airStressCellU(iCell)/)) - call mpas_log_write("airStressCellV: $r", messageType=MPAS_LOG_ERR, realArgs=(/airStressCellV(iCell)/)) - call mpas_log_write("airPotentialTemperature: $r", messageType=MPAS_LOG_ERR, realArgs=(/airPotentialTemperature(iCell)/)) - call mpas_log_write("seaSurfaceTemperature: $r", messageType=MPAS_LOG_ERR, realArgs=(/seaSurfaceTemperature(iCell)/)) - call mpas_log_write("seaSurfaceSalinity: $r", messageType=MPAS_LOG_ERR, realArgs=(/seaSurfaceSalinity(iCell)/)) - call mpas_log_write("seaFreezingTemperature: $r", messageType=MPAS_LOG_ERR, realArgs=(/seaFreezingTemperature(iCell)/)) - call mpas_log_write("oceanStressCellU: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanStressCellU(iCell)/)) - call mpas_log_write("oceanStressCellV: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanStressCellV(iCell)/)) - call mpas_log_write("oceanHeatFluxIceBottom: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanHeatFluxIceBottom(iCell)/)) - call mpas_log_write("freezingMeltingPotential: $r", messageType=MPAS_LOG_ERR, realArgs=(/freezingMeltingPotential(iCell)/)) - call mpas_log_write("lateralIceMeltFraction: $r", messageType=MPAS_LOG_ERR, realArgs=(/lateralIceMeltFraction(iCell)/)) - call mpas_log_write("snowfallRate: $r", messageType=MPAS_LOG_ERR, realArgs=(/snowfallRate(iCell)/)) - call mpas_log_write("rainfallRate: $r", messageType=MPAS_LOG_ERR, realArgs=(/rainfallRate(iCell)/)) - call mpas_log_write("pondFreshWaterFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/pondFreshWaterFlux(iCell)/)) - call mpas_log_write("snowLossToLeads: $r", messageType=MPAS_LOG_ERR, realArgs=(/snowLossToLeads(iCell)/)) - call mpas_log_write("surfaceHeatFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/surfaceHeatFlux(iCell)/)) - call mpas_log_write("surfaceHeatFluxCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceHeatFluxCategory(:,iCell)/)) - call mpas_log_write("surfaceConductiveFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/surfaceConductiveFlux(iCell)/)) - call mpas_log_write("surfaceConductiveFluxCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceConductiveFluxCategory(:,iCell)/)) - call mpas_log_write("surfaceShortwaveFlux: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceShortwaveFlux(:,iCell)/)) - call mpas_log_write("interiorShortwaveFlux: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/interiorShortwaveFlux(:,iCell)/)) - call mpas_log_write("penetratingShortwaveFlux: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/penetratingShortwaveFlux(:,iCell)/)) - call mpas_log_write("absorbedShortwaveFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/absorbedShortwaveFlux(iCell)/)) - call mpas_log_write("longwaveUp: $r", messageType=MPAS_LOG_ERR, realArgs=(/longwaveUp(iCell)/)) - do iCategory = 1, nCategories - call mpas_log_write("absorbedShortwaveSnowLayer: $i "//repeat("$r ", nSnowLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/absorbedShortwaveSnowLayer(:,iCategory,iCell)/)) - enddo ! iCategory - do iCategory = 1, nCategories - call mpas_log_write("absorbedShortwaveIceLayer: $i "//repeat("$r ", nIceLayers), messageType=MPAS_LOG_ERR, intArgs=(/iCategory/), realArgs=(/absorbedShortwaveIceLayer(:,iCategory,iCell)/)) - enddo ! iCategory - call mpas_log_write("longwaveDown: $r", messageType=MPAS_LOG_ERR, realArgs=(/longwaveDown(iCell)/)) - call mpas_log_write("solarZenithAngleCosine: $r", messageType=MPAS_LOG_ERR, realArgs=(/solarZenithAngleCosine(iCell)/)) - call mpas_log_write("sensibleHeatFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/sensibleHeatFlux(iCell)/)) - call mpas_log_write("sensibleHeatFluxCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/sensibleHeatFluxCategory(:,iCell)/)) - call mpas_log_write("latentHeatFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/latentHeatFlux(iCell)/)) - call mpas_log_write("latentHeatFluxCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/latentHeatFluxCategory(:,iCell)/)) - call mpas_log_write("evaporativeWaterFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/evaporativeWaterFlux(iCell)/)) - call mpas_log_write("oceanFreshWaterFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanFreshWaterFlux(iCell)/)) - call mpas_log_write("oceanSaltFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanSaltFlux(iCell)/)) - call mpas_log_write("oceanHeatFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanHeatFlux(iCell)/)) - call mpas_log_write("oceanShortwaveFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanShortwaveFlux(iCell)/)) - call mpas_log_write("latentHeatFluxCouple: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/latentHeatFluxCouple(:,iCell)/)) - call mpas_log_write("sensibleHeatFluxCouple: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/sensibleHeatFluxCouple(:,iCell)/)) - call mpas_log_write("surfaceHeatFluxCouple: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceHeatFluxCouple(:,iCell)/)) - call mpas_log_write("surfaceConductiveFluxCouple: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceConductiveFluxCouple(:,iCell)/)) - call mpas_log_write("atmosAerosolFlux: "//repeat("$r ", nAerosols), messageType=MPAS_LOG_ERR, realArgs=(/atmosAerosolFlux(:,iCell)/)) - call mpas_log_write("oceanAerosolFlux: "//repeat("$r ", nAerosols), messageType=MPAS_LOG_ERR, realArgs=(/oceanAerosolFlux(:,iCell)/)) - call mpas_log_write("pondSnowDepthDifference: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/pondSnowDepthDifference(:,iCell)/)) - call mpas_log_write("pondLidMeltFluxFraction: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/pondLidMeltFluxFraction(:,iCell)/)) - call mpas_log_write("surfaceIceMelt: $r", messageType=MPAS_LOG_ERR, realArgs=(/surfaceIceMelt(iCell)/)) - call mpas_log_write("surfaceIceMeltCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/surfaceIceMeltCategory(:,iCell)/)) - call mpas_log_write("basalIceMelt: $r", messageType=MPAS_LOG_ERR, realArgs=(/basalIceMelt(iCell)/)) - call mpas_log_write("basalIceMeltCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/basalIceMeltCategory(:,iCell)/)) - call mpas_log_write("lateralIceMelt: $r", messageType=MPAS_LOG_ERR, realArgs=(/lateralIceMelt(iCell)/)) - call mpas_log_write("snowMelt: $r", messageType=MPAS_LOG_ERR, realArgs=(/snowMelt(iCell)/)) - call mpas_log_write("snowMeltCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/snowMeltCategory(:,iCell)/)) - call mpas_log_write("snowMeltMassCell: $r", messageType=MPAS_LOG_ERR, realArgs=(/snowMeltMassCell(iCell)/)) - call mpas_log_write("snowMeltMassCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/snowMeltMassCategory(:,iCell)/)) - call mpas_log_write("congelation: $r", messageType=MPAS_LOG_ERR, realArgs=(/congelation(iCell)/)) - call mpas_log_write("congelationCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/congelationCategory(:,iCell)/)) - call mpas_log_write("snowiceFormation: $r", messageType=MPAS_LOG_ERR, realArgs=(/snowiceFormation(iCell)/)) - call mpas_log_write("snowiceFormationCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/snowiceFormationCategory(:,iCell)/)) - call mpas_log_write("snowThicknessChangeCategory: "//repeat("$r ", nCategories), messageType=MPAS_LOG_ERR, realArgs=(/snowThicknessChangeCategory(:,iCell)/)) - call mpas_log_write("frazilFormation: $r", messageType=MPAS_LOG_ERR, realArgs=(/frazilFormation(iCell)/)) - call mpas_log_write("northernHemisphereMask: $l", messageType=MPAS_LOG_ERR, logicArgs=(/northernHemisphereMask/)) - call mpas_log_write("meltOnset: $r", messageType=MPAS_LOG_ERR, realArgs=(/meltOnset(iCell)/)) - call mpas_log_write("freezeOnset: $r", messageType=MPAS_LOG_ERR, realArgs=(/freezeOnset(iCell)/)) - call mpas_log_write("dayOfYear: $r", messageType=MPAS_LOG_ERR, realArgs=(/dayOfYear/)) - call mpas_log_write("config_use_prescribed_ice: $l", messageType=MPAS_LOG_ERR, logicArgs=(/config_use_prescribed_ice/)) - anyAbort = .true. - abortFlag = .false. - abortMessage = "" - endif - - ! aerosol - if (config_use_aerosols) then - - do iCategory = 1, nCategories - do iAerosol = 1, nAerosols - - if (snowVolumeCategory(1,iCategory,iCell) > seaicePuny) & - specificSnowAerosol(iAerosol, :, iCategory) = & - specificSnowAerosol(iAerosol, :, iCategory) / snowVolumeCategory(1,iCategory,iCell) - - if (iceVolumeCategory(1,iCategory,iCell) > seaicePuny) & - specificIceAerosol(iAerosol, :, iCategory) = & - specificIceAerosol(iAerosol, :, iCategory) / iceVolumeCategory(1,iCategory,iCell) - - snowScatteringAerosol(iAerosol,iCategory,iCell) = specificSnowAerosol(iAerosol, 1, iCategory) - snowBodyAerosol(iAerosol,iCategory,iCell) = specificSnowAerosol(iAerosol, 2, iCategory) - - iceScatteringAerosol(iAerosol,iCategory,iCell) = specificIceAerosol(iAerosol, 1, iCategory) - iceBodyAerosol(iAerosol,iCategory,iCell) = specificIceAerosol(iAerosol, 2, iCategory) - - enddo ! iAerosol - enddo ! iCategory - - endif - - enddo ! iCell - - ! code abort - call seaice_critical_error_write_block(domain, block, anyAbort) - call seaice_check_critical_error(domain, anyAbort) - - ! aerosols - deallocate(specificSnowAerosol) - deallocate(specificIceAerosol) - - block => block % next - end do - - end subroutine column_vertical_thermodynamics - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_itd_thermodynamics -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 21th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_itd_thermodynamics(domain, clock) - - use ice_colpkg, only: & - colpkg_step_therm2, & - colpkg_clear_warnings - - use seaice_constants, only: & - seaicePuny - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - icestate, & - tracers, & - tracers_aggregate, & - atmos_coupling, & - ocean_coupling, & - ocean_fluxes, & - melt_growth_rates, & - ponds, & - biogeochemistry, & - initial, & - diagnostics, & - aerosols - - ! configs - real(kind=RKIND), pointer :: & - config_dt - - logical, pointer :: & - config_update_ocean_fluxes, & - config_use_column_biogeochemistry, & - config_use_zaerosols - - ! dimensions - integer, pointer :: & - nCellsSolve, & - nCategories, & - nIceLayers, & - nSnowLayers, & - nAerosols, & - nBioLayers, & - nBioLayersP1 - - ! variables - real(kind=RKIND), dimension(:), pointer :: & - openWaterArea, & - iceAreaCell, & - seaFreezingTemperature, & - seaSurfaceSalinity, & - lateralIceMeltFraction, & - lateralIceMelt, & - freezingMeltingPotential, & - frazilFormation, & - rainfallRate, & - pondFreshWaterFlux, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFlux, & - freezeOnset, & - categoryThicknessLimits, & - biologyGrid, & - verticalGrid, & - interfaceBiologyGrid, & - zSalinityFlux, & - frazilGrowthDiagnostic - - real(kind=RKIND), dimension(:,:), pointer :: & - iceAreaCategoryInitial, & - iceVolumeCategoryInitial, & - oceanAerosolFlux, & - oceanBioFluxes, & - oceanBioConcentrations, & - initialSalinityProfile - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - iceVolumeCategory, & - snowVolumeCategory, & - brineFraction - - integer, dimension(:,:), pointer :: & - newlyFormedIce - - integer, dimension(:), pointer :: & - indexToCellID - - ! local - integer :: & - iCell, & - iCategory, & - iBioTracers, & - iBioData, & - iBioLayers - - ! test carbon conservation - real(kind=RKIND), dimension(:,:), allocatable :: & - totalCarbonCatFinal, & - totalCarbonCatInitial, & - oceanBioFluxesTemp - - real(kind=RKIND), dimension(:), allocatable :: & - verticalGridSpace, & - oceanCarbonFlux, & - totalCarbonFinal, & - totalCarbonInitial, & - carbonError - - real(kind=RKIND), dimension(:), allocatable :: & - oceanBioConcentrationsUsed - - logical, dimension(:), allocatable :: & - newlyFormedIceLogical - - logical :: & - abortFlag, & - anyAbort, & - setGetPhysicsTracers, & - setGetBGCTracers, & - checkCarbon - - character(len=strKIND) :: & - abortMessage, & - abortLocation - - real(kind=RKIND) :: & - dayOfYear - - ! day of year - call get_day_of_year(clock, dayOfYear) - - checkCarbon = .false. - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "icestate", icestate) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", ocean_fluxes) - call MPAS_pool_get_subpool(block % structs, "melt_growth_rates", melt_growth_rates) - call MPAS_pool_get_subpool(block % structs, "ponds", ponds) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "initial", initial) - call MPAS_pool_get_subpool(block % structs, "diagnostics", diagnostics) - call MPAS_pool_get_subpool(block % structs, "aerosols", aerosols) - - call MPAS_pool_get_config(block % configs, "config_dt", config_dt) - call MPAS_pool_get_config(block % configs, "config_update_ocean_fluxes", config_update_ocean_fluxes) - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols", config_use_zaerosols) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(mesh, "nAerosols", nAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_array(mesh, "indexToCellID", indexToCellID) - - call MPAS_pool_get_array(icestate, "iceAreaCategoryInitial", iceAreaCategoryInitial) - call MPAS_pool_get_array(icestate, "iceVolumeCategoryInitial", iceVolumeCategoryInitial) - call MPAS_pool_get_array(icestate, "openWaterArea", openWaterArea) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - - call MPAS_pool_get_array(atmos_coupling, "rainfallRate", rainfallRate) - - call MPAS_pool_get_array(ocean_coupling, "freezingMeltingPotential", freezingMeltingPotential) - call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - call MPAS_pool_get_array(ocean_coupling, "seaSurfaceSalinity", seaSurfaceSalinity) - - call MPAS_pool_get_array(ocean_fluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanSaltFlux", oceanSaltFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanHeatFlux", oceanHeatFlux) - - call MPAS_pool_get_array(melt_growth_rates, "lateralIceMeltFraction", lateralIceMeltFraction) - call MPAS_pool_get_array(melt_growth_rates, "lateralIceMelt", lateralIceMelt) - call MPAS_pool_get_array(melt_growth_rates, "frazilFormation", frazilFormation) - call MPAS_pool_get_array(melt_growth_rates, "frazilGrowthDiagnostic", frazilGrowthDiagnostic) - - call MPAS_pool_get_array(ponds, "pondFreshWaterFlux", pondFreshWaterFlux) - - call MPAS_pool_get_array(aerosols, "oceanAerosolFlux", oceanAerosolFlux) - - call MPAS_pool_get_array(biogeochemistry, "newlyFormedIce", newlyFormedIce) - call MPAS_pool_get_array(biogeochemistry, "oceanBioFluxes", oceanBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "oceanBioConcentrations", oceanBioConcentrations) - call MPAS_pool_get_array(biogeochemistry, "biologyGrid", biologyGrid) - call MPAS_pool_get_array(biogeochemistry, "verticalGrid", verticalGrid) - call MPAS_pool_get_array(biogeochemistry, "interfaceBiologyGrid", interfaceBiologyGrid) - call MPAS_pool_get_array(biogeochemistry, "zSalinityFlux", zSalinityFlux) - - call MPAS_pool_get_array(initial, "initialSalinityProfile", initialSalinityProfile) - call MPAS_pool_get_array(initial, "categoryThicknessLimits", categoryThicknessLimits) - - call MPAS_pool_get_array(diagnostics, "freezeOnset", freezeOnset) - - ! newly formed ice - allocate(newlyFormedIceLogical(nCategories)) - allocate(oceanBioConcentrationsUsed(ciceTracerObject % nBioTracers)) - allocate(oceanBioFluxesTemp(ciceTracerObject % nBioTracers,nCellsSolve)) - allocate(verticalGridSpace(nBioLayersP1)) - if (checkCarbon) then - allocate(totalCarbonCatFinal(nCategories,nCellsSolve)) - allocate(totalCarbonCatInitial(nCategories,nCellsSolve)) - allocate(totalCarbonInitial(nCellsSolve)) - allocate(totalCarbonFinal(nCellsSolve)) - allocate(oceanCarbonFlux(nCellsSolve)) - allocate(carbonError(nCellsSolve)) - else - allocate(totalCarbonCatFinal(1,1)) - allocate(totalCarbonCatInitial(1,1)) - allocate(totalCarbonInitial(1)) - allocate(totalCarbonFinal(1)) - allocate(oceanCarbonFlux(1)) - allocate(carbonError(1)) - endif - - verticalGridSpace(:) = 1.0_RKIND/real(nBioLayers,kind=RKIND) - verticalGridSpace(1) = verticalGridSpace(1)/2.0_RKIND - verticalGridSpace(nBioLayersP1) = verticalGridSpace(1) - - setGetPhysicsTracers = .true. - setGetBGCTracers = (config_use_column_biogeochemistry .or. config_use_zaerosols) - - ! code abort - abortFlag = .false. - abortMessage = "" - anyAbort = .false. - - !$omp parallel do default(shared) private(iCategory,iBioTracers,iBioData,& - !$omp& totalCarbonInitial,totalCarbonCatInitial,totalCarbonCatFinal,& - !$omp& abortMessage,oceanBioFluxesTemp,totalCarbonFinal,& - !$omp& oceanCarbonFlux, carbonError) & - !$omp& firstprivate(newlyFormedIceLogical,oceanBioConcentrationsUsed) & - !$omp& reduction(.or.:abortFlag) - do iCell = 1, nCellsSolve - - ! newly formed ice - do iCategory = 1, nCategories - newlyFormedIceLogical(iCategory) = (newlyFormedIce(iCategory,iCell) == 1) - enddo ! iCategory - - ! read the required ocean concentration fields into the allocated array - do iBioTracers = 1, ciceTracerObject % nBioTracers - iBioData = ciceTracerObject % index_LayerIndexToDataArray(iBioTracers) - oceanBioConcentrationsUsed(iBioTracers) = oceanBioConcentrations(iBioData, iCell) - enddo ! iBioTracers - - ! set the category tracer array - call set_cice_tracer_array_category(block, ciceTracerObject,& - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (checkCarbon) then - totalCarbonInitial(iCell) = 0.0_RKIND - call seaice_total_carbon_content_category(block,totalCarbonCatInitial(:,iCell),iceAreaCategory(1,:,:),iceVolumeCategory(1,:,:),iCell) - do iCategory = 1,nCategories - totalCarbonInitial(iCell) = totalCarbonInitial(iCell) + totalCarbonCatInitial(iCategory,iCell)*iceAreaCategory(1,iCategory,iCell) - enddo - endif - - oceanBioFluxesTemp(:,iCell) = 0.0_RKIND - - call colpkg_clear_warnings() - call colpkg_step_therm2(& - config_dt, & - nCategories, & - nAerosols, & - ciceTracerObject % nBioTracers, & !nbtrcr, intent(in) - nIcelayers, & - nSnowLayers, & - categoryThicknessLimits(:), & !hin_max, intent(inout), dimension(0:ncat) - nBioLayers, & - iceAreaCategory(1,:,iCell), & - iceVolumeCategory(1,:,iCell), & - snowVolumeCategory(1,:,iCell), & - iceAreaCategoryInitial(:,iCell), & - iceVolumeCategoryInitial(:,iCell), & - tracerArrayCategory, & !trcrn, intent(inout) - openWaterArea(iCell), & - iceAreaCell(iCell), & - ciceTracerObject % parentIndex, & !trcr_depend, intent(in) - ciceTracerObject % firstAncestorMask, & !trcr_base, intent(in) - ciceTracerObject % ancestorNumber, & !n_trcr_strata,intent(in) - ciceTracerObject % ancestorIndices, & !nt_strata, intent(in) - seaFreezingTemperature(iCell), & - seaSurfaceSalinity(iCell), & - initialSalinityProfile(:,iCell), & - lateralIceMeltFraction(iCell), & - lateralIceMelt(iCell), & - freezingMeltingPotential(iCell), & - frazilFormation(iCell), & - rainfallRate(iCell), & - pondFreshWaterFlux(iCell), & - oceanFreshWaterFlux(iCell), & - oceanSaltFlux(iCell), & - oceanHeatFlux(iCell), & - config_update_ocean_fluxes, & !update_ocn_f, intent(in) - biologyGrid(:), & !bgrid, intent(in) - verticalGrid(:), & !cgrid, intent(in) - interfaceBiologyGrid(:), & !igrid, intent(in) - oceanAerosolFlux(:,iCell), & - newlyFormedIceLogical(:), & !first_ice, intent(inout) - zSalinityFlux(iCell), & - oceanBioFluxesTemp(:,iCell), & - oceanBioConcentrationsUsed(:), & !ocean_bio, intent(in) - abortFlag, & - abortMessage, & - frazilGrowthDiagnostic(iCell), & - freezeOnset(iCell), & - dayOfYear) - - do iBioTracers = 1, ciceTracerObject % nBioTracers - oceanBioFluxes(iBioTracers,iCell) = oceanBioFluxes(iBioTracers,iCell) + oceanBioFluxesTemp(iBioTracers,iCell) - enddo - - call column_write_warnings(abortFlag) - - ! update - do iCategory = 1, nCategories - newlyFormedIce(iCategory,iCell) = 0 - if (newlyFormedIceLogical(iCategory)) newlyFormedIce(iCategory,iCell) = 1 - enddo ! iCategory - - ! get category tracer array - call get_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (checkCarbon) then - totalCarbonFinal(iCell) = 0.0_RKIND - call seaice_total_carbon_content_category(block,totalCarbonCatFinal(:,iCell),iceAreaCategory(1,:,:),iceVolumeCategory(1,:,:),iCell) - call seaice_ocean_carbon_flux_cell(block,oceanCarbonFlux(iCell),oceanBioFluxesTemp(:,iCell),iCell) - do iCategory = 1,nCategories - totalCarbonFinal(iCell) = totalCarbonFinal(iCell) + totalCarbonCatFinal(iCategory,iCell)*iceAreaCategory(1,iCategory,iCell) - enddo - carbonError(iCell) = (totalCarbonFinal(iCell) - totalCarbonInitial(iCell))/config_dt + oceanCarbonFlux(iCell) - - if (abs(carbonError(iCell)) > max(seaicePuny,1.0e-14_RKIND*abs(oceanCarbonFlux(iCell)))) then - call mpas_log_write("column_step_therm2, carbon conservation error", messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - call mpas_log_write("carbonError: $r", messageType=MPAS_LOG_ERR, realArgs=(/carbonError(iCell)/)) - call mpas_log_write("totalCarbonInitial: $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonInitial(iCell)/)) - call mpas_log_write("totalCarbonFinal: $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonFinal(iCell)/)) - call mpas_log_write("oceanCarbonFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanCarbonFlux(iCell)/)) - - do iCategory = 1, nCategories - call mpas_log_write("iCategory: $i", messageType=MPAS_LOG_ERR, intArgs=(/iCategory/)) - call mpas_log_write("totalCarbonCatFinal(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatFinal(iCategory,iCell)/)) - call mpas_log_write("totalCarbonCatInitial(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatFinal(iCategory,iCell)/)) - enddo - endif - endif - - ! code abort - if (abortFlag .and. .not. anyAbort) then - call mpas_log_write("column_itd_thermodynamics: "//trim(abortMessage) , messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - abortFlag = .false. - abortMessage = "" - anyAbort = .true. - endif - - enddo ! iCell - - ! code abort - call seaice_critical_error_write_block(domain, block, anyAbort) - call seaice_check_critical_error(domain, anyAbort) - - deallocate(totalCarbonCatFinal) - deallocate(totalCarbonCatInitial) - deallocate(totalCarbonInitial) - deallocate(totalCarbonFinal) - deallocate(oceanCarbonFlux) - deallocate(carbonError) - - ! newly formed ice - deallocate(newlyFormedIceLogical) - deallocate(oceanBioConcentrationsUsed) - deallocate(oceanBioFluxesTemp) - deallocate(verticalGridSpace) - - block => block % next - end do - - end subroutine column_itd_thermodynamics - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_prep_radiation -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 21th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_prep_radiation(domain) - - use ice_colpkg, only: colpkg_prep_radiation - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - tracers_aggregate, & - atmos_coupling, & - shortwave - - ! dimensions - integer, pointer :: & - nCellsSolve, & - nCategories, & - nIceLayers, & - nSnowLayers - - ! variables - real(kind=RKIND), dimension(:), pointer :: & - iceAreaCell, & - shortwaveVisibleDirectDown, & - shortwaveVisibleDiffuseDown, & - shortwaveIRDirectDown, & - shortwaveIRDiffuseDown, & - shortwaveScalingFactor, & - albedoVisibleDirectArea, & - albedoVisibleDiffuseArea, & - albedoIRDirectArea, & - albedoIRDiffuseArea - - real(kind=RKIND), dimension(:,:), pointer :: & - surfaceShortwaveFlux, & - interiorShortwaveFlux, & - penetratingShortwaveFlux - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - shortwaveLayerPenetration, & - absorbedShortwaveSnowLayer, & - absorbedShortwaveIceLayer - - ! local - integer :: & - iCell - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - - call MPAS_pool_get_array(atmos_coupling, "shortwaveVisibleDirectDown", shortwaveVisibleDirectDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveVisibleDiffuseDown", shortwaveVisibleDiffuseDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveIRDirectDown", shortwaveIRDirectDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveIRDiffuseDown", shortwaveIRDiffuseDown) - - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectArea", albedoVisibleDirectArea) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseArea", albedoVisibleDiffuseArea) - call MPAS_pool_get_array(shortwave, "albedoIRDirectArea", albedoIRDirectArea) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseArea", albedoIRDiffuseArea) - call MPAS_pool_get_array(shortwave, "shortwaveScalingFactor", shortwaveScalingFactor) - call MPAS_pool_get_array(shortwave, "surfaceShortwaveFlux", surfaceShortwaveFlux) - call MPAS_pool_get_array(shortwave, "interiorShortwaveFlux", interiorShortwaveFlux) - call MPAS_pool_get_array(shortwave, "penetratingShortwaveFlux", penetratingShortwaveFlux) - call MPAS_pool_get_array(shortwave, "shortwaveLayerPenetration", shortwaveLayerPenetration) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveSnowLayer", absorbedShortwaveSnowLayer) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveIceLayer", absorbedShortwaveIceLayer) - - do iCell = 1, nCellsSolve - - call colpkg_prep_radiation(& - nCategories, & - nIceLayers, & - nSnowLayers, & - iceAreaCell(iCell), & - iceAreaCategory(1,:,iCell), & - shortwaveVisibleDirectDown(iCell), & - shortwaveVisibleDiffuseDown(iCell), & - shortwaveIRDirectDown(iCell), & - shortwaveIRDiffuseDown(iCell), & - albedoVisibleDirectArea(iCell), & - albedoVisibleDiffuseArea(iCell), & - albedoIRDirectArea(iCell), & - albedoIRDiffuseArea(iCell), & - shortwaveScalingFactor(iCell), & - surfaceShortwaveFlux(:,iCell), & - interiorShortwaveFlux(:,iCell), & - penetratingShortwaveFlux(:,iCell), & - shortwaveLayerPenetration(:,:,iCell), & - absorbedShortwaveSnowLayer(:,:,iCell), & - absorbedShortwaveIceLayer(:,:,iCell)) - - enddo ! iCell - - block => block % next - end do - - end subroutine column_prep_radiation - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_snow -! -!> \brief Enable snow grain aging, effective snow density, wind compaction and redistribution -!> -!> \author Nicole Jeffery, LANL -!> \date 3rd April 2017 -!> \details -!> -!> Snow physics improvements include: -!> 1) Snow redistribution by wind (multiple options available). -!> Includes parametrizations for snow compaction, redistribution among categories/level ice -!> and loss to leads. -!> 2) Tracking of snow liquid and ice content. Liquid is stored in snow before passing to ponds. -!> Effective snow density is also tracked. -!> 3) Snow grain radius aging based on wet (liquid content) and dry (temperature gradient) metamorphism. -!> 4) Effective snow density (based on snow liquid/ice content and compaction) -! -!----------------------------------------------------------------------- - - subroutine column_snow(domain) - - use ice_colpkg, only: & - colpkg_step_snow, & - colpkg_clear_warnings, & - colpkg_get_warnings - - use seaice_constants, only: & - seaicePuny, & - seaiceDensitySnow - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - tracers_aggregate, & - atmos_forcing, & - snow, & - ocean_fluxes, & - atmos_coupling - - logical, pointer :: & - config_use_effective_snow_density, & - config_use_snow_grain_radius, & - config_use_column_biogeochemistry, & - config_use_zaerosols - - real(kind=RKIND), dimension(:,:,:), pointer :: & - snowIceMass, & - snowLiquidMass, & - snowDensity, & - snowVolumeCategory, & - iceAreaCategory, & - iceVolumeCategory, & - levelIceArea, & - levelIceVolume, & - iceEnthalpy, & - snowEnthalpy, & - iceSalinity, & - surfaceTemperature, & - snowGrainRadius, & - snowEmpiricalGrowthParameterTau, & - snowEmpiricalGrowthParameterKappa, & - snowPropertyRate - - real(kind=RKIND), dimension(:,:), pointer :: & - snowMeltMassCategory - - real(kind=RKIND), dimension(:), pointer :: & - windSpeed, & - oceanFreshWaterFlux, & - oceanHeatFlux, & - snowLossToLeads, & - snowfallRate, & - iceAreaCell, & - iceVolumeCell, & - snowVolumeCell, & - snowDensityViaContent, & - snowDensityViaCompaction, & - snowMeltMassCell - - real(kind=RKIND), pointer :: & - config_dt, & - config_new_snow_density, & - config_max_snow_density, & - config_minimum_wind_compaction, & - config_wind_compaction_factor, & - config_snow_redistribution_factor - - integer, pointer :: & - nCellsSolve, & - nSnowLayers, & - nIceLayers, & - nCategories, & - nGrainAgingTemperature, & - nGrainAgingTempGradient, & - nGrainAgingSnowDensity - - integer :: & - iCell, & - iSnowLayer, & - iIceLayer, & - iCategory - - logical :: & - abortFlag, & - setGetPhysicsTracers, & - setGetBGCTracers - - character(len=strKIND) :: & - abortMessage, & - abortLocation - - character(len=strKINDWarnings), dimension(:), allocatable :: & - warnings - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "snow", snow) - call MPAS_pool_get_subpool(block % structs, "atmos_forcing", atmos_forcing) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", ocean_fluxes) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - - call MPAS_pool_get_config(block % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(block % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - call MPAS_pool_get_config(block % configs, "config_dt", config_dt) - call MPAS_pool_get_config(block % configs, "config_new_snow_density", config_new_snow_density) - call MPAS_pool_get_config(block % configs, "config_max_snow_density", config_max_snow_density) - call MPAS_pool_get_config(block % configs, "config_minimum_wind_compaction", config_minimum_wind_compaction) - call MPAS_pool_get_config(block % configs, "config_wind_compaction_factor", config_wind_compaction_factor) - call MPAS_pool_get_config(block % configs, "config_snow_redistribution_factor", config_snow_redistribution_factor) - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols", config_use_zaerosols) - - call MPAS_pool_get_dimension(block % dimensions, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(block % dimensions, "nCategories", nCategories) - call MPAS_pool_get_dimension(block % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(block % dimensions, "nGrainAgingTemperature", nGrainAgingTemperature) - call MPAS_pool_get_dimension(block % dimensions, "nGrainAgingTempGradient", nGrainAgingTempGradient) - call MPAS_pool_get_dimension(block % dimensions, "nGrainAgingSnowDensity", nGrainAgingSnowDensity) - - call MPAS_pool_get_array(snow, "snowDensityViaContent", snowDensityViaContent) - call MPAS_pool_get_array(snow, "snowDensityViaCompaction", snowDensityViaCompaction) - call MPAS_pool_get_array(snow, "snowMeltMassCategory", snowMeltMassCategory) - call MPAS_pool_get_array(snow, "snowMeltMassCell", snowMeltMassCell) - call MPAS_pool_get_array(snow, "snowLossToLeads", snowLossToLeads) - call MPAS_pool_get_array(snow, "snowEmpiricalGrowthParameterTau", snowEmpiricalGrowthParameterTau) - call MPAS_pool_get_array(snow, "snowEmpiricalGrowthParameterKappa", snowEmpiricalGrowthParameterKappa) - call MPAS_pool_get_array(snow, "snowPropertyRate", snowPropertyRate) - - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "snowIceMass", snowIceMass, 1) - call MPAS_pool_get_array(tracers, "snowLiquidMass", snowLiquidMass, 1) - call MPAS_pool_get_array(tracers, "snowDensity", snowDensity, 1) - call MPAS_pool_get_array(tracers, "snowGrainRadius", snowGrainRadius, 1) - call MPAS_pool_get_array(tracers, "levelIceArea", levelIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceVolume", levelIceVolume, 1) - call MPAS_pool_get_array(tracers, "iceEnthalpy", iceEnthalpy, 1) - call MPAS_pool_get_array(tracers, "snowEnthalpy", snowEnthalpy, 1) - call MPAS_pool_get_array(tracers, "iceSalinity", iceSalinity, 1) - call MPAS_pool_get_array(tracers, "surfaceTemperature", surfaceTemperature, 1) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "snowVolumeCell", snowVolumeCell) - - call MPAS_pool_get_array(atmos_coupling, "snowfallRate", snowfallRate) - - call MPAS_pool_get_array(atmos_forcing, "windSpeed", windSpeed) - - call MPAS_pool_get_array(ocean_fluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanHeatFlux", oceanHeatFlux) - - setGetPhysicsTracers = .true. - setGetBGCTracers = (config_use_column_biogeochemistry .or. config_use_zaerosols) - - ! code abort - abortFlag = .false. - abortMessage = "" - - do iCell = 1, nCellsSolve - - call colpkg_clear_warnings() - call colpkg_step_snow (& - config_dt, & - windSpeed(iCell), & - nIceLayers, & - nSnowLayers, & - nCategories, & - iceAreaCell(iCell), & - iceAreaCategory(1,:,iCell), & - iceVolumeCategory(1,:,iCell), & - snowVolumeCategory(1,:,iCell), & - levelIceArea(1,:,iCell), & - levelIceVolume(1,:,iCell), & - snowIceMass(:,:,iCell), & - snowLiquidMass(:,:,iCell), & - snowDensity(:,:,iCell), & - snowDensityViaCompaction(iCell), & - snowGrainRadius(:,:,iCell), & - iceEnthalpy(1,:,iCell), & - iceSalinity(1,:,iCell), & - surfaceTemperature(1,:,iCell), & - snowEnthalpy(:,:,iCell), & - oceanFreshWaterFlux(iCell), & - oceanHeatFlux(iCell), & - snowLossToLeads(iCell), & - snowfallRate(iCell), & - config_new_snow_density, & - config_max_snow_density, & - config_minimum_wind_compaction, & - config_wind_compaction_factor, & - config_snow_redistribution_factor, & - snowEmpiricalGrowthParameterTau(:,:,:), & - snowEmpiricalGrowthParameterKappa(:,:,:), & - snowPropertyRate(:,:,:), & - nGrainAgingTemperature, & - nGrainAgingTempGradient, & - nGrainAgingSnowDensity, & - abortFlag, & - abortMessage) - - call column_write_warnings(abortFlag) - ! code abort - if (abortFlag) exit - - if (config_use_snow_grain_radius) then - snowDensityViaContent(iCell) = 0.0_RKIND - do iCategory = 1, nCategories - if (snowVolumeCategory(1,iCategory,iCell) .gt. 0.0_RKIND) then - do iSnowLayer = 1, nSnowLayers - snowDensityViaContent(iCell) = snowDensityViaContent(iCell) & - + snowVolumeCategory(1,iCategory,iCell) * & - (snowIceMass(iSnowLayer,iCategory,iCell) + & - snowLiquidMass(iSnowLayer,iCategory,iCell)) - enddo !iSnowLayer - endif !snowVolumeCategory - enddo !iCategory - if (snowVolumeCell(iCell) .gt. seaicePuny) then - snowDensityViaContent(iCell) = snowDensityViaContent(iCell)/ & - (snowVolumeCell(iCell) * real(nSnowLayers,kind=RKIND)) !!!CHECK THIS!!! - else - snowDensityViaContent(iCell) = seaiceDensitySnow - endif !snowVolumeCell - endif - - enddo !iCell - - ! code abort - call seaice_critical_error_write_block(domain, block, abortFlag) - call seaice_check_critical_error(domain, abortFlag) - - block => block % next - end do - - end subroutine column_snow - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_radiation -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 21th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_radiation(domain, clock, lInitialization) - - use ice_colpkg, only: & - colpkg_step_radiation, & - colpkg_clear_warnings - - use seaice_constants, only: & - pii - - type(domain_type), intent(inout) :: domain - - type(MPAS_clock_type), intent(in) :: clock - - logical, intent(in) :: & - lInitialization - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - atmos_coupling, & - shortwave, & - ponds, & - aerosols, & - biogeochemistry, & - snicar, & - snow - - ! configs - real(kind=RKIND), pointer :: & - config_dt - - logical, pointer :: & - config_use_shortwave_bioabsorption, & - config_use_brine, & - config_use_modal_aerosols, & - config_use_column_biogeochemistry, & - config_use_zaerosols - - character(len=strKIND), pointer :: & - config_snow_redistribution_scheme - - ! dimensions - integer, pointer :: & - nCellsSolve, & - nCategories, & - nIceLayers, & - nSnowLayers, & - nAerosols, & - nAlgae, & - nBioLayers, & - nzAerosols, & - maxAerosolType - - ! variables - real(kind=RKIND), dimension(:), pointer :: & - latCell, & - lonCell, & - shortwaveVisibleDirectDown, & - shortwaveVisibleDiffuseDown, & - shortwaveIRDirectDown, & - shortwaveIRDiffuseDown, & - solarZenithAngleCosine, & - snowfallRate, & - verticalShortwaveGrid, & - verticalGrid - - real(kind=RKIND), dimension(:,:), pointer :: & - surfaceShortwaveFlux, & - interiorShortwaveFlux, & - penetratingShortwaveFlux, & - bareIceAlbedoCategory, & - snowAlbedoCategory, & - pondAlbedoCategory, & - effectivePondAreaCategory, & - pondSnowDepthDifference, & - pondLidMeltFluxFraction, & - aerosolMassExtinctionCrossSection, & - aerosolSingleScatterAlbedo, & - aerosolAsymmetryParameter, & - modalMassExtinctionCrossSection, & - modalSingleScatterAlbedo, & - modalAsymmetryParameter, & - albedoVisibleDirectCategory, & - albedoVisibleDiffuseCategory, & - albedoIRDirectCategory, & - albedoIRDiffuseCategory, & - snowFractionCategory, & - iceAsymmetryParameterDirect, & - iceAsymmetryParameterDiffuse, & - iceSingleScatterAlbedoDirect, & - iceSingleScatterAlbedoDiffuse, & - iceMassExtinctionCrossSectionDirect, & - iceMassExtinctionCrossSectionDiffuse, & - aerosolAsymmetryParameter5band, & - aerosolMassExtinctionCrossSection5band, & - aerosolSingleScatterAlbedo5band, & - modalAsymmetryParameter5band, & - modalMassExtinctionCrossSection5band, & - modalSingleScatterAlbedo5band, & - snowRadiusInStandardRadiationSchemeCategory - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - iceVolumeCategory, & - snowVolumeCategory, & - surfaceTemperature, & - levelIceArea, & - pondArea, & - pondDepth, & - pondLidThickness, & - shortwaveLayerPenetration, & - absorbedShortwaveSnowLayer, & - absorbedShortwaveIceLayer, & - snowScatteringAerosol, & - snowBodyAerosol, & - iceScatteringAerosol, & - iceBodyAerosol, & - brineFraction, & - modalBCabsorptionParameter, & - bioTracerShortwave, & - modalBCabsorptionParameter5band, & - snowGrainRadius - - real(kind=RKIND), pointer :: & - dayOfNextShortwaveCalculation ! needed for CESM like coupled simulations - - character(len=strKIND), pointer :: & - config_calendar_type - - character(len=strKIND) :: & - calendarType ! needed for CESM like coupled simulations - - ! aerosols array - real(kind=RKIND), dimension(:,:), allocatable :: & - aerosolsArray - - ! local - integer :: & - iCell, & - iCategory, & - iAerosol, & - iTracer -! nspint_5bd, & ! for checking against icepack array values -! nmbrad_snicar ! for checking against icepack array values - - integer, dimension(:), allocatable :: & - index_shortwaveAerosol - - real(kind=RKIND) :: & - dayOfYear, & - lonCellColumn - - integer :: & - secondsIntoDay, & - daysInYear - - logical :: & - setGetPhysicsTracers, & - setGetBGCTracers - - ! day of year - call get_day_of_year(clock, dayOfYear) - - ! seconds into day - call get_seconds_into_day(clock, secondsIntoDay) - - ! get days in year - call get_days_in_year(domain, clock, daysInYear) - - call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) - call MPAS_pool_get_config(domain % configs, "config_use_modal_aerosols",config_use_modal_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry",config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols",config_use_zaerosols) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - call MPAS_pool_get_subpool(block % structs, "ponds", ponds) - call MPAS_pool_get_subpool(block % structs, "aerosols", aerosols) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "snicar", snicar) - call MPAS_pool_get_subpool(block % structs, "snow", snow) - - call MPAS_pool_get_config(block % configs, "config_dt", config_dt) - call MPAS_pool_get_config(block % configs, "config_snow_redistribution_scheme", config_snow_redistribution_scheme) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(mesh, "nAerosols", nAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(block % dimensions, "maxAerosolType", maxAerosolType) - - call MPAS_pool_get_array(mesh, "latCell", latCell) - call MPAS_pool_get_array(mesh, "lonCell", lonCell) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "surfaceTemperature", surfaceTemperature, 1) - call MPAS_pool_get_array(tracers, "levelIceArea", levelIceArea, 1) - call MPAS_pool_get_array(tracers, "pondArea", pondArea, 1) - call MPAS_pool_get_array(tracers, "pondDepth", pondDepth, 1) - call MPAS_pool_get_array(tracers, "pondLidThickness", pondLidThickness, 1) - call MPAS_pool_get_array(tracers, "snowScatteringAerosol", snowScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "snowBodyAerosol", snowBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "iceScatteringAerosol", iceScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "iceBodyAerosol", iceBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - call MPAS_pool_get_array(tracers, "snowGrainRadius", snowGrainRadius, 1) - - call MPAS_pool_get_array(atmos_coupling, "shortwaveVisibleDirectDown", shortwaveVisibleDirectDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveVisibleDiffuseDown", shortwaveVisibleDiffuseDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveIRDirectDown", shortwaveIRDirectDown) - call MPAS_pool_get_array(atmos_coupling, "shortwaveIRDiffuseDown", shortwaveIRDiffuseDown) - call MPAS_pool_get_array(atmos_coupling, "snowfallRate", snowfallRate) - - call MPAS_pool_get_array(shortwave, "dayOfNextShortwaveCalculation", dayOfNextShortwaveCalculation) - call MPAS_pool_get_array(shortwave, "solarZenithAngleCosine", solarZenithAngleCosine) - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectCategory", albedoVisibleDirectCategory) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseCategory", albedoVisibleDiffuseCategory) - call MPAS_pool_get_array(shortwave, "albedoIRDirectCategory", albedoIRDirectCategory) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseCategory", albedoIRDiffuseCategory) - call MPAS_pool_get_array(shortwave, "surfaceShortwaveFlux", surfaceShortwaveFlux) - call MPAS_pool_get_array(shortwave, "interiorShortwaveFlux", interiorShortwaveFlux) - call MPAS_pool_get_array(shortwave, "penetratingShortwaveFlux", penetratingShortwaveFlux) - call MPAS_pool_get_array(shortwave, "shortwaveLayerPenetration", shortwaveLayerPenetration) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveSnowLayer", absorbedShortwaveSnowLayer) - call MPAS_pool_get_array(shortwave, "absorbedShortwaveIceLayer", absorbedShortwaveIceLayer) - call MPAS_pool_get_array(shortwave, "bareIceAlbedoCategory", bareIceAlbedoCategory) - call MPAS_pool_get_array(shortwave, "snowAlbedoCategory", snowAlbedoCategory) - call MPAS_pool_get_array(shortwave, "pondAlbedoCategory", pondAlbedoCategory) - call MPAS_pool_get_array(shortwave, "effectivePondAreaCategory", effectivePondAreaCategory) - call MPAS_pool_get_array(shortwave, "snowFractionCategory", snowFractionCategory) - - call MPAS_pool_get_array(ponds, "pondSnowDepthDifference", pondSnowDepthDifference) - call MPAS_pool_get_array(ponds, "pondLidMeltFluxFraction", pondLidMeltFluxFraction) - - call MPAS_pool_get_array(aerosols, "aerosolMassExtinctionCrossSection", aerosolMassExtinctionCrossSection) - call MPAS_pool_get_array(aerosols, "aerosolSingleScatterAlbedo", aerosolSingleScatterAlbedo) - call MPAS_pool_get_array(aerosols, "aerosolAsymmetryParameter", aerosolAsymmetryParameter) - call MPAS_pool_get_array(aerosols, "modalMassExtinctionCrossSection", modalMassExtinctionCrossSection) - call MPAS_pool_get_array(aerosols, "modalSingleScatterAlbedo", modalSingleScatterAlbedo) - call MPAS_pool_get_array(aerosols, "modalAsymmetryParameter", modalAsymmetryParameter) - call MPAS_pool_get_array(aerosols, "modalBCabsorptionParameter", modalBCabsorptionParameter) - - call MPAS_pool_get_array(biogeochemistry, "bioTracerShortwave", bioTracerShortwave) - call MPAS_pool_get_array(biogeochemistry, "verticalShortwaveGrid", verticalShortwaveGrid) - call MPAS_pool_get_array(biogeochemistry, "verticalGrid", verticalGrid) - - ! snicar 5-band snow IOPs - call MPAS_pool_get_array(snicar, "iceAsymmetryParameterDirect", iceAsymmetryParameterDirect) - call MPAS_pool_get_array(snicar, "iceAsymmetryParameterDiffuse", iceAsymmetryParameterDiffuse) - call MPAS_pool_get_array(snicar, "iceSingleScatterAlbedoDirect", iceSingleScatterAlbedoDirect) - call MPAS_pool_get_array(snicar, "iceSingleScatterAlbedoDiffuse", iceSingleScatterAlbedoDiffuse) - call MPAS_pool_get_array(snicar, "iceMassExtinctionCrossSectionDirect", iceMassExtinctionCrossSectionDirect) - call MPAS_pool_get_array(snicar, "iceMassExtinctionCrossSectionDiffuse", iceMassExtinctionCrossSectionDiffuse) - call MPAS_pool_get_array(snicar, "aerosolMassExtinctionCrossSection5band", aerosolMassExtinctionCrossSection5band) - call MPAS_pool_get_array(snicar, "aerosolSingleScatterAlbedo5band", aerosolSingleScatterAlbedo5band) - call MPAS_pool_get_array(snicar, "aerosolAsymmetryParameter5band", aerosolAsymmetryParameter5band) - call MPAS_pool_get_array(snicar, "modalMassExtinctionCrossSection5band", modalMassExtinctionCrossSection5band) - call MPAS_pool_get_array(snicar, "modalSingleScatterAlbedo5band", modalSingleScatterAlbedo5band) - call MPAS_pool_get_array(snicar, "modalAsymmetryParameter5band", modalAsymmetryParameter5band) - call MPAS_pool_get_array(snicar, "modalBCabsorptionParameter5band", modalBCabsorptionParameter5band) - -! write out corner values of arrays to compare with values from icepack tables (subroutine icepack_init_radiation) -! call mpas_log_write(' ') -! call mpas_log_write(" ----- snicar parameters (column) -----") -! nspint_5bd = size(iceAsymmetryParameterDirect,1) -! nmbrad_snicar = size(iceAsymmetryParameterDirect,2) -! call mpas_log_write('nspint_5bd $i',intArgs=(/nspint_5bd/)) -! call mpas_log_write('nmbrad_snicar $i',intArgs=(/nmbrad_snicar/)) -! call mpas_log_write('ssp_sasymmdr(1,1) $r',realArgs=(/iceAsymmetryParameterDirect(1,1)/)) -! call mpas_log_write('ssp_sasymmdr(nspint_5bd,1) $r',realArgs=(/iceAsymmetryParameterDirect(nspint_5bd,1)/)) -! call mpas_log_write('ssp_sasymmdr(1,nmbrad_snicar) $r',realArgs=(/iceAsymmetryParameterDirect(1,nmbrad_snicar)/)) -! call mpas_log_write('ssp_sasymmdr(nspint_5bd,nmbrad_snicar) $r',realArgs=(/iceAsymmetryParameterDirect(nspint_5bd,nmbrad_snicar)/)) -! call mpas_log_write('ssp_sasymmdc(1,1) $r',realArgs=(/iceAsymmetryParameterDiffuse(1,1)/)) -! call mpas_log_write('ssp_sasymmdc(nspint_5bd,1) $r',realArgs=(/iceAsymmetryParameterDiffuse(nspint_5bd,1)/)) -! call mpas_log_write('ssp_sasymmdc(1,nmbrad_snicar) $r',realArgs=(/iceAsymmetryParameterDiffuse(1,nmbrad_snicar)/)) -! call mpas_log_write('ssp_sasymmdc(nspint_5bd,nmbrad_snicar) $r',realArgs=(/iceAsymmetryParameterDiffuse(nspint_5bd,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwalbdr(1,1) $r',realArgs=(/iceSingleScatterAlbedoDirect(1,1)/)) -! call mpas_log_write('ssp_snwalbdr(nspint_5bd,1) $r',realArgs=(/iceSingleScatterAlbedoDirect(nspint_5bd,1)/)) -! call mpas_log_write('ssp_snwalbdr(1,nmbrad_snicar) $r',realArgs=(/iceSingleScatterAlbedoDirect(1,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwalbdr(nspint_5bd,nmbrad_snicar) $r',realArgs=(/iceSingleScatterAlbedoDirect(nspint_5bd,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwalbdc(1,1) $r',realArgs=(/iceSingleScatterAlbedoDiffuse(1,1)/)) -! call mpas_log_write('ssp_snwalbdc(nspint_5bd,1) $r',realArgs=(/iceSingleScatterAlbedoDiffuse(nspint_5bd,1)/)) -! call mpas_log_write('ssp_snwalbdc(1,nmbrad_snicar) $r',realArgs=(/iceSingleScatterAlbedoDiffuse(1,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwalbdc(nspint_5bd,nmbrad_snicar) $r',realArgs=(/iceSingleScatterAlbedoDiffuse(nspint_5bd,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwextdr(1,1) $r',realArgs=(/iceMassExtinctionCrossSectionDirect(1,1)/)) -! call mpas_log_write('ssp_snwextdr(nspint_5bd,1) $r',realArgs=(/iceMassExtinctionCrossSectionDirect(nspint_5bd,1)/)) -! call mpas_log_write('ssp_snwextdr(1,nmbrad_snicar) $r',realArgs=(/iceMassExtinctionCrossSectionDirect(1,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwextdr(nspint_5bd,nmbrad_snicar) $r',realArgs=(/iceMassExtinctionCrossSectionDirect(nspint_5bd,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwextdc(1,1) $r',realArgs=(/iceMassExtinctionCrossSectionDiffuse(1,1)/)) -! call mpas_log_write('ssp_snwextdc(nspint_5bd,1) $r',realArgs=(/iceMassExtinctionCrossSectionDiffuse(nspint_5bd,1)/)) -! call mpas_log_write('ssp_snwextdc(1,nmbrad_snicar) $r',realArgs=(/iceMassExtinctionCrossSectionDiffuse(1,nmbrad_snicar)/)) -! call mpas_log_write('ssp_snwextdc(nspint_5bd,nmbrad_snicar) $r',realArgs=(/iceMassExtinctionCrossSectionDiffuse(nspint_5bd,nmbrad_snicar)/)) - - call MPAS_pool_get_array(snow, "snowRadiusInStandardRadiationSchemeCategory", snowRadiusInStandardRadiationSchemeCategory) - - ! calendar type - call MPAS_pool_get_config(block % configs, "config_calendar_type", config_calendar_type) - if (trim(config_calendar_type) == "gregorian") then - calendarType = "GREGORIAN" - else - calendarType = "NOLEAP" - endif - - ! aerosols array - allocate(aerosolsArray(4*nAerosols,nCategories)) - allocate(index_shortwaveAerosol(maxAerosolType)) - - if (.not. config_use_zaerosols) then - index_shortwaveAerosol(1:maxAerosolType) = 1 - else - do iAerosol = 1, maxAerosolType - index_shortwaveAerosol(iAerosol) = ciceTracerObject % index_verticalAerosolsConcShortwave(iAerosol) - enddo - endif - - setGetPhysicsTracers = .true. - setGetBGCTracers = (config_use_column_biogeochemistry .or. config_use_zaerosols) - - !$omp parallel do default(shared) firstprivate(aerosolsArray,index_shortwaveAerosol) & - !$omp& private(iCategory,iAerosol,lonCellColumn) - do iCell = 1, nCellsSolve - - ! set aerosols array - do iCategory = 1, nCategories - do iAerosol = 1, nAerosols - - aerosolsArray(1+4*(iAerosol-1), iCategory) = snowScatteringAerosol(iAerosol,iCategory,iCell) - aerosolsArray(2+4*(iAerosol-1), iCategory) = snowBodyAerosol(iAerosol,iCategory,iCell) - aerosolsArray(3+4*(iAerosol-1), iCategory) = iceScatteringAerosol(iAerosol,iCategory,iCell) - aerosolsArray(4+4*(iAerosol-1), iCategory) = iceBodyAerosol(iAerosol,iCategory,iCell) - - enddo ! iAerosol - enddo ! iCategory - - lonCellColumn = lonCell(iCell) - if (lonCellColumn > pii) lonCellColumn = lonCellColumn - 2.0_RKIND * pii - - ! set the category tracer array - call set_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - call colpkg_clear_warnings() - call colpkg_step_radiation(& - config_dt, & - nCategories, & - nAlgae, & - nBioLayers, & - ciceTracerObject % nTracers, & - ciceTracerObject % nBioTracers, & - ciceTracerObject % nBioTracersShortwave, & - nIceLayers, & - nSnowLayers, & - nAerosols, & - nzAerosols, & - config_use_shortwave_bioabsorption, & - ciceTracerObject % index_chlorophyllShortwave, & - index_shortwaveAerosol, & ! nlt_zaero_sw, dimension(:), intent(in) - verticalShortwaveGrid(:), & ! swgrid, dimension (:), intent(in) - verticalGrid(:), & ! igrid, dimension (:), intent(in) - brineFraction(1,:,iCell), & - iceAreaCategory(1,:,iCell), & - iceVolumeCategory(1,:,iCell), & - snowVolumeCategory(1,:,iCell), & - surfaceTemperature(1,:,iCell), & - levelIceArea(1,:,iCell), & - pondArea(1,:,iCell), & - pondDepth(1,:,iCell), & - pondLidThickness(1,:,iCell), & - config_snow_redistribution_scheme, & - snowGrainRadius(:,:,iCell), & - aerosolsArray, & - bioTracerShortwave(:,:,iCell), & - tracerArrayCategory, & ! trcrn, dimension(:,:), intent(in) - latCell(iCell), & - lonCellColumn, & - calendarType, & - daysInYear, & - dayOfNextShortwaveCalculation, & - dayOfYear, & - secondsIntoDay, & - aerosolMassExtinctionCrossSection(:,:), & ! kaer_tab, dimension(:,:), intent(in) - aerosolSingleScatterAlbedo(:,:), & ! waer_tab, dimension(:,:), intent(in) - aerosolAsymmetryParameter(:,:), & ! gaer_tab, dimension(:,:), intent(in) - modalMassExtinctionCrossSection(:,:), & ! kaer_bc_tab, dimension(:,:), intent(in) - modalSingleScatterAlbedo(:,:), & ! waer_bc_tab, dimension(:,:), intent(in) - modalAsymmetryParameter(:,:), & ! gaer_bc_tab, dimension(:,:), intent(in) - modalBCabsorptionParameter(:,:,:), & ! bcenh, dimension(:,:,:), intent(in) - config_use_modal_aerosols, & - shortwaveVisibleDirectDown(iCell), & - shortwaveVisibleDiffuseDown(iCell), & - shortwaveIRDirectDown(iCell), & - shortwaveIRDiffuseDown(iCell), & - solarZenithAngleCosine(iCell), & - snowfallRate(iCell), & - albedoVisibleDirectCategory(:,iCell), & - albedoVisibleDiffuseCategory(:,iCell), & - albedoIRDirectCategory(:,iCell), & - albedoIRDiffuseCategory(:,iCell), & - surfaceShortwaveFlux(:,iCell), & - interiorShortwaveFlux(:,iCell), & - penetratingShortwaveFlux(:,iCell), & - shortwaveLayerPenetration(:,:,iCell), & - absorbedShortwaveSnowLayer(:,:,iCell), & - absorbedShortwaveIceLayer(:,:,iCell), & - bareIceAlbedoCategory(:,iCell), & - snowAlbedoCategory(:,iCell), & - pondAlbedoCategory(:,iCell), & - effectivePondAreaCategory(:,iCell), & - snowFractionCategory(:,iCell), & - pondSnowDepthDifference(:,iCell), & - pondLidMeltFluxFraction(:,iCell), & - .false., & - lInitialization, & - iceAsymmetryParameterDirect(:,:), & - iceAsymmetryParameterDiffuse(:,:), & - iceSingleScatterAlbedoDirect(:,:), & - iceSingleScatterAlbedoDiffuse(:,:), & - iceMassExtinctionCrossSectionDirect(:,:), & - iceMassExtinctionCrossSectionDiffuse(:,:), & - aerosolMassExtinctionCrossSection5band(:,:), & - aerosolSingleScatterAlbedo5band(:,:), & - aerosolAsymmetryParameter5band(:,:), & - modalMassExtinctionCrossSection5band(:,:), & - modalSingleScatterAlbedo5band(:,:), & - modalAsymmetryParameter5band(:,:), & - modalBCabsorptionParameter5band(:,:,:), & - snowRadiusInStandardRadiationSchemeCategory(:,iCell)) - - call column_write_warnings(.false.) - - ! set the category tracer array - call get_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - enddo ! iCell - - ! aerosols array - deallocate(aerosolsArray) - deallocate(index_shortwaveAerosol) - - block => block % next - end do - - end subroutine column_radiation - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_ridging -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 21th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_ridging(domain) - - use ice_colpkg, only: & - colpkg_step_ridge, & - colpkg_clear_warnings - - use seaice_constants, only: & - seaicePuny - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - icestate, & - tracers, & - tracers_aggregate, & - ponds, & - ocean_fluxes, & - ocean_coupling, & - ridging, & - aerosols, & - biogeochemistry, & - initial, & - velocity_solver - - ! configs - logical, pointer :: & - config_use_column_biogeochemistry, & - config_use_zaerosols - - real(kind=RKIND), pointer :: & - config_dt - - integer, pointer :: & - config_dynamics_subcycle_number - - ! dimensions - integer, pointer :: & - nCellsSolve, & - nCategories, & - nIceLayers, & - nSnowLayers, & - nAerosols, & - nBioLayers, & - nBioLayersP1 - - ! variables - real(kind=RKIND), dimension(:), pointer :: & - pondFreshWaterFlux, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFlux, & - seaFreezingTemperature, & - iceAreaCell, & - ridgeConvergence, & - ridgeShear, & - openWaterArea, & - areaLossRidge, & - areaGainRidge, & - iceVolumeRidged, & - openingRateRidge, & - categoryThicknessLimits, & - zSalinityFlux - - real(kind=RKIND), dimension(:,:), pointer :: & - oceanAerosolFlux, & - ridgeParticipationFunction, & - ratioRidgeThicknessToIce, & - fractionNewRidgeArea, & - fractionNewRidgeVolume, & - areaLossRidgeCategory, & - areaGainRidgeCategory, & - iceVolumeRidgedCategory, & - raftingIceArea, & - raftingIceVolume, & - oceanBioFluxes - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - iceVolumeCategory, & - snowVolumeCategory - - integer, dimension(:,:), pointer :: & - newlyFormedIce - - integer, dimension(:), pointer :: & - indexToCellID - - real(kind=RKIND), pointer :: & - dynamicsTimeStep - - ! local - integer :: & - iCell, & - iCategory, & - iBioTracers, & - iBioData, & - iBioLayers - - ! test carbon conservation - real(kind=RKIND), dimension(:,:), allocatable :: & - totalCarbonCatFinal, & - totalCarbonCatInitial, & - oceanBioFluxesTemp - - real(kind=RKIND), dimension(:), allocatable :: & - verticalGridSpace, & - oceanCarbonFlux, & - totalCarbonFinal, & - totalCarbonInitial, & - carbonError, & - iceAreaCategoryInitial - - logical, dimension(:), allocatable :: & - newlyFormedIceLogical - - logical :: & - abortFlag, & - setGetPhysicsTracers, & - setGetBGCTracers, & - checkCarbon - - character(len=strKIND) :: & - abortMessage, & - abortLocation - - checkCarbon = .false. - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "icestate", icestate) - call MPAS_pool_get_subpool(block % structs, "ponds", ponds) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", ocean_fluxes) - call MPAS_pool_get_subpool(block % structs, "ridging", ridging) - call MPAS_pool_get_subpool(block % structs, "aerosols", aerosols) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "initial", initial) - call MPAS_pool_get_subpool(block % structs, "velocity_solver", velocity_solver) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - - call MPAS_pool_get_config(block % configs, "config_dynamics_subcycle_number", config_dynamics_subcycle_number) - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(block % configs, "config_dt", config_dt) - - call MPAS_pool_get_array(velocity_solver, "dynamicsTimeStep", dynamicsTimeStep) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(mesh, "nAerosols", nAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP1", nBioLayersP1) - - call MPAS_pool_get_array(mesh, "indexToCellID", indexToCellID) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - - call MPAS_pool_get_array(icestate, "openWaterArea", openWaterArea) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - - call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - - call MPAS_pool_get_array(ocean_fluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanSaltFlux", oceanSaltFlux) - call MPAS_pool_get_array(ocean_fluxes, "oceanHeatFlux", oceanHeatFlux) - - call MPAS_pool_get_array(ridging, "ridgeConvergence", ridgeConvergence) - call MPAS_pool_get_array(ridging, "ridgeShear", ridgeShear) - call MPAS_pool_get_array(ridging, "areaLossRidge", areaLossRidge) - call MPAS_pool_get_array(ridging, "areaGainRidge", areaGainRidge) - call MPAS_pool_get_array(ridging, "iceVolumeRidged", iceVolumeRidged) - call MPAS_pool_get_array(ridging, "openingRateRidge", openingRateRidge) - call MPAS_pool_get_array(ridging, "ridgeParticipationFunction", ridgeParticipationFunction) - call MPAS_pool_get_array(ridging, "ratioRidgeThicknessToIce", ratioRidgeThicknessToIce) - call MPAS_pool_get_array(ridging, "fractionNewRidgeArea", fractionNewRidgeArea) - call MPAS_pool_get_array(ridging, "fractionNewRidgeVolume", fractionNewRidgeVolume) - call MPAS_pool_get_array(ridging, "areaLossRidgeCategory", areaLossRidgeCategory) - call MPAS_pool_get_array(ridging, "areaGainRidgeCategory", areaGainRidgeCategory) - call MPAS_pool_get_array(ridging, "iceVolumeRidgedCategory", iceVolumeRidgedCategory) - call MPAS_pool_get_array(ridging, "raftingIceArea", raftingIceArea) - call MPAS_pool_get_array(ridging, "raftingIceVolume", raftingIceVolume) - - call MPAS_pool_get_array(aerosols, "oceanAerosolFlux", oceanAerosolFlux) - - call MPAS_pool_get_array(ponds, "pondFreshWaterFlux", pondFreshWaterFlux) - - call MPAS_pool_get_array(biogeochemistry, "newlyFormedIce", newlyFormedIce) - call MPAS_pool_get_array(biogeochemistry, "oceanBioFluxes", oceanBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "zSalinityFlux", zSalinityFlux) - - call MPAS_pool_get_array(initial, "categoryThicknessLimits", categoryThicknessLimits) - - ! newly formed ice - allocate(newlyFormedIceLogical(nCategories)) - - allocate(oceanBioFluxesTemp(ciceTracerObject % nBioTracers,nCellsSolve)) - allocate(verticalGridSpace(nBioLayersP1)) - if (checkCarbon) then - allocate(totalCarbonCatFinal(nCategories,nCellsSolve)) - allocate(totalCarbonCatInitial(nCategories,nCellsSolve)) - allocate(totalCarbonInitial(nCellsSolve)) - allocate(totalCarbonFinal(nCellsSolve)) - allocate(oceanCarbonFlux(nCellsSolve)) - allocate(carbonError(nCellsSolve)) - allocate(iceAreaCategoryInitial(nCategories)) - else - allocate(totalCarbonCatFinal(1,1)) - allocate(totalCarbonCatInitial(1,1)) - allocate(totalCarbonInitial(1)) - allocate(totalCarbonFinal(1)) - allocate(oceanCarbonFlux(1)) - allocate(carbonError(1)) - allocate(iceAreaCategoryInitial(1)) - endif - - verticalGridSpace(:) = 1.0_RKIND/real(nBioLayers,kind=RKIND) - verticalGridSpace(1) = verticalGridSpace(2)/2.0_RKIND - verticalGridSpace(nBioLayersP1) = verticalGridSpace(1) - - setGetPhysicsTracers = .true. - setGetBGCTracers = (config_use_column_biogeochemistry .or. config_use_zaerosols) - - ! code abort - abortFlag = .false. - abortMessage = "" - - do iCell = 1, nCellsSolve - - ! newly formed ice - do iCategory = 1, nCategories - newlyFormedIceLogical(iCategory) = (newlyFormedIce(iCategory,iCell) == 1) - enddo ! iCategory - - ! set the category tracer array - call set_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (checkCarbon) then - totalCarbonInitial(iCell) = 0.0_RKIND - call seaice_total_carbon_content_category(block,totalCarbonCatInitial(:,iCell),iceAreaCategory(1,:,:),iceVolumeCategory(1,:,:),iCell) - do iCategory = 1,nCategories - iceAreaCategoryInitial(iCategory) = iceAreaCategory(1,iCategory,iCell) - totalCarbonInitial(iCell) = totalCarbonInitial(iCell) + totalCarbonCatInitial(iCategory,iCell)*iceAreaCategory(1,iCategory,iCell) - enddo - endif - - oceanBioFluxesTemp(:,iCell) = 0.0_RKIND - - call colpkg_clear_warnings() - call colpkg_step_ridge(& - dynamicsTimeStep, & - config_dynamics_subcycle_number, & - nIceLayers, & - nSnowLayers, & - nBioLayers, & - nCategories, & - categoryThicknessLimits, & ! hin_max, dimension(0:ncat), intent(inout) - ridgeConvergence(iCell), & - ridgeShear(iCell), & - seaFreezingTemperature(iCell), & - iceAreaCategory(1,:,iCell), & - tracerArrayCategory, & ! trcrn, dimension(:,:), intent(inout) - iceVolumeCategory(1,:,iCell), & - snowVolumeCategory(1,:,iCell), & - openWaterArea(iCell), & - ciceTracerObject % parentIndex, & ! trcr_depend - ciceTracerObject % firstAncestorMask, & ! trcr_base - ciceTracerObject % ancestorNumber, & ! n_trcr_strata - ciceTracerObject % ancestorIndices, & ! nt_strata - areaLossRidge(iCell), & - areaGainRidge(iCell), & - iceVolumeRidged(iCell), & - openingRateRidge(iCell), & - pondFreshWaterFlux(iCell), & - oceanFreshWaterFlux(iCell), & - oceanHeatFlux(iCell), & - nAerosols, & - oceanAerosolFlux(:,iCell), & - ridgeParticipationFunction(:,iCell), & - ratioRidgeThicknessToIce(:,iCell), & - fractionNewRidgeArea(:,iCell), & - fractionNewRidgeVolume(:,iCell), & - areaLossRidgeCategory(:,iCell), & - areaGainRidgeCategory(:,iCell), & - iceVolumeRidgedCategory(:,iCell), & - raftingIceArea(:,iCell), & - raftingIceVolume(:,iCell), & - iceAreaCell(iCell), & - oceanSaltFlux(iCell), & - newlyFormedIceLogical(:), & - zSalinityFlux(iCell), & - oceanBioFluxesTemp(:,iCell), & - abortFlag, & - abortMessage) - call column_write_warnings(abortFlag) - - do iBioTracers = 1, ciceTracerObject % nBioTracers - oceanBioFluxes(iBioTracers,iCell) = oceanBioFluxes(iBioTracers,iCell) + oceanBioFluxesTemp(iBioTracers,iCell) - enddo - - ! update - do iCategory = 1, nCategories - newlyFormedIce(iCategory,iCell) = 0 - if (newlyFormedIceLogical(iCategory)) newlyFormedIce(iCategory,iCell) = 1 - enddo ! iCategory - - ! get category tracer array - call get_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (checkCarbon) then - totalCarbonFinal(iCell) = 0.0_RKIND - call seaice_total_carbon_content_category(block,totalCarbonCatFinal(:,iCell),iceAreaCategory(1,:,:),iceVolumeCategory(1,:,:),iCell) - call seaice_ocean_carbon_flux_cell(block,oceanCarbonFlux(iCell),oceanBioFluxesTemp(:,iCell),iCell) - do iCategory = 1,nCategories - totalCarbonFinal(iCell) = totalCarbonFinal(iCell) + totalCarbonCatFinal(iCategory,iCell)*iceAreaCategory(1,iCategory,iCell) - enddo - carbonError(iCell) = (totalCarbonFinal(iCell) - totalCarbonInitial(iCell))/config_dt + oceanCarbonFlux(iCell) - - if (abs(carbonError(iCell)) > max(10.0_RKIND*seaicePuny,1.0e-14_RKIND*abs(oceanCarbonFlux(iCell))) .and. & - MAXVAL(iceAreaCategory(1,:,iCell)) > seaicePuny .and. & - MAXVAL(iceAreaCategoryInitial(:)) > seaicePuny) then - call mpas_log_write("column_step_ridge, carbon conservation error", messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - call mpas_log_write("carbonError: $r", messageType=MPAS_LOG_ERR, realArgs=(/carbonError(iCell)/)) - call mpas_log_write("totalCarbonInitial: $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonInitial(iCell)/)) - call mpas_log_write("totalCarbonFinal: $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonFinal(iCell)/)) - call mpas_log_write("oceanCarbonFlux: $r", messageType=MPAS_LOG_ERR, realArgs=(/oceanCarbonFlux(iCell)/)) - - do iCategory = 1, nCategories - call mpas_log_write("iCategory: $i", messageType=MPAS_LOG_ERR, intArgs=(/iCategory/)) - call mpas_log_write("totalCarbonCatFinal(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatFinal(iCategory,iCell)/)) - call mpas_log_write("totalCarbonCatInitial(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatFinal(iCategory,iCell)/)) - call mpas_log_write("iceAreaCategory(1,iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCategory(1,iCategory,iCell)/)) - call mpas_log_write("iceAreaCategoryInitial(iCategory): $r", messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCategoryInitial(iCategory)/)) - enddo - endif - endif - - ! code abort - if (abortFlag) then - call mpas_log_write("column_ridging: "//trim(abortMessage) , messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - exit - endif - - enddo ! iCell - - ! code abort - call seaice_critical_error_write_block(domain, block, abortFlag) - call seaice_check_critical_error(domain, abortFlag) - - deallocate(oceanBioFluxesTemp) - deallocate(verticalGridSpace) - deallocate(totalCarbonCatFinal) - deallocate(totalCarbonCatInitial) - deallocate(totalCarbonInitial) - deallocate(totalCarbonFinal) - deallocate(oceanCarbonFlux) - deallocate(carbonError) - deallocate(iceAreaCategoryInitial) - - ! newly formed ice - deallocate(newlyFormedIceLogical) - - block => block % next - end do - - end subroutine column_ridging - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_biogeochemistry -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 19th October 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_biogeochemistry(domain) - - use ice_colpkg, only: & - colpkg_biogeochemistry, & - colpkg_init_OceanConcArray, & - colpkg_clear_warnings - - use seaice_constants, only: & - seaicePuny - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - biogeochemistry, & - diagnostics_biogeochemistry, & - icestate, & - tracers, & - shortwave, & - melt_growth_rates, & - ocean_coupling, & - atmos_coupling, & - initial - - ! configs - real(kind=RKIND), pointer :: & - config_dt - - logical, pointer :: & - config_use_brine, & - config_use_skeletal_biochemistry, & - config_use_column_biogeochemistry, & - config_use_zaerosols, & - config_use_vertical_tracers - - ! dimensions - integer, pointer :: & - nCellsSolve, & - nCategories, & - nIceLayers, & - nSnowLayers, & - nzAerosols, & - nBioLayers, & - nBioLayersP1, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nZBGCTracers, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - maxBCType, & - maxDustType, & - maxAerosolType - - ! variables - - real(kind=RKIND), dimension(:), pointer :: & - rayleighCriteriaReal, & - netNitrateUptake, & - netAmmoniumUptake, & - totalVerticalSalinity, & - netSpecificAlgalGrowthRate, & - primaryProduction, & - netBrineHeight, & - biologyGrid, & - interfaceBiologyGrid, & - interfaceGrid, & - verticalGrid, & - seaSurfaceTemperature, & - seaSurfaceSalinity, & - seaFreezingTemperature, & - snowfallRate, & - zSalinityFlux, & - zSalinityGDFlux, & - oceanMixedLayerDepth, & - totalSkeletalAlgae, & - oceanNitrateConc, & - oceanSilicateConc, & - oceanAmmoniumConc, & - oceanDMSConc, & - oceanDMSPConc, & - oceanHumicsConc, & - openWaterArea, & - totalChlorophyll - - real(kind=RKIND), dimension(:,:), pointer :: & - iceAreaCategoryInitial, & - iceVolumeCategoryInitial, & - snowVolumeCategoryInitial, & - iceThicknessCategoryInitial, & !icestate - brineBottomChange, & - brineTopChange, & - darcyVelocityBio, & - snowIceBioFluxes, & - atmosIceBioFluxes, & - oceanBioConcentrations, & - oceanBioConcentrationsInUse, & - totalVerticalBiologyIce, & - totalVerticalBiologySnow, & - penetratingShortwaveFlux, & - zSalinityIceDensity, & - basalIceMeltCategory, & - surfaceIceMeltCategory, & - congelationCategory, & - snowiceFormationCategory, & - snowMeltCategory, & - initialSalinityProfile, & - atmosBioFluxes, & - atmosBlackCarbonFlux, & - atmosDustFlux, & - oceanBioFluxes, & - oceanAlgaeConc, & - oceanDOCConc, & - oceanDICConc, & - oceanDONConc, & - oceanParticulateIronConc, & - oceanDissolvedIronConc, & - oceanZAerosolConc, & - bioShortwaveFluxCell - - real(kind=RKIND), dimension(:,:,:), pointer :: & - shortwaveLayerPenetration, & - verticalNitrogenLosses, & - bioPorosity, & - bioTemperature, & - bioDiffusivity, & - bioPermeability, & - bioShortwaveFlux, & - iceAreaCategory, & ! tracers (1,ncat,ncell) - iceVolumeCategory, & ! tracers (1,ncat,ncell) - snowVolumeCategory, & ! tracers (1,ncat,ncell) - skeletalAlgaeConc, & - oceanBioFluxesCategory, & - brineFraction - - real(kind=RKIND), dimension(:,:), pointer :: & - bgridTemperatureIceCell, & - bgridSalinityIceCell, & - bgridPorosityIceCell - - integer, dimension(:,:), pointer :: & - newlyFormedIce - - integer, dimension(:), pointer :: & - indexToCellID - - ! local - integer :: & - iCell, & - iTracers, & - iBioTracers, & - iCategory, & - iAlgae, & - iBioData, & - iBioCount, & - iSnowCount, & - iIceCount, & - indexj, & - iBioLayers - - ! test carbon conservation - real(kind=RKIND), dimension(:,:), allocatable :: & - totalCarbonCatFinal, & - totalCarbonCatInitial, & - totalCarbonCatFlux, & - brineHeightCatInitial, & - brineHeightCatFinal - - real(kind=RKIND), dimension(:), allocatable :: & - totalCarbonFinal, & - totalCarbonInitial, & - totalCarbonFlux, & - carbonError - - real(kind=RKIND):: & - errorCheck - - logical, dimension(:), allocatable :: & - newlyFormedIceLogical - - logical :: & - abortFlag, & - rayleighCriteria, & - setGetPhysicsTracers, & - setGetBGCTracers, & - checkCarbon - - character(len=strKIND) :: & - abortMessage, & - abortLocation - - real(kind=RKIND), parameter :: & - accuracy = 1.0e-13_RKIND - - ! test carbon conservation - checkCarbon = .false. - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "icestate", icestate) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "diagnostics_biogeochemistry", diagnostics_biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmos_coupling) - call MPAS_pool_get_subpool(block % structs, "melt_growth_rates", melt_growth_rates) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - call MPAS_pool_get_subpool(block % structs, "initial", initial) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(mesh, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(mesh, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(mesh, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(mesh, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(mesh, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(mesh, "nDOC", nDOC) - call MPAS_pool_get_dimension(mesh, "nDIC", nDIC) - call MPAS_pool_get_dimension(mesh, "nDON", nDON) - call MPAS_pool_get_dimension(mesh, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(mesh, "nDissolvedIron", nDissolvedIron) - call MPAS_pool_get_dimension(mesh, "nZBGCTracers", nZBGCTracers) - call MPAS_pool_get_dimension(mesh, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(mesh, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(mesh, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(mesh, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(mesh, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(mesh, "maxIronType", maxIronType) - call MPAS_pool_get_dimension(mesh, "maxBCType", maxBCType) - call MPAS_pool_get_dimension(mesh, "maxDustType", maxDustType) - - call MPAS_pool_get_array(mesh, "indexToCellID", indexToCellID) - - call MPAS_pool_get_config(block % configs, "config_dt", config_dt) - call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers",config_use_vertical_tracers) - - call MPAS_pool_get_array(biogeochemistry, "newlyFormedIce", newlyFormedIce) - call MPAS_pool_get_array(biogeochemistry, "netNitrateUptake", netNitrateUptake) - call MPAS_pool_get_array(biogeochemistry, "netAmmoniumUptake", netAmmoniumUptake) - call MPAS_pool_get_array(biogeochemistry, "totalVerticalSalinity", totalVerticalSalinity) - call MPAS_pool_get_array(biogeochemistry, "totalChlorophyll", totalChlorophyll) - call MPAS_pool_get_array(biogeochemistry, "netSpecificAlgalGrowthRate", netSpecificAlgalGrowthRate) - call MPAS_pool_get_array(biogeochemistry, "primaryProduction", primaryProduction) - call MPAS_pool_get_array(biogeochemistry, "netBrineHeight", netBrineHeight) - call MPAS_pool_get_array(biogeochemistry, "brineBottomChange", brineBottomChange) - call MPAS_pool_get_array(biogeochemistry, "brineTopChange", brineTopChange) - call MPAS_pool_get_array(biogeochemistry, "bioPorosity", bioPorosity) - call MPAS_pool_get_array(biogeochemistry, "rayleighCriteriaReal", rayleighCriteriaReal) - call MPAS_pool_get_array(biogeochemistry, "biologyGrid", biologyGrid) - call MPAS_pool_get_array(biogeochemistry, "interfaceBiologyGrid", interfaceBiologyGrid) - call MPAS_pool_get_array(biogeochemistry, "interfaceGrid", interfaceGrid) - call MPAS_pool_get_array(biogeochemistry, "verticalGrid", verticalGrid) - call MPAS_pool_get_array(biogeochemistry, "bioDiffusivity", bioDiffusivity) - call MPAS_pool_get_array(biogeochemistry, "bioPermeability", bioPermeability) - call MPAS_pool_get_array(biogeochemistry, "bioShortwaveFlux", bioShortwaveFlux) - call MPAS_pool_get_array(biogeochemistry, "bioShortwaveFluxCell", bioShortwaveFluxCell) - call MPAS_pool_get_array(biogeochemistry, "darcyVelocityBio", darcyVelocityBio) - call MPAS_pool_get_array(biogeochemistry, "snowIceBioFluxes", snowIceBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "atmosIceBioFluxes", atmosIceBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "oceanBioConcentrations", oceanBioConcentrations) - call MPAS_pool_get_array(biogeochemistry, "oceanBioConcentrationsInUse", oceanBioConcentrationsInUse) - call MPAS_pool_get_array(biogeochemistry, "totalVerticalBiologyIce", totalVerticalBiologyIce) - call MPAS_pool_get_array(biogeochemistry, "totalVerticalBiologySnow", totalVerticalBiologySnow) - call MPAS_pool_get_array(biogeochemistry, "zSalinityIceDensity", zSalinityIceDensity) - call MPAS_pool_get_array(biogeochemistry, "zSalinityFlux", zSalinityFlux) - call MPAS_pool_get_array(biogeochemistry, "zSalinityGDFlux", zSalinityGDFlux) - call MPAS_pool_get_array(biogeochemistry, "atmosBioFluxes", atmosBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "atmosBlackCarbonFlux", atmosBlackCarbonFlux) - call MPAS_pool_get_array(biogeochemistry, "atmosDustFlux", atmosDustFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanBioFluxes", oceanBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "oceanBioFluxesCategory", oceanBioFluxesCategory) - call MPAS_pool_get_array(biogeochemistry, "verticalNitrogenLosses", verticalNitrogenLosses) - call MPAS_pool_get_array(biogeochemistry, "bioTemperature", bioTemperature) - call MPAS_pool_get_array(biogeochemistry, "totalSkeletalAlgae", totalSkeletalAlgae) - call MPAS_pool_get_array(biogeochemistry, "oceanAlgaeConc",oceanAlgaeConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDOCConc",oceanDOCConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDICConc",oceanDICConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDONConc",oceanDONConc) - call MPAS_pool_get_array(biogeochemistry, "oceanParticulateIronConc",oceanParticulateIronConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDissolvedIronConc",oceanDissolvedIronConc) - call MPAS_pool_get_array(biogeochemistry, "oceanNitrateConc",oceanNitrateConc) - call MPAS_pool_get_array(biogeochemistry, "oceanSilicateConc",oceanSilicateConc) - call MPAS_pool_get_array(biogeochemistry, "oceanAmmoniumConc",oceanAmmoniumConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSConc",oceanDMSConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPConc",oceanDMSPConc) - call MPAS_pool_get_array(biogeochemistry, "oceanHumicsConc",oceanHumicsConc) - call MPAS_pool_get_array(biogeochemistry, "oceanZAerosolConc",oceanZAerosolConc) - - call MPAS_pool_get_array(diagnostics_biogeochemistry, "bgridPorosityIceCell",bgridPorosityIceCell) - call MPAS_pool_get_array(diagnostics_biogeochemistry, "bgridSalinityIceCell",bgridSalinityIceCell) - call MPAS_pool_get_array(diagnostics_biogeochemistry, "bgridTemperatureIceCell",bgridTemperatureIceCell) - - call MPAS_pool_get_array(ocean_coupling, "seaSurfaceTemperature", seaSurfaceTemperature) - call MPAS_pool_get_array(ocean_coupling, "seaSurfaceSalinity", seaSurfaceSalinity) - call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - call MPAS_pool_get_array(ocean_coupling, "oceanMixedLayerDepth", oceanMixedLayerDepth) - - call MPAS_pool_get_array(atmos_coupling, "snowfallRate", snowfallRate) - - call MPAS_pool_get_array(icestate, "iceAreaCategoryInitial", iceAreaCategoryInitial) - call MPAS_pool_get_array(icestate, "iceVolumeCategoryInitial", iceVolumeCategoryInitial) - call MPAS_pool_get_array(icestate, "snowVolumeCategoryInitial", snowVolumeCategoryInitial) - call MPAS_pool_get_array(icestate, "iceThicknessCategoryInitial", iceThicknessCategoryInitial) - call MPAS_pool_get_array(icestate, "openWaterArea", openWaterArea) - - call MPAS_pool_get_array(shortwave, "penetratingShortwaveFlux", penetratingShortwaveFlux) - call MPAS_pool_get_array(shortwave, "shortwaveLayerPenetration", shortwaveLayerPenetration) - - call MPAS_pool_get_array(melt_growth_rates, "basalIceMeltCategory", basalIceMeltCategory) - call MPAS_pool_get_array(melt_growth_rates, "surfaceIceMeltCategory", surfaceIceMeltCategory) - call MPAS_pool_get_array(melt_growth_rates, "congelationCategory", congelationCategory) - call MPAS_pool_get_array(melt_growth_rates, "snowiceFormationCategory", snowiceFormationCategory) - call MPAS_pool_get_array(melt_growth_rates, "snowMeltCategory", snowMeltCategory) - - call MPAS_pool_get_array(initial,"initialSalinityProfile",initialSalinityProfile) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "skeletalAlgaeConc", skeletalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - - ! newly formed ice - allocate(newlyFormedIceLogical(nCategories)) - allocate(brineHeightCatInitial(nCategories,nCellsSolve)) - allocate(carbonError(nCellsSolve)) - - if (checkCarbon) then - allocate(totalCarbonCatFinal(nCategories,nCellsSolve)) - allocate(totalCarbonCatInitial(nCategories,nCellsSolve)) - allocate(totalCarbonCatFlux(nCategories,nCellsSolve)) - allocate(brineHeightCatFinal(nCategories,nCellsSolve)) - allocate(totalCarbonFinal(nCellsSolve)) - allocate(totalCarbonInitial(nCellsSolve)) - allocate(totalCarbonFlux(nCellsSolve)) - else - allocate(totalCarbonCatFinal(1,1)) - allocate(totalCarbonCatInitial(1,1)) - allocate(totalCarbonCatFlux(1,1)) - allocate(brineHeightCatFinal(1,1)) - allocate(totalCarbonFinal(1)) - allocate(totalCarbonInitial(1)) - allocate(totalCarbonFlux(1)) - endif - - brineHeightCatInitial(:,:) = 0.0_RKIND - carbonError(:) = 0.0_RKIND - totalCarbonCatFinal(:,:) = 0.0_RKIND - totalCarbonCatInitial(:,:) = 0.0_RKIND - totalCarbonCatFlux(:,:) = 0.0_RKIND - brineHeightCatFinal(:,:) = 0.0_RKIND - totalCarbonFinal(:) = 0.0_RKIND - totalCarbonInitial(:) = 0.0_RKIND - totalCarbonFlux(:) = 0.0_RKIND - - setGetPhysicsTracers = .true. - setGetBGCTracers = (config_use_column_biogeochemistry .or. config_use_zaerosols) - - ! code abort - abortFlag = .false. - abortMessage = "" - - atmosBioFluxes(:,:) = 0.0_RKIND - oceanBioConcentrationsInUse(:,:) = 0.0_RKIND - - !$offomp parallel do default(shared) private(iCategory,iBioTracers,iAlgae, iBioLayers) & - !$offomp& firstprivate(atmosBioFluxes,atmosBlackCarbonFlux, & - !$offomp& totalCarbonCatInitial, totalCarbonCatFinal, & - !$offomp& totalCarbonInitial, totalCarbonFinal, totalCarbonFlux, & - !$offomp& atmosDustFlux, bioShortwaveFluxCell, newlyFormedIce) - ! - do iCell = 1, nCellsSolve - ! newly formed ice - do iCategory = 1, nCategories - newlyFormedIceLogical(iCategory) = (newlyFormedIce(iCategory,iCell) == 1) - brineHeightCatInitial(iCategory,iCell) = brineFraction(1,iCategory,iCell) * & - iceVolumeCategoryInitial(iCategory,iCell)/(iceAreaCategoryInitial(iCategory,iCell) + seaicePuny) - enddo ! iCategory - rayleighCriteria = (rayleighCriteriaReal(iCell) > 0.5_RKIND) - - !update ocean concentrations fields and atmospheric fluxes into allocated array -#ifdef coupled - call colpkg_init_OceanConcArray(& - nZBGCTracers, & - maxAlgaeType, & - maxDONType, & - maxDOCType, & - maxDICType, & - maxAerosolType, & - maxIronType, & - oceanNitrateConc(iCell), & - oceanAmmoniumConc(iCell), & - oceanSilicateConc(iCell),& - oceanDMSPConc(iCell), & - oceanDMSConc(iCell), & - oceanAlgaeConc(:,iCell), & - oceanDOCConc(:,iCell), & - oceanDONConc(:,iCell), & - oceanDICConc(:,iCell), & - oceanDissolvedIronConc(:,iCell), & - oceanParticulateIronConc(:,iCell), & - oceanZAerosolConc(:,iCell), & - oceanBioConcentrations(:,iCell), & - oceanHumicsConc(iCell)) -#else - do iBioTracers = 1, maxBCType - atmosBlackCarbonFlux(iBioTracers,iCell) = 1.e-12_RKIND - enddo - do iBioTracers = 1, maxDustType - atmosDustFlux(iBioTracers,iCell) = 1.e-13_RKIND - enddo -#endif - if (config_use_zaerosols) then - indexj = ciceTracerObject % index_verticalAerosolsConcLayer(1) - do iBioTracers = 1, maxBCType - atmosBioFluxes(indexj -1 + iBioTracers,iCell) = atmosBlackCarbonFlux(iBioTracers,iCell) - enddo - do iBioTracers = maxBCType + 1, nzAerosols - atmosBioFluxes(indexj -1 + iBioTracers, iCell) = atmosDustFlux(iBioTracers-maxBCType,iCell) - enddo - endif - - do iBioTracers = 1, ciceTracerObject % nBioTracers - iBioData = ciceTracerObject % index_LayerIndexToDataArray(iBioTracers) - oceanBioConcentrationsInUse(iBioTracers,iCell) = oceanBioConcentrations(iBioData,iCell) - enddo ! iBioTracers - - call set_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (checkCarbon) then - call seaice_total_carbon_content_category(block,& - totalCarbonCatInitial(:,iCell),iceAreaCategoryInitial(:,:),iceVolumeCategoryInitial(:,:),iCell) - totalCarbonInitial(iCell) = 0.0_RKIND - do iCategory = 1, nCategories - totalCarbonInitial(iCell) = totalCarbonInitial(iCell) + totalCarbonCatInitial(iCategory,iCell)*iceAreaCategoryInitial(iCategory,iCell) - enddo - endif - - call colpkg_clear_warnings() - call colpkg_biogeochemistry(& - config_dt, & - ciceTracerObject % nTracers, & - ciceTracerObject % nBioTracers, & - netNitrateUptake(iCell), & - netAmmoniumUptake(iCell), & - bioDiffusivity(:,:,iCell), & - bioPermeability(:,:,iCell), & - bioShortwaveFlux(:,:,iCell), & - totalVerticalSalinity(iCell), & - darcyVelocityBio(:,iCell), & - netSpecificAlgalGrowthRate(iCell), & - primaryProduction(iCell), & - netBrineHeight(iCell), & - brineBottomChange(:,iCell), & - brineTopChange(:,iCell), & - verticalNitrogenLosses(:,:,iCell), & - snowIceBioFluxes(:,iCell), & - atmosIceBioFluxes(:,iCell), & - oceanBioConcentrationsInUse(:,iCell), & - newlyFormedIceLogical(:), & - shortwaveLayerPenetration(:,:,iCell), & - bioPorosity(:,:,iCell), & - bioTemperature(:,:,iCell), & - totalVerticalBiologyIce(:,iCell), & - totalVerticalBiologySnow(:,iCell), & - totalChlorophyll(iCell), & - penetratingShortwaveFlux(:,iCell), & - rayleighCriteria, & - zSalinityIceDensity(:,iCell), & - zSalinityFlux(iCell), & - zSalinityGDFlux(iCell), & - biologyGrid, & - interfaceBiologyGrid, & - interfaceGrid, & - verticalGrid, & - nBioLayers, & - nIceLayers, & - nSnowLayers, & - nAlgae, & - nzAerosols, & - nCategories, & - nDOC, & - nDIC, & - nDON, & - nDissolvedIron, & - nParticulateIron, & - basalIceMeltCategory(:,iCell), & - surfaceIceMeltCategory(:,iCell), & - congelationCategory(:,iCell), & - snowiceFormationCategory(:,iCell), & - seaSurfaceTemperature(iCell), & - seaSurfaceSalinity(iCell), & - seaFreezingTemperature(iCell), & - snowfallRate(iCell), & - snowMeltCategory(:,iCell), & - oceanMixedLayerDepth(iCell), & - initialSalinityProfile(:,iCell), & - iceThicknessCategoryInitial(:,iCell), & - oceanBioFluxes(:,iCell), & - atmosBioFluxes(:,iCell), & - iceAreaCategoryInitial(:,iCell), & - iceVolumeCategoryInitial(:,iCell), & - iceAreaCategory(1,:,iCell), & - iceVolumeCategory(1,:,iCell), & - snowVolumeCategory(1,:,iCell), & - openWaterArea(iCell), & - tracerArrayCategory, & - snowVolumeCategoryInitial(:,iCell), & - config_use_skeletal_biochemistry, & - maxAlgaeType, & - nZBGCTracers, & - oceanBioFluxesCategory(:,:,iCell), & - bgridPorosityIceCell(:,iCell), & - bgridSalinityIceCell(:,iCell), & - bgridTemperatureIceCell(:,iCell), & - abortFlag, & - abortMessage) - call column_write_warnings(abortFlag) - - call get_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (checkCarbon) then - call seaice_total_carbon_content_category(block,totalCarbonCatFinal(:,iCell),iceAreaCategory(1,:,:),iceVolumeCategory(1,:,:),iCell) - call seaice_ocean_carbon_flux(block,totalCarbonCatFlux(:,iCell),oceanBioFluxesCategory(:,:,:),iCell) - totalCarbonFinal(iCell) = 0.0_RKIND - totalCarbonFlux(iCell) = 0.0_RKIND - do iCategory = 1, nCategories - totalCarbonFinal(iCell) = totalCarbonFinal(iCell) + totalCarbonCatFinal(iCategory,iCell)*iceAreaCategory(1,iCategory,iCell) - totalCarbonFlux(iCell) = totalCarbonFlux(iCell) + totalCarbonCatFlux(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - enddo - carbonError(iCell) = (totalCarbonFinal(iCell) - totalCarbonInitial(iCell))/config_dt + totalCarbonFlux(iCell) - errorCheck = MAX(accuracy,accuracy*abs(totalCarbonFlux(iCell))) - - if (abs(carbonError(iCell)) > errorCheck) then - do iCategory = 1,nCategories - if (iceAreaCategory(1,iCategory,iCell) > seaicePuny) then - brineHeightCatFinal(iCategory,iCell) = brineFraction(1,iCategory,iCell) * & - iceVolumeCategory(1,iCategory,iCell)/(iceAreaCategory(1,iCategory,iCell) + seaicePuny) - call mpas_log_write("column_biogeochemistry, carbon conservation error", messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - call mpas_log_write("iCategory: $i", messageType=MPAS_LOG_ERR, intArgs=(/iCategory/)) - call mpas_log_write("carbonError: $r", messageType=MPAS_LOG_ERR, realArgs=(/carbonError(iCell)/)) - call mpas_log_write("carbonError*iceAreaCategory: $r", messageType=MPAS_LOG_ERR, realArgs=(/carbonError(iCell)*iceAreaCategory(1,iCategory,iCell)/)) - call mpas_log_write("iceAreaCategory: $r", messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCategory(1,iCategory,iCell)/)) - call mpas_log_write("iceAreaCategoryInitial: $r", messageType=MPAS_LOG_ERR, realArgs=(/iceAreaCategoryInitial(iCategory,iCell)/)) - call mpas_log_write("totalCarbonCatInitial(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatInitial(iCategory,iCell)/)) - call mpas_log_write("totalCarbonCatFinal(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatFinal(iCategory,iCell)/)) - call mpas_log_write("totalCarbonCatFlux(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/totalCarbonCatFlux(iCategory,iCell)/)) - call mpas_log_write("brineHeightCatInitial(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/brineHeightCatInitial(iCategory,iCell)/)) - call mpas_log_write("brineHeightCatFinal(iCategory,iCell): $r", messageType=MPAS_LOG_ERR, realArgs=(/brineHeightCatFinal(iCategory,iCell)/)) - endif - enddo - endif !carbonError - - endif - ! code abort - if (abortFlag) then - call mpas_log_write("column_biogeochemistry: "//trim(abortMessage) , messageType=MPAS_LOG_ERR) - call mpas_log_write("iCell: $i", messageType=MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/)) - endif - - totalSkeletalAlgae(iCell) = 0.0_RKIND - bioShortwaveFluxCell(:,iCell) = 0.0_RKIND - - do iCategory = 1, nCategories - if (config_use_skeletal_biochemistry .and. iceAreaCategory(1,iCategory,iCell) > seaicePuny) then - do iAlgae = 1, nAlgae - totalSkeletalAlgae(iCell) = totalSkeletalAlgae(iCell) + & - skeletalAlgaeConc(iAlgae,iCategory,iCell) * & - iceAreaCategory(1,iCategory,iCell) - enddo - endif - if (config_use_vertical_tracers) then - do iBioLayers = 1, nBioLayersP1 - bioShortwaveFluxCell(iBioLayers,iCell) = bioShortwaveFluxCell(iBioLayers,iCell) + & - bioShortwaveFlux(iBioLayers,iCategory,iCell) * & - iceAreaCategory(1,iCategory,iCell) - enddo - endif - newlyFormedIce(iCategory,iCell) = 0 - if (newlyFormedIceLogical(iCategory)) newlyFormedIce(iCategory,iCell) = 1 - enddo ! iCategory - - if (.not. rayleighCriteria) rayleighCriteriaReal(iCell) = 0.0_RKIND - - enddo ! iCell - - ! code abort - call seaice_critical_error_write_block(domain, block, abortFlag) - call seaice_check_critical_error(domain, abortFlag) - - deallocate(totalCarbonCatFinal) - deallocate(totalCarbonCatInitial) - deallocate(totalCarbonCatFlux) - deallocate(brineHeightCatFinal) - deallocate(totalCarbonFinal) - deallocate(totalCarbonInitial) - deallocate(totalCarbonFlux) - - deallocate(brineHeightCatInitial) - deallocate(newlyFormedIceLogical) - deallocate(carbonError) - - block => block % next - end do - - end subroutine column_biogeochemistry - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_day_of_year -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 20th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_day_of_year(clock, dayOfYear) - - type(MPAS_clock_type), intent(in) :: & - clock - - real(kind=RKIND), intent(out) :: & - dayOfYear - - type(MPAS_Time_type) :: & - currentTime - - integer :: & - dayOfYearInt, & - ierr - - currentTime = MPAS_get_clock_time(clock, MPAS_NOW, ierr=ierr) - - call MPAS_get_time(currentTime, DoY=dayOfYearInt, ierr=ierr) - - dayOfYear = real(dayOfYearInt, RKIND) - - end subroutine get_day_of_year - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_seconds_into_day -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_seconds_into_day(clock, secondsIntoDay) - - type(MPAS_clock_type), intent(in) :: & - clock - - integer, intent(out) :: & - secondsIntoDay - - type(MPAS_Time_type) :: & - currentTime - - integer :: & - ierr, & - hours, & - minutes, & - seconds - - currentTime = MPAS_get_clock_time(clock, MPAS_NOW, ierr=ierr) - - call MPAS_get_time(currentTime, H=hours, M=minutes, S=seconds, ierr=ierr) - - secondsIntoDay = hours * 3600 + minutes * 60 + seconds - - end subroutine get_seconds_into_day - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_days_in_year -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_days_in_year(domain, clock, daysInYear) - - type(domain_type), intent(in) :: domain - - type(MPAS_clock_type), intent(in) :: & - clock - - integer, intent(out) :: & - daysInYear - - type(MPAS_Time_type) :: & - currentTime - - character(len=strKIND), pointer :: & - config_calendar_type - - integer :: & - ierr, & - year - - currentTime = MPAS_get_clock_time(clock, MPAS_NOW, ierr=ierr) - - call MPAS_get_time(currentTime, YYYY=year, ierr=ierr) - - call MPAS_pool_get_config(domain % configs, "config_calendar_type", config_calendar_type) - - select case (trim(config_calendar_type)) - case ("gregorian") - if (isLeapYear(Year)) then - daysInYear = sum(daysInMonthLeap) - else - daysInYear = sum(daysInMonth) - endif - case ("noleap") - daysInYear = sum(daysInMonth) - end select - - end subroutine get_days_in_year - -!----------------------------------------------------------------------- -! Other routines -!----------------------------------------------------------------------- - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_update_state -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 31st March 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_update_state(domain, stateUpdateType, dt, iceAgeTimeOffset) - - type(domain_type), intent(inout) :: domain - - character(len=*), intent(in) :: & - stateUpdateType - - real(kind=RKIND), intent(in) :: & - dt, & - iceAgeTimeOffset - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - tracers_aggregate, & - diagnostics - - real(kind=RKIND), dimension(:), pointer :: & - iceAreaCell, & - iceVolumeCell, & - iceAgeCell, & - iceAreaTendency, & - iceVolumeTendency, & - iceAgeTendency - - integer, pointer :: & - nCellsSolve - - integer :: & - iCell - - logical, pointer :: & - config_use_ice_age - - ! aggregate state variables - call mpas_timer_start("Column aggregate") - call seaice_column_aggregate(domain) - call mpas_timer_stop("Column aggregate") - - ! get configs - call MPAS_pool_get_config(domain % blocklist % configs, "config_use_ice_age", config_use_ice_age) - - ! compute thermodynamic area and volume tendencies - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "diagnostics", diagnostics) - - call MPAS_pool_get_dimension(tracers_aggregate, "nCellsSolve", nCellsSolve) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "iceVolumeCell", iceVolumeCell) - call MPAS_pool_get_array(tracers_aggregate, "iceAgeCell", iceAgeCell) - - if (trim(stateUpdateType) == "transport") then - - call MPAS_pool_get_array(diagnostics, "iceAreaTendencyTransport", iceAreaTendency) - call MPAS_pool_get_array(diagnostics, "iceVolumeTendencyTransport", iceVolumeTendency) - call MPAS_pool_get_array(diagnostics, "iceAgeTendencyTransport", iceAgeTendency) - - else if (trim(stateUpdateType) == "thermodynamics") then - - call MPAS_pool_get_array(diagnostics, "iceAreaTendencyThermodynamics", iceAreaTendency) - call MPAS_pool_get_array(diagnostics, "iceVolumeTendencyThermodynamics", iceVolumeTendency) - call MPAS_pool_get_array(diagnostics, "iceAgeTendencyThermodynamics", iceAgeTendency) - - else - - call mpas_log_write("seaice_column_update_state: Unknown update type: "//trim(stateUpdateType), messageType=MPAS_LOG_CRIT) - - endif - - do iCell = 1, nCellsSolve - - iceAreaTendency(iCell) = (iceAreaCell(iCell) - iceAreaTendency(iCell)) / dt - iceVolumeTendency(iCell) = (iceVolumeCell(iCell) - iceVolumeTendency(iCell)) / dt - - if (config_use_ice_age) then - if (iceAgeTimeOffset > 0.0_RKIND) then - - if (iceAgeCell(iCell) > 0.0_RKIND) & - iceAgeTendency(iCell) = & - (iceAgeCell(iCell) - iceAgeTendency(iCell) - iceAgeTimeOffset) / dt - - else - - iceAgeTendency(iCell) = & - (iceAgeCell(iCell) - iceAgeTendency(iCell)) / dt - - endif - endif - - enddo ! iCell - - block => block % next - enddo - - end subroutine seaice_column_update_state - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_aggregate -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th March 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_aggregate(domain) - - use ice_colpkg, only: colpkg_aggregate - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - tracers_aggregate, & - icestate, & - ocean_coupling - - logical, pointer :: & - config_use_column_biogeochemistry, & - config_use_zaerosols - - real(kind=RKIND), dimension(:), pointer :: & - iceAreaCell, & - iceVolumeCell, & - snowVolumeCell, & - openWaterArea, & - seaFreezingTemperature - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - iceVolumeCategory, & - snowVolumeCategory - - integer :: & - iCell - - integer, pointer :: & - nCellsSolve, & - nCategories - - logical :: & - setGetPhysicsTracers, & - setGetBGCTracers - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "icestate", icestate) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols", config_use_zaerosols) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "iceVolumeCell", iceVolumeCell) - call MPAS_pool_get_array(tracers_aggregate, "snowVolumeCell", snowVolumeCell) - - call MPAS_pool_get_array(icestate, "openWaterArea", openWaterArea) - - call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - - setGetPhysicsTracers = .true. - setGetBGCTracers = (config_use_column_biogeochemistry .or. config_use_zaerosols) - - do iCell = 1, nCellsSolve - - ! set the category tracer array - call set_cice_tracer_array_category(block, ciceTracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - call colpkg_aggregate(& - nCategories, & - seaFreezingTemperature(iCell), & - iceAreaCategory(1,:,iCell), & - tracerArrayCategory, & ! trcrn - iceVolumeCategory(1,:,iCell), & - snowVolumeCategory(1,:,iCell), & - iceAreaCell(iCell), & - tracerArrayCell, & ! trcr - iceVolumeCell(iCell), & - snowVolumeCell(iCell), & - openWaterArea(iCell), & - ciceTracerObject % nTracers, & - ciceTracerObject % parentIndex, & ! trcr_depend - ciceTracerObject % firstAncestorMask, & ! trcr_base - ciceTracerObject % ancestorNumber, & ! n_trcr_strata - ciceTracerObject % ancestorIndices) ! nt_strata - - ! set the cell tracer array - call get_cice_tracer_array_cell(block, ciceTracerObject, & - tracerArrayCell, iCell, setGetPhysicsTracers, setGetBGCTracers) - - enddo ! iCell - - block => block % next - end do - - end subroutine seaice_column_aggregate - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_aggregate_simple -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 29th August 2021 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_aggregate_simple(domain) - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers, & - tracers_aggregate, & - icestate - - real(kind=RKIND), dimension(:), pointer :: & - iceAreaCell, & - iceVolumeCell, & - snowVolumeCell, & - openWaterArea - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory, & - iceVolumeCategory, & - snowVolumeCategory - - integer :: & - iCell, & - iCategory - - integer, pointer :: & - nCellsSolve, & - nCategories - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "icestate", icestate) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - call MPAS_pool_get_array(tracers, "iceVolumeCategory", iceVolumeCategory, 1) - call MPAS_pool_get_array(tracers, "snowVolumeCategory", snowVolumeCategory, 1) - - call MPAS_pool_get_array(tracers_aggregate, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "iceVolumeCell", iceVolumeCell) - call MPAS_pool_get_array(tracers_aggregate, "snowVolumeCell", snowVolumeCell) - - call MPAS_pool_get_array(icestate, "openWaterArea", openWaterArea) - - do iCell = 1, nCellsSolve - - iceAreaCell(iCell) = 0.0_RKIND - iceVolumeCell(iCell) = 0.0_RKIND - - do iCategory = 1, nCategories - - iceAreaCell(iCell) = iceAreaCell(iCell) + iceAreaCategory(1,iCategory,iCell) - iceVolumeCell(iCell) = iceVolumeCell(iCell) + iceVolumeCategory(1,iCategory,iCell) - - enddo ! iCategory - - openWaterArea(iCell) = 1.0_RKIND - iceAreaCell(iCell) - - enddo ! iCell - - block => block % next - end do - - end subroutine seaice_column_aggregate_simple - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_coupling_prep -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th April -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_coupling_prep(domain) - - use seaice_constants, only: & - seaicePuny, & - seaiceDensityFreshwater - - type(domain_type) :: domain - - type(block_type), pointer :: block - - logical, pointer :: & - config_use_ocean_mixed_layer, & - config_include_pond_freshwater_feedback, & - config_use_column_biogeochemistry, & - config_use_zaerosols - - type(MPAS_pool_type), pointer :: & - oceanCoupling, & - diagnostics, & - shortwave, & - atmosCoupling, & - tracers, & - ponds, & - oceanFluxes, & - biogeochemistry, & - mesh - - real(kind=RKIND), dimension(:), pointer :: & - freezingMeltingPotential, & - freezingMeltingPotentialInitial, & - albedoVisibleDirectCell, & - albedoVisibleDiffuseCell, & - albedoIRDirectCell, & - albedoIRDiffuseCell, & - albedoVisibleDirectArea, & - albedoVisibleDiffuseArea, & - albedoIRDirectArea, & - albedoIRDiffuseArea, & - bareIceAlbedoCell, & - snowAlbedoCell, & - pondAlbedoCell, & - solarZenithAngleCosine, & - effectivePondAreaCell, & - shortwaveScalingFactor, & - shortwaveVisibleDirectDown, & - shortwaveVisibleDiffuseDown, & - shortwaveIRDirectDown, & - shortwaveIRDiffuseDown, & - pondFreshWaterFlux, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFlux, & - oceanShortwaveFlux, & - oceanFreshWaterFluxArea, & - oceanSaltFluxArea, & - oceanHeatFluxArea, & - oceanShortwaveFluxArea, & - oceanNitrateFlux, & - oceanSilicateFlux, & - oceanAmmoniumFlux, & - oceanDMSFlux, & - oceanDMSPpFlux, & - oceanDMSPdFlux, & - oceanHumicsFlux, & - oceanDustIronFlux, & - oceanBlackCarbonFlux, & - totalOceanCarbonFlux, & - oceanNitrateFluxArea, & - oceanSilicateFluxArea, & - oceanAmmoniumFluxArea, & - oceanDMSFluxArea, & - oceanDMSPpFluxArea, & - oceanDMSPdFluxArea, & - oceanHumicsFluxArea, & - oceanDustIronFluxArea, & - oceanBlackCarbonFluxArea - - real(kind=RKIND), dimension(:,:), pointer :: & - albedoVisibleDirectCategory, & - albedoVisibleDiffuseCategory, & - albedoIRDirectCategory, & - albedoIRDiffuseCategory, & - bareIceAlbedoCategory, & - snowAlbedoCategory, & - pondAlbedoCategory, & - effectivePondAreaCategory, & - oceanBioFluxes, & - oceanAlgaeFlux, & - oceanDOCFlux, & - oceanDICFlux, & - oceanDONFlux, & - oceanParticulateIronFlux, & - oceanDissolvedIronFlux, & - oceanAlgaeFluxArea, & - oceanDOCFluxArea, & - oceanDICFluxArea, & - oceanDONFluxArea, & - oceanParticulateIronFluxArea, & - oceanDissolvedIronFluxArea - - real(kind=RKIND), dimension(:,:,:), pointer :: & - iceAreaCategory - - real(kind=RKIND), pointer :: & - config_dt - - real(kind=RKIND), pointer :: & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_C_to_N_proteins - - integer, pointer :: & - nCellsSolve, & - nCategories, & - nZBGCTracers, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - maxBCType, & - maxDustType, & - maxAerosolType - - integer :: & - iCell, & - iCategory, & - iBioTracers, & - iBioData - - real(kind=RKIND), dimension(:), allocatable :: & - ratio_C_to_N - - real(kind=RKIND), dimension(:), allocatable :: & - oceanBioFluxesAll - - call MPAS_pool_get_config(domain % configs, "config_use_ocean_mixed_layer", config_use_ocean_mixed_layer) - call MPAS_pool_get_config(domain % configs, "config_dt", config_dt) - call MPAS_pool_get_config(domain % configs, "config_include_pond_freshwater_feedback", config_include_pond_freshwater_feedback) - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_diatoms", config_ratio_C_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_small_plankton", config_ratio_C_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_phaeocystis", config_ratio_C_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_proteins", config_ratio_C_to_N_proteins) - - if (config_use_ocean_mixed_layer) & - call seaice_column_ocean_mixed_layer(domain) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", oceanCoupling) - call MPAS_pool_get_subpool(block % structs, "diagnostics", diagnostics) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmosCoupling) - call MPAS_pool_get_subpool(block % structs, "ponds", ponds) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", oceanFluxes) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - - call MPAS_pool_get_dimension(tracers, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(tracers, "nCategories", nCategories) - - call MPAS_pool_get_array(oceanCoupling, "freezingMeltingPotential", freezingMeltingPotential) - call MPAS_pool_get_array(diagnostics, "freezingMeltingPotentialInitial", freezingMeltingPotentialInitial) - - call MPAS_pool_get_array(tracers, "iceAreaCategory", iceAreaCategory, 1) - - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectCell", albedoVisibleDirectCell) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseCell", albedoVisibleDiffuseCell) - call MPAS_pool_get_array(shortwave, "albedoIRDirectCell", albedoIRDirectCell) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseCell", albedoIRDiffuseCell) - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectCategory", albedoVisibleDirectCategory) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseCategory", albedoVisibleDiffuseCategory) - call MPAS_pool_get_array(shortwave, "albedoIRDirectCategory", albedoIRDirectCategory) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseCategory", albedoIRDiffuseCategory) - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectArea", albedoVisibleDirectArea) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseArea", albedoVisibleDiffuseArea) - call MPAS_pool_get_array(shortwave, "albedoIRDirectArea", albedoIRDirectArea) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseArea", albedoIRDiffuseArea) - - call MPAS_pool_get_array(shortwave, "solarZenithAngleCosine", solarZenithAngleCosine) - call MPAS_pool_get_array(shortwave, "bareIceAlbedoCell", bareIceAlbedoCell) - call MPAS_pool_get_array(shortwave, "snowAlbedoCell", snowAlbedoCell) - call MPAS_pool_get_array(shortwave, "pondAlbedoCell", pondAlbedoCell) - call MPAS_pool_get_array(shortwave, "bareIceAlbedoCategory", bareIceAlbedoCategory) - call MPAS_pool_get_array(shortwave, "snowAlbedoCategory", snowAlbedoCategory) - call MPAS_pool_get_array(shortwave, "pondAlbedoCategory", pondAlbedoCategory) - - call MPAS_pool_get_array(shortwave, "effectivePondAreaCell", effectivePondAreaCell) - call MPAS_pool_get_array(shortwave, "effectivePondAreaCategory", effectivePondAreaCategory) - - call MPAS_pool_get_array(shortwave, "shortwaveScalingFactor", shortwaveScalingFactor) - - call MPAS_pool_get_array(atmosCoupling, "shortwaveVisibleDirectDown", shortwaveVisibleDirectDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveVisibleDiffuseDown", shortwaveVisibleDiffuseDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveIRDirectDown", shortwaveIRDirectDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveIRDiffuseDown", shortwaveIRDiffuseDown) - - call MPAS_pool_get_array(ponds, "pondFreshWaterFlux", pondFreshWaterFlux) - - call MPAS_pool_get_array(oceanFluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanSaltFlux", oceanSaltFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanHeatFlux", oceanHeatFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanShortwaveFlux", oceanShortwaveFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanFreshWaterFluxArea", oceanFreshWaterFluxArea) - call MPAS_pool_get_array(oceanFluxes, "oceanSaltFluxArea", oceanSaltFluxArea) - call MPAS_pool_get_array(oceanFluxes, "oceanHeatFluxArea", oceanHeatFluxArea) - call MPAS_pool_get_array(oceanFluxes, "oceanShortwaveFluxArea", oceanShortwaveFluxArea) - - call MPAS_pool_get_array(biogeochemistry, "oceanNitrateFlux", oceanNitrateFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanSilicateFlux", oceanSilicateFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanAmmoniumFlux", oceanAmmoniumFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSFlux", oceanDMSFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPpFlux", oceanDMSPpFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPdFlux", oceanDMSPdFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanHumicsFlux", oceanHumicsFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDustIronFlux", oceanDustIronFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanBlackCarbonFlux", oceanBlackCarbonFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanBioFluxes", oceanBioFluxes) - call MPAS_pool_get_array(biogeochemistry, "oceanAlgaeFlux", oceanAlgaeFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDOCFlux", oceanDOCFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDICFlux", oceanDICFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDONFlux", oceanDONFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanParticulateIronFlux", oceanParticulateIronFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDissolvedIronFlux", oceanDissolvedIronFlux) - call MPAS_pool_get_array(biogeochemistry, "totalOceanCarbonFlux", totalOceanCarbonFlux) - - call MPAS_pool_get_array(biogeochemistry, "oceanNitrateFluxArea", oceanNitrateFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanSilicateFluxArea", oceanSilicateFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanAmmoniumFluxArea", oceanAmmoniumFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSFluxArea", oceanDMSFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPpFluxArea", oceanDMSPpFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPdFluxArea", oceanDMSPdFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanHumicsFluxArea", oceanHumicsFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDustIronFluxArea", oceanDustIronFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanBlackCarbonFluxArea", oceanBlackCarbonFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanAlgaeFluxArea", oceanAlgaeFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDOCFluxArea", oceanDOCFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDICFluxArea", oceanDICFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDONFluxArea", oceanDONFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanParticulateIronFluxArea", oceanParticulateIronFluxArea) - call MPAS_pool_get_array(biogeochemistry, "oceanDissolvedIronFluxArea", oceanDissolvedIronFluxArea) - - call MPAS_pool_get_dimension(mesh, "nZBGCTracers", nZBGCTracers) - call MPAS_pool_get_dimension(mesh, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(mesh, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(mesh, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(mesh, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(mesh, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(mesh, "maxIronType", maxIronType) - call MPAS_pool_get_dimension(mesh, "maxBCType", maxBCType) - call MPAS_pool_get_dimension(mesh, "maxDustType", maxDustType) - - allocate(oceanBioFluxesAll(nZBGCTracers)) - - allocate(ratio_C_to_N(3)) - - ratio_C_to_N(1) = config_ratio_C_to_N_diatoms - ratio_C_to_N(2) = config_ratio_C_to_N_small_plankton - ratio_C_to_N(3) = config_ratio_C_to_N_phaeocystis - - do iCell = 1, nCellsSolve - - !------------------------------------------------------------------- - ! store initial freezing melting potential - !------------------------------------------------------------------- - - freezingMeltingPotentialInitial(iCell) = freezingMeltingPotential(iCell) - - !------------------------------------------------------------------- - ! aggregate albedos - !------------------------------------------------------------------- - - albedoVisibleDirectCell(iCell) = 0.0_RKIND - albedoVisibleDiffuseCell(iCell) = 0.0_RKIND - albedoIRDirectCell(iCell) = 0.0_RKIND - albedoIRDiffuseCell(iCell) = 0.0_RKIND - - bareIceAlbedoCell(iCell) = 0.0_RKIND - snowAlbedoCell(iCell) = 0.0_RKIND - pondAlbedoCell(iCell) = 0.0_RKIND - - effectivePondAreaCell(iCell) = 0.0_RKIND - - do iCategory = 1, nCategories - - albedoVisibleDirectCell(iCell) = albedoVisibleDirectCell(iCell) + & - albedoVisibleDirectCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - albedoVisibleDiffuseCell(iCell) = albedoVisibleDiffuseCell(iCell) + & - albedoVisibleDiffuseCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - albedoIRDirectCell(iCell) = albedoIRDirectCell(iCell) + & - albedoIRDirectCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - albedoIRDiffuseCell(iCell) = albedoIRDiffuseCell(iCell) + & - albedoIRDiffuseCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - - ! sun above horizon - if (solarZenithAngleCosine(iCell) > seaicePuny) then - - bareIceAlbedoCell(iCell) = bareIceAlbedoCell(iCell) + & - bareIceAlbedoCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - snowAlbedoCell(iCell) = snowAlbedoCell(iCell) + & - snowAlbedoCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - pondAlbedoCell(iCell) = pondAlbedoCell(iCell) + & - pondAlbedoCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - - endif - - effectivePondAreaCell(iCell) = effectivePondAreaCell(iCell) + & - effectivePondAreaCategory(iCategory,iCell) * iceAreaCategory(1,iCategory,iCell) - - enddo ! iCategory - - !------------------------------------------------------------------- - ! reduce oceanFreshWaterFlux by pondFreshWaterFlux for coupling - !------------------------------------------------------------------- - - if (config_include_pond_freshwater_feedback) then - pondFreshWaterFlux(iCell) = pondFreshWaterFlux(iCell) * seaiceDensityFreshwater / config_dt - oceanFreshWaterFlux(iCell) = oceanFreshWaterFlux(iCell) - pondFreshWaterFlux(iCell) - endif - - !------------------------------------------------------------------- - ! Store grid box mean albedos and fluxes before scaling by aice - !------------------------------------------------------------------- - - albedoVisibleDirectArea(iCell) = albedoVisibleDirectCell(iCell) - albedoVisibleDiffuseArea(iCell) = albedoVisibleDiffuseCell(iCell) - albedoIRDirectArea(iCell) = albedoIRDirectCell(iCell) - albedoIRDiffuseArea(iCell) = albedoIRDiffuseCell(iCell) - oceanFreshWaterFluxArea(iCell) = oceanFreshWaterFlux(iCell) - oceanSaltFluxArea(iCell) = oceanSaltFlux(iCell) - oceanHeatFluxArea(iCell) = oceanHeatFlux(iCell) - oceanShortwaveFluxArea(iCell) = oceanShortwaveFlux(iCell) - - !----------------------------------------------------------------- - ! Save net shortwave for scaling factor in shortwaveScalingFactor - !----------------------------------------------------------------- - - shortwaveScalingFactor(iCell) = & - shortwaveVisibleDirectDown(iCell) * (1.0_RKIND - albedoVisibleDirectArea(iCell)) + & - shortwaveVisibleDiffuseDown(iCell) * (1.0_RKIND - albedoVisibleDiffuseArea(iCell)) + & - shortwaveIRDirectDown(iCell) * (1.0_RKIND - albedoIRDirectArea(iCell)) + & - shortwaveIRDiffuseDown(iCell) * (1.0_RKIND - albedoIRDiffuseArea(iCell)) - - !----------------------------------------------------------------- - ! Define ocean biogeochemical flux variables - !----------------------------------------------------------------- - - oceanBioFluxesAll(:) = 0.0_RKIND - - if (config_use_column_biogeochemistry .or. config_use_zaerosols) then - - totalOceanCarbonFlux(iCell) = 0.0_RKIND - oceanAlgaeFlux(:,iCell) = 0.0_RKIND - oceanDOCFlux(:,iCell) = 0.0_RKIND - oceanDICFlux(:,iCell) = 0.0_RKIND - oceanDONFlux(:,iCell) = 0.0_RKIND - oceanParticulateIronFlux(:,iCell) = 0.0_RKIND - oceanDissolvedIronFlux(:,iCell) = 0.0_RKIND - oceanNitrateFlux(iCell) = 0.0_RKIND - oceanSilicateFlux(iCell) = 0.0_RKIND - oceanAmmoniumFlux(iCell) = 0.0_RKIND - oceanDMSPpFlux(iCell) = 0.0_RKIND - oceanDMSPdFlux(iCell) = 0.0_RKIND - oceanDMSFlux(iCell) = 0.0_RKIND - oceanDustIronFlux(iCell) = 0.0_RKIND - oceanBlackCarbonFlux(iCell) = 0.0_RKIND - oceanHumicsFlux(iCell) = 0.0_RKIND - - do iBioTracers = 1, ciceTracerObject % nBioTracers - iBioData = ciceTracerObject % index_LayerIndexToDataArray(iBioTracers) - oceanBioFluxesAll(iBioData) = oceanBioFluxes(iBioTracers,iCell) - enddo - iBioData = 0 - - ! Algae - do iBioTracers = 1, maxAlgaeType - iBioData = iBioData+1 - oceanAlgaeFlux(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - oceanAlgaeFluxArea(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - totalOceanCarbonFlux(iCell) = totalOceanCarbonFlux(iCell) + & - oceanAlgaeFlux(iBioTracers,iCell) * ratio_C_to_N(iBioTracers) - enddo - - ! Nitrate - iBioData = iBioData+1 - oceanNitrateFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanNitrateFluxArea(iCell) = oceanBioFluxesAll(iBioData) - - ! Polysaccharids and Lipids - do iBioTracers = 1, maxDOCType - iBioData = iBioData+1 - oceanDOCFlux(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - oceanDOCFluxArea(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - totalOceanCarbonFlux(iCell) = totalOceanCarbonFlux(iCell) + & - oceanDOCFlux(iBioTracers,iCell) - enddo - - ! DIC - do iBioTracers = 1, maxDICType - iBioData = iBioData+1 - oceanDICFlux(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - oceanDICFluxArea(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - totalOceanCarbonFlux(iCell) = totalOceanCarbonFlux(iCell) + & - oceanDICFlux(iBioTracers,iCell) - enddo - - ! Chlorophyll (not saved) - iBioData = iBioData+maxAlgaeType - - ! Ammonium - iBioData = iBioData+1 - oceanAmmoniumFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanAmmoniumFluxArea(iCell) = oceanBioFluxesAll(iBioData) - - ! Silicate - iBioData = iBioData+1 - oceanSilicateFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanSilicateFluxArea(iCell) = oceanBioFluxesAll(iBioData) - - ! DMSPp - iBioData = iBioData+1 - oceanDMSPpFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanDMSPpFluxArea(iCell) = oceanBioFluxesAll(iBioData) - - ! DMSPd - iBioData = iBioData+1 - oceanDMSPdFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanDMSPdFluxArea(iCell) = oceanBioFluxesAll(iBioData) - - ! DMS - iBioData = iBioData+1 - oceanDMSFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanDMSFluxArea(iCell) = oceanBioFluxesAll(iBioData) - - ! PON - iBioData = iBioData+1 - - ! DON (Proteins) - do iBioTracers = 1, maxDONType - iBioData = iBioData+1 - oceanDONFlux(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - oceanDONFluxArea(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - totalOceanCarbonFlux(iCell) = totalOceanCarbonFlux(iCell) + & - oceanDONFlux(iBioTracers,iCell) * config_ratio_C_to_N_proteins - enddo - - ! Dissolved Iron - do iBioTracers = 1, maxIronType - iBioData = iBioData+1 - oceanDissolvedIronFlux(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - oceanDissolvedIronFluxArea(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - enddo - - ! Particulate Iron - do iBioTracers = 1, maxIronType - iBioData = iBioData+1 - oceanParticulateIronFlux(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - oceanParticulateIronFluxArea(iBioTracers,iCell) = oceanBioFluxesAll(iBioData) - enddo - - ! Black Carbon (combined; saved for conservation) - do iBioTracers = 1, maxBCType - iBioData = iBioData + 1 - oceanBlackCarbonFlux(iCell) = oceanBlackCarbonFlux(iCell) + oceanBioFluxesAll(iBioData) - enddo - oceanBlackCarbonFluxArea(iCell) = oceanBlackCarbonFlux(iCell) - - ! Dust (combined) - do iBioTracers = 1, maxDustType - iBioData = iBioData+1 - oceanDustIronFlux(iCell) = oceanDustIronFlux(iCell) + oceanBioFluxesAll(iBioData) - enddo - oceanDustIronFluxArea(iCell) = oceanDustIronFlux(iCell) - - ! Humics - iBioData = iBioData+1 - oceanHumicsFlux(iCell) = oceanBioFluxesAll(iBioData) - oceanHumicsFluxArea(iCell) = oceanBioFluxesAll(iBioData) - totalOceanCarbonFlux(iCell) = totalOceanCarbonFlux(iCell) + & - oceanHumicsFlux(iCell) - - endif ! config_use_column_biogeochemistry .or. config_use_zaerosols - - enddo ! iCell - - deallocate(oceanBioFluxesAll) - deallocate(ratio_C_to_N) - - block => block % next - enddo - - call seaice_column_scale_fluxes(domain) - - end subroutine seaice_column_coupling_prep - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_scale_fluxes -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th April -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_scale_fluxes(domain) - - use seaice_constants, only: & - seaiceStefanBoltzmann, & - seaiceFreshWaterFreezingPoint - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - tracersAggregate, & - velocitySolver, & - atmosFluxes, & - shortwave, & - atmosCoupling, & - oceanCoupling, & - oceanFluxes, & - biogeochemistry, & - mesh - - logical, pointer :: & - config_use_column_biogeochemistry, & - config_use_zaerosols - - real(kind=RKIND), dimension(:), pointer :: & - iceAreaCell, & - airStressCellU, & - airStressCellV, & - sensibleHeatFlux, & - latentHeatFlux, & - absorbedShortwaveFlux, & - longwaveUp, & - evaporativeWaterFlux, & - atmosReferenceHumidity2m, & - atmosReferenceTemperature2m, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFlux, & - oceanShortwaveFlux, & - albedoVisibleDirectCell, & - albedoIRDirectCell, & - albedoVisibleDiffuseCell, & - albedoIRDiffuseCell, & - airTemperature, & - airSpecificHumidity, & - seaFreezingTemperature, & - oceanNitrateFlux, & - oceanSilicateFlux, & - oceanAmmoniumFlux, & - oceanDMSFlux, & - oceanDMSPpFlux, & - oceanDMSPdFlux, & - oceanHumicsFlux, & - oceanDustIronFlux - - real(kind=RKIND), dimension(:,:), pointer :: & - oceanAlgaeFlux, & - oceanDOCFlux, & - oceanDICFlux, & - oceanDONFlux, & - oceanParticulateIronFlux, & - oceanDissolvedIronFlux - - real(kind=RKIND) :: & - iceAreaInverse - - integer, pointer :: & - nCellsSolve, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - maxBCType, & - maxDustType, & - maxAerosolType - - integer :: & - iCell, & - iBioTracers - - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracersAggregate) - call MPAS_pool_get_subpool(block % structs, "velocity_solver", velocitySolver) - call MPAS_pool_get_subpool(block % structs, "atmos_fluxes", atmosFluxes) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwave) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmosCoupling) - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", oceanCoupling) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", oceanFluxes) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - - call MPAS_pool_get_dimension(tracersAggregate, "nCellsSolve", nCellsSolve) - - call MPAS_pool_get_array(tracersAggregate, "iceAreaCell", iceAreaCell) - - call MPAS_pool_get_array(velocitySolver, "airStressCellU", airStressCellU) - call MPAS_pool_get_array(velocitySolver, "airStressCellV", airStressCellV) - - call MPAS_pool_get_array(atmosFluxes, "sensibleHeatFlux", sensibleHeatFlux) - call MPAS_pool_get_array(atmosFluxes, "latentHeatFlux", latentHeatFlux) - call MPAS_pool_get_array(atmosFluxes, "evaporativeWaterFlux", evaporativeWaterFlux) - call MPAS_pool_get_array(atmosFluxes, "longwaveUp", longwaveUp) - - call MPAS_pool_get_array(shortwave, "absorbedShortwaveFlux", absorbedShortwaveFlux) - call MPAS_pool_get_array(shortwave, "albedoVisibleDirectCell", albedoVisibleDirectCell) - call MPAS_pool_get_array(shortwave, "albedoIRDirectCell", albedoIRDirectCell) - call MPAS_pool_get_array(shortwave, "albedoVisibleDiffuseCell", albedoVisibleDiffuseCell) - call MPAS_pool_get_array(shortwave, "albedoIRDiffuseCell", albedoIRDiffuseCell) - - call MPAS_pool_get_array(atmosCoupling, "atmosReferenceHumidity2m", atmosReferenceHumidity2m) - call MPAS_pool_get_array(atmosCoupling, "atmosReferenceTemperature2m", atmosReferenceTemperature2m) - call MPAS_pool_get_array(atmosCoupling, "airTemperature", airTemperature) - call MPAS_pool_get_array(atmosCoupling, "airSpecificHumidity", airSpecificHumidity) - - call MPAS_pool_get_array(oceanCoupling, "seaFreezingTemperature", seaFreezingTemperature) - - call MPAS_pool_get_array(oceanFluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanSaltFlux", oceanSaltFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanHeatFlux", oceanHeatFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanShortwaveFlux", oceanShortwaveFlux) - - call MPAS_pool_get_array(biogeochemistry, "oceanNitrateFlux", oceanNitrateFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanSilicateFlux", oceanSilicateFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanAmmoniumFlux", oceanAmmoniumFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSFlux", oceanDMSFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPpFlux", oceanDMSPpFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPdFlux", oceanDMSPdFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanHumicsFlux", oceanHumicsFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDustIronFlux", oceanDustIronFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanAlgaeFlux", oceanAlgaeFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDOCFlux", oceanDOCFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDICFlux", oceanDICFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDONFlux", oceanDONFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanParticulateIronFlux", oceanParticulateIronFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanDissolvedIronFlux", oceanDissolvedIronFlux) - - call MPAS_pool_get_dimension(mesh, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(mesh, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(mesh, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(mesh, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(mesh, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(mesh, "maxIronType", maxIronType) - call MPAS_pool_get_dimension(mesh, "maxBCType", maxBCType) - call MPAS_pool_get_dimension(mesh, "maxDustType", maxDustType) - - do iCell = 1, nCellsSolve - - if (iceAreaCell(iCell) > 0.0_RKIND) then - - iceAreaInverse = 1.0_RKIND / iceAreaCell(iCell) - - airStressCellU(iCell) = airStressCellU(iCell) * iceAreaInverse - airStressCellV(iCell) = airStressCellV(iCell) * iceAreaInverse - sensibleHeatFlux(iCell) = sensibleHeatFlux(iCell) * iceAreaInverse - latentHeatFlux(iCell) = latentHeatFlux(iCell) * iceAreaInverse - absorbedShortwaveFlux(iCell) = absorbedShortwaveFlux(iCell) * iceAreaInverse - longwaveUp(iCell) = longwaveUp(iCell) * iceAreaInverse - evaporativeWaterFlux(iCell) = evaporativeWaterFlux(iCell) * iceAreaInverse - atmosReferenceTemperature2m(iCell) = atmosReferenceTemperature2m(iCell) * iceAreaInverse - atmosReferenceHumidity2m(iCell) = atmosReferenceHumidity2m(iCell) * iceAreaInverse - oceanFreshWaterFlux(iCell) = oceanFreshWaterFlux(iCell) * iceAreaInverse - oceanSaltFlux(iCell) = oceanSaltFlux(iCell) * iceAreaInverse - oceanHeatFlux(iCell) = oceanHeatFlux(iCell) * iceAreaInverse - oceanShortwaveFlux(iCell) = oceanShortwaveFlux(iCell) * iceAreaInverse - albedoVisibleDirectCell(iCell) = albedoVisibleDirectCell(iCell) * iceAreaInverse - albedoIRDirectCell(iCell) = albedoIRDirectCell(iCell) * iceAreaInverse - albedoVisibleDiffuseCell(iCell) = albedoVisibleDiffuseCell(iCell) * iceAreaInverse - albedoIRDiffuseCell(iCell) = albedoIRDiffuseCell(iCell) * iceAreaInverse - - if (config_use_zaerosols) & - oceanDustIronFlux(iCell) = oceanDustIronFlux(iCell) * iceAreaInverse - - if (config_use_column_biogeochemistry) then - - oceanNitrateFlux(iCell) = oceanNitrateFlux(iCell) * iceAreaInverse - oceanSilicateFlux(iCell) = oceanSilicateFlux(iCell) * iceAreaInverse - oceanAmmoniumFlux(iCell) = oceanAmmoniumFlux(iCell) * iceAreaInverse - oceanDMSPpFlux(iCell) = oceanDMSPpFlux(iCell) * iceAreaInverse - oceanDMSPdFlux(iCell) = oceanDMSPdFlux(iCell) * iceAreaInverse - oceanDMSFlux(iCell) = oceanDMSFlux(iCell) * iceAreaInverse - oceanHumicsFlux(iCell) = oceanHumicsFlux(iCell) * iceAreaInverse - - do iBioTracers = 1, maxAlgaeType - oceanAlgaeFlux(iBioTracers,iCell) = oceanAlgaeFlux(iBioTracers,iCell) * iceAreaInverse - enddo - do iBioTracers = 1, maxDOCType - oceanDOCFlux(iBioTracers,iCell) = oceanDOCFlux(iBioTracers,iCell) * iceAreaInverse - enddo - do iBioTracers = 1, maxDICType - oceanDICFlux(iBioTracers,iCell) = oceanDICFlux(iBioTracers,iCell) * iceAreaInverse - enddo - do iBioTracers = 1, maxDONType - oceanDONFlux(iBioTracers,iCell) = oceanDONFlux(iBioTracers,iCell) * iceAreaInverse - enddo - do iBioTracers = 1, maxIronType - oceanDissolvedIronFlux(iBioTracers,iCell) = oceanDissolvedIronFlux(iBioTracers,iCell) * iceAreaInverse - enddo - do iBioTracers = 1, maxIronType - oceanParticulateIronFlux(iBioTracers,iCell) = oceanParticulateIronFlux(iBioTracers,iCell) * iceAreaInverse - enddo - endif - - else - - airStressCellU(iCell) = 0.0_RKIND - airStressCellV(iCell) = 0.0_RKIND - sensibleHeatFlux(iCell) = 0.0_RKIND - latentHeatFlux(iCell) = 0.0_RKIND - absorbedShortwaveFlux(iCell) = 0.0_RKIND - longwaveUp(iCell) = & - -seaiceStefanBoltzmann * (seaFreezingTemperature(iCell) + seaiceFreshWaterFreezingPoint)**4 - evaporativeWaterFlux(iCell) = 0.0_RKIND - atmosReferenceTemperature2m(iCell) = airTemperature(iCell) - atmosReferenceHumidity2m(iCell) = airSpecificHumidity(iCell) - oceanFreshWaterFlux(iCell) = 0.0_RKIND - oceanSaltFlux(iCell) = 0.0_RKIND - oceanHeatFlux(iCell) = 0.0_RKIND - oceanShortwaveFlux(iCell) = 0.0_RKIND - albedoVisibleDirectCell(iCell) = 0.0_RKIND - albedoIRDirectCell(iCell) = 0.0_RKIND - albedoVisibleDiffuseCell(iCell) = 0.0_RKIND - albedoIRDiffuseCell(iCell) = 0.0_RKIND - - if (config_use_zaerosols) & - oceanDustIronFlux(iCell) = 0.0_RKIND - - if (config_use_column_biogeochemistry) then - - oceanNitrateFlux(iCell) = 0.0_RKIND - oceanSilicateFlux(iCell) = 0.0_RKIND - oceanAmmoniumFlux(iCell) = 0.0_RKIND - oceanDMSPpFlux(iCell) = 0.0_RKIND - oceanDMSPdFlux(iCell) = 0.0_RKIND - oceanDMSFlux(iCell) = 0.0_RKIND - oceanHumicsFlux(iCell) = 0.0_RKIND - oceanAlgaeFlux(:,iCell) = 0.0_RKIND - oceanDOCFlux(:,iCell) = 0.0_RKIND - oceanDICFlux(:,iCell) = 0.0_RKIND - oceanDONFlux(:,iCell) = 0.0_RKIND - oceanParticulateIronFlux(:,iCell) = 0.0_RKIND - oceanDissolvedIronFlux(:,iCell) = 0.0_RKIND - - endif - endif - - enddo ! iCell - - block => block % next - enddo - - end subroutine seaice_column_scale_fluxes - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_ocean_mixed_layer -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 6th April -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_ocean_mixed_layer(domain) - - use ice_colpkg, only: & - colpkg_atm_boundary, & - colpkg_ocn_mixed_layer - - use seaice_constants, only: & - seaiceOceanAlbedo - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - oceanCoupling, & - atmosCoupling, & - atmosForcing, & - tracersAggregate, & - drag, & - oceanFluxes, & - oceanAtmosphere - - real(kind=RKIND), dimension(:), pointer :: & - seaSurfaceTemperature, & - seaSurfaceSalinity, & - seaFreezingTemperature, & - oceanMixedLayerDepth, & - oceanHeatFluxConvergence, & - airPotentialTemperature, & - airSpecificHumidity, & - uAirVelocity, & - vAirVelocity, & - windSpeed, & - airLevelHeight, & - airDensity, & - longwaveDown, & - iceAreaCell, & - freezingMeltingPotential, & - frazilMassAdjust, & - shortwaveVisibleDirectDown, & - shortwaveVisibleDiffuseDown, & - shortwaveIRDirectDown, & - shortwaveIRDiffuseDown, & - airDragCoefficient, & - airOceanDragCoefficientRatio, & - oceanHeatFlux, & - oceanShortwaveFlux, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - airStressOceanU, & - airStressOceanV, & - atmosReferenceTemperature2mOcean, & - atmosReferenceHumidity2mOcean, & - longwaveUpOcean, & - sensibleHeatFluxOcean, & - latentHeatFluxOcean, & - evaporativeWaterFluxOcean, & - albedoVisibleDirectOcean, & - albedoIRDirectOcean, & - albedoVisibleDiffuseOcean, & - albedoIRDiffuseOcean - - real(kind=RKIND) :: & - sensibleTransferCoefficient, & - latentTransferCoefficient, & - potentialTemperatureDifference, & - specificHumidityDifference - - real(kind=RKIND), pointer :: & - config_dt - - character(len=strKIND), pointer :: & - config_ocean_mixed_layer_type - - integer :: & - iCell - - integer, pointer :: & - nCellsSolve - - integer, dimension(:), pointer :: & - landIceMask - - logical, pointer :: & - config_use_test_ice_shelf - - call MPAS_pool_get_config(domain % configs, "config_dt", config_dt) - call MPAS_pool_get_config(domain % configs, "config_ocean_mixed_layer_type", config_ocean_mixed_layer_type) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", oceanCoupling) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmosCoupling) - call MPAS_pool_get_subpool(block % structs, "atmos_forcing", atmosForcing) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracersAggregate) - call MPAS_pool_get_subpool(block % structs, "drag", drag) - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", oceanFluxes) - call MPAS_pool_get_subpool(block % structs, "ocean_atmosphere", oceanAtmosphere) - - call MPAS_pool_get_dimension(oceanCoupling, "nCellsSolve", nCellsSolve) - - call MPAS_pool_get_array(oceanCoupling, "seaSurfaceTemperature", seaSurfaceTemperature) - call MPAS_pool_get_array(oceanCoupling, "seaSurfaceSalinity", seaSurfaceSalinity) - call MPAS_pool_get_array(oceanCoupling, "seaFreezingTemperature", seaFreezingTemperature) - call MPAS_pool_get_array(oceanCoupling, "freezingMeltingPotential", freezingMeltingPotential) - call MPAS_pool_get_array(oceanCoupling, "frazilMassAdjust", frazilMassAdjust) - call MPAS_pool_get_array(oceanCoupling, "oceanMixedLayerDepth", oceanMixedLayerDepth) - call MPAS_pool_get_array(oceanCoupling, "oceanHeatFluxConvergence", oceanHeatFluxConvergence) - - call MPAS_pool_get_array(atmosCoupling, "airPotentialTemperature", airPotentialTemperature) - call MPAS_pool_get_array(atmosCoupling, "uAirVelocity", uAirVelocity) - call MPAS_pool_get_array(atmosCoupling, "vAirVelocity", vAirVelocity) - call MPAS_pool_get_array(atmosCoupling, "airLevelHeight", airLevelHeight) - call MPAS_pool_get_array(atmosCoupling, "airSpecificHumidity", airSpecificHumidity) - call MPAS_pool_get_array(atmosCoupling, "airDensity", airDensity) - call MPAS_pool_get_array(atmosCoupling, "longwaveDown", longwaveDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveVisibleDirectDown", shortwaveVisibleDirectDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveVisibleDiffuseDown", shortwaveVisibleDiffuseDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveIRDirectDown", shortwaveIRDirectDown) - call MPAS_pool_get_array(atmosCoupling, "shortwaveIRDiffuseDown", shortwaveIRDiffuseDown) - - call MPAS_pool_get_array(atmosForcing, "windSpeed", windSpeed) - - call MPAS_pool_get_array(tracersAggregate, "iceAreaCell", iceAreaCell) - - call MPAS_pool_get_array(drag, "airDragCoefficient", airDragCoefficient) - call MPAS_pool_get_array(drag, "airOceanDragCoefficientRatio", airOceanDragCoefficientRatio) - - call MPAS_pool_get_array(oceanFluxes, "oceanHeatFlux", oceanHeatFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanShortwaveFlux", oceanShortwaveFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(oceanFluxes, "oceanSaltFlux", oceanSaltFlux) - - call MPAS_pool_get_array(oceanAtmosphere, "airStressOceanU", airStressOceanU) - call MPAS_pool_get_array(oceanAtmosphere, "airStressOceanV", airStressOceanV) - call MPAS_pool_get_array(oceanAtmosphere, "atmosReferenceTemperature2mOcean", atmosReferenceTemperature2mOcean) - call MPAS_pool_get_array(oceanAtmosphere, "atmosReferenceHumidity2mOcean", atmosReferenceHumidity2mOcean) - call MPAS_pool_get_array(oceanAtmosphere, "albedoVisibleDirectOcean", albedoVisibleDirectOcean) - call MPAS_pool_get_array(oceanAtmosphere, "albedoVisibleDiffuseOcean", albedoVisibleDiffuseOcean) - call MPAS_pool_get_array(oceanAtmosphere, "albedoIRDirectOcean", albedoIRDirectOcean) - call MPAS_pool_get_array(oceanAtmosphere, "albedoIRDiffuseOcean", albedoIRDiffuseOcean) - call MPAS_pool_get_array(oceanAtmosphere, "longwaveUpOcean", longwaveUpOcean) - call MPAS_pool_get_array(oceanAtmosphere, "sensibleHeatFluxOcean", sensibleHeatFluxOcean) - call MPAS_pool_get_array(oceanAtmosphere, "latentHeatFluxOcean", latentHeatFluxOcean) - call MPAS_pool_get_array(oceanAtmosphere, "evaporativeWaterFluxOcean", evaporativeWaterFluxOcean) - - if (trim(config_ocean_mixed_layer_type) == "cice") then - - do iCell = 1, nCellsSolve - - call colpkg_atm_boundary(& - 'ocn', & - seaSurfaceTemperature(iCell), & - airPotentialTemperature(iCell), & - uAirVelocity(iCell), & - vAirVelocity(iCell), & - windSpeed(iCell), & - airLevelHeight(iCell), & - airSpecificHumidity(iCell), & - airDensity(iCell), & - airStressOceanU(iCell), & - airStressOceanV(iCell), & - atmosReferenceTemperature2mOcean(iCell), & - atmosReferenceHumidity2mOcean(iCell), & - potentialTemperatureDifference, & - specificHumidityDifference, & - latentTransferCoefficient, & - sensibleTransferCoefficient, & - airDragCoefficient(iCell), & - airOceanDragCoefficientRatio(iCell)) - - albedoVisibleDirectOcean(iCell) = seaiceOceanAlbedo - albedoIRDirectOcean(iCell) = seaiceOceanAlbedo - albedoVisibleDiffuseOcean(iCell) = seaiceOceanAlbedo - albedoIRDiffuseOcean(iCell) = seaiceOceanAlbedo - - call colpkg_ocn_mixed_layer(& - albedoVisibleDirectOcean(iCell), & - shortwaveVisibleDirectDown(iCell), & - albedoIRDirectOcean(iCell), & - shortwaveIRDirectDown(iCell), & - albedoVisibleDiffuseOcean(iCell), & - shortwaveVisibleDiffuseDown(iCell), & - albedoIRDiffuseOcean(iCell), & - shortwaveIRDiffuseDown(iCell), & - seaSurfaceTemperature(iCell), & - longwaveUpOcean(iCell), & - sensibleHeatFluxOcean(iCell), & - sensibleTransferCoefficient, & - latentHeatFluxOcean(iCell), & - latentTransferCoefficient, & - evaporativeWaterFluxOcean(iCell), & - longwaveDown(iCell), & - potentialTemperatureDifference, & - specificHumidityDifference, & - iceAreaCell(iCell), & - oceanHeatFlux(iCell), & - oceanShortwaveFlux(iCell), & - oceanMixedLayerDepth(iCell), & - seaFreezingTemperature(iCell), & - oceanHeatFluxConvergence(iCell), & - freezingMeltingPotential(iCell), & - config_dt) - - enddo ! iCell - - else if (trim(config_ocean_mixed_layer_type) == "e3sm") then - - do iCell = 1, nCellsSolve - - call colpkg_atm_boundary(& - 'ocn', & - seaSurfaceTemperature(iCell), & - airPotentialTemperature(iCell), & - uAirVelocity(iCell), & - vAirVelocity(iCell), & - windSpeed(iCell), & - airLevelHeight(iCell), & - airSpecificHumidity(iCell), & - airDensity(iCell), & - airStressOceanU(iCell), & - airStressOceanV(iCell), & - atmosReferenceTemperature2mOcean(iCell), & - atmosReferenceHumidity2mOcean(iCell), & - potentialTemperatureDifference, & - specificHumidityDifference, & - latentTransferCoefficient, & - sensibleTransferCoefficient, & - airDragCoefficient(iCell), & - airOceanDragCoefficientRatio(iCell)) - - albedoVisibleDirectOcean(iCell) = seaiceOceanAlbedo - albedoIRDirectOcean(iCell) = seaiceOceanAlbedo - albedoVisibleDiffuseOcean(iCell) = seaiceOceanAlbedo - albedoIRDiffuseOcean(iCell) = seaiceOceanAlbedo - - call seaice_ocean_mixed_layer_e3sm(& - oceanMixedLayerDepth(iCell), & - seaSurfaceTemperature(iCell), & - seaSurfaceSalinity(iCell), & - freezingMeltingPotential(iCell), & - frazilMassAdjust(iCell), & - oceanHeatFlux(iCell), & - oceanShortwaveFlux(iCell), & - oceanFreshWaterFlux(iCell), & - oceanSaltFlux(iCell), & - oceanHeatFluxConvergence(iCell), & - albedoVisibleDirectOcean(iCell), & - shortwaveVisibleDirectDown(iCell), & - albedoIRDirectOcean(iCell), & - shortwaveIRDirectDown(iCell), & - albedoVisibleDiffuseOcean(iCell), & - shortwaveVisibleDiffuseDown(iCell), & - albedoIRDiffuseOcean(iCell), & - shortwaveIRDiffuseDown(iCell), & - sensibleTransferCoefficient, & - latentTransferCoefficient, & - longwaveDown(iCell), & - potentialTemperatureDifference, & - specificHumidityDifference, & - iceAreaCell(iCell), & - seaFreezingTemperature(iCell), & - config_dt) - - enddo ! iCell - - endif - - block => block % next - enddo - - ! remove frazil from below ice shelves if were testing that - call MPAS_pool_get_config(domain % configs, "config_use_test_ice_shelf", config_use_test_ice_shelf) - - if (config_use_test_ice_shelf) then - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", oceanCoupling) - - call MPAS_pool_get_array(oceanCoupling, "freezingMeltingPotential", freezingMeltingPotential) - call MPAS_pool_get_array(oceanCoupling, "landIceMask", landIceMask) - - call MPAS_pool_get_dimension(oceanCoupling, "nCellsSolve", nCellsSolve) - - do iCell = 1, nCellsSolve - - if (landIceMask(iCell) == 1) then - freezingMeltingPotential(iCell) = 0.0_RKIND - endif - - enddo ! iCell - - block => block % next - enddo - - endif ! - - end subroutine seaice_column_ocean_mixed_layer - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_ocean_mixed_layer_e3sm -! -!> \brief E3SM ocean coupling proxy -!> \author Adrian K. Turner, LANL -!> \date 9th July 2022 -!> \details Representation of ocean processes and coupling in e3sm. This -!> routine mimics the ocean/sea ice coupling in e3sm using MPAS-Ocn, -!> including updates to ocean thickness, temperature and salinity from -!> interactions with sea ice and frazil formation. -! -!----------------------------------------------------------------------- - - subroutine seaice_ocean_mixed_layer_e3sm(& - oceanMixedLayerDepth, & - seaSurfaceTemperature, & - seaSurfaceSalinity, & - freezingMeltingPotential, & - frazilMassAdjust, & - oceanHeatFlux, & - oceanShortwaveFlux, & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFluxConvergence, & - albedoVisibleDirectOcean, & - shortwaveVisibleDirectDown, & - albedoIRDirectOcean, & - shortwaveIRDirectDown, & - albedoVisibleDiffuseOcean, & - shortwaveVisibleDiffuseDown, & - albedoIRDiffuseOcean, & - shortwaveIRDiffuseDown, & - sensibleTransferCoefficient, & - latentTransferCoefficient, & - longwaveDown, & - potentialTemperatureDifference, & - specificHumidityDifference, & - iceAreaCell, & - seaFreezingTemperature, & - timeStep) - - use seaice_constants, only: & - seaiceFreshWaterFreezingPoint, & - seaiceStefanBoltzmann, & - seaiceDensitySeaWater, & - seaiceSeaWaterSpecificHeat, & - seaiceLatentHeatVaporization, & - seaiceReferenceSalinity - - real(kind=RKIND), intent(inout) :: & - oceanMixedLayerDepth, & - seaSurfaceTemperature, & - seaSurfaceSalinity - - real(kind=RKIND), intent(out) :: & - freezingMeltingPotential - - real(kind=RKIND), intent(inout) :: & - frazilMassAdjust, & - oceanFreshWaterFlux, & - oceanSaltFlux - - real(kind=RKIND), intent(in) :: & - oceanHeatFlux, & - oceanShortwaveFlux, & - oceanHeatFluxConvergence, & - albedoVisibleDirectOcean, & - shortwaveVisibleDirectDown, & - albedoIRDirectOcean, & - shortwaveIRDirectDown, & - albedoVisibleDiffuseOcean, & - shortwaveVisibleDiffuseDown, & - albedoIRDiffuseOcean, & - shortwaveIRDiffuseDown, & - sensibleTransferCoefficient, & - latentTransferCoefficient, & - longwaveDown, & - potentialTemperatureDifference, & - specificHumidityDifference, & - iceAreaCell, & - seaFreezingTemperature, & - timeStep - - real(kind=RKIND) :: & - absorbedShortwaveOcean, & - seaSurfaceTemperatureKelvin, & - longwaveUpOcean, & - sensibleHeatFluxOcean, & - latentHeatFluxOcean, & - evaporativeWaterFluxOcean, & - openWaterHeatFlux, & - iceHeatFlux, & - totalHeatFlux, & - fflux_factor, & - hflux_factor, & - sflux_factor, & - maxFreezingMeltingPotential, & - changeOceanMixedLayerDepth, & - changeSeaSurfaceTemperature, & - changeSeaSurfaceSalinity - - real(kind=RKIND) :: & - potential, & - freezingEnergy, & - newFrazilIceThickness, & - newThicknessWeightedSaltContent, & - frazilLayerThicknessTendency, & - frazilSalinityTendency, & - frazilTemperatureTendency, & - seaIceEnergy, & - accumulatedFrazilIceMass, & - sumNewFrazilIceThickness, & - ocn_cpl_dt, & - o2x_Fioo_q, & - o2x_Fioo_frazil, & - x2i_Fioo_q, & - x2i_Fioo_frazil, & - frazilMassFlux, & - frazilMassFluxRev - - real(kind=RKIND), parameter :: & - config_specific_heat_sea_water = 3.996e3_RKIND, & - rho_sw = 1.026e3_RKIND, & - cp_sw = 3.996e3_RKIND, & - config_frazil_heat_of_fusion = 3.337e5_RKIND, & - config_frazil_ice_density = 1000.0_RKIND, & - config_frazil_fractional_thickness_limit = 0.1_RKIND, & - config_frazil_sea_ice_reference_salinity = 4.0_RKIND - - ocn_cpl_dt = timeStep - - !----------------------------------------------------------------------------------- - ! ice_comp_mct - export - !----------------------------------------------------------------------------------- - - oceanFreshWaterFlux = oceanFreshWaterFlux + frazilMassAdjust/iceAreaCell - oceanSaltFlux = oceanSaltFlux + seaiceReferenceSalinity*0.001_RKIND*frazilMassAdjust/iceAreaCell - - !----------------------------------------------------------------------------------- - ! Ocean surface fluxes - !----------------------------------------------------------------------------------- - - ! shortwave radiative flux - absorbedShortwaveOcean = & - (1.0_RKIND-albedoVisibleDirectOcean) * shortwaveVisibleDirectDown + & - (1.0_RKIND-albedoIRDirectOcean) * shortwaveIRDirectDown + & - (1.0_RKIND-albedoVisibleDiffuseOcean) * shortwaveVisibleDiffuseDown + & - (1.0_RKIND-albedoIRDiffuseOcean) * shortwaveIRDiffuseDown - - ! ocean surface temperature in Kelvin - seaSurfaceTemperatureKelvin = seaSurfaceTemperature + seaiceFreshWaterFreezingPoint - - ! longwave radiative flux - longwaveUpOcean = -seaiceStefanBoltzmann * seaSurfaceTemperatureKelvin**4 - - ! downward latent and sensible heat fluxes - sensibleHeatFluxOcean = sensibleTransferCoefficient * potentialTemperatureDifference - latentHeatFluxOcean = latentTransferCoefficient * specificHumidityDifference - evaporativeWaterFluxOcean = -latentHeatFluxOcean / seaiceLatentHeatVaporization - - ! open water heat flux - openWaterHeatFlux = & - sensibleHeatFluxOcean + & - latentHeatFluxOcean + & - longwaveUpOcean + & - longwaveDown + & - absorbedShortwaveOcean - openWaterHeatFlux = openWaterHeatFlux * (1.0_RKIND - iceAreaCell) - - ! ice heat flux - iceHeatFlux = & - oceanHeatFlux + & - oceanShortwaveFlux - - ! total heat flux - totalHeatFlux = openWaterHeatFlux + iceHeatFlux - oceanHeatFluxConvergence - - !----------------------------------------------------------------------------------- - ! MPAS-Ocn frazil formation - mpas_ocn_frazil_forcing.F - !----------------------------------------------------------------------------------- - potential = oceanMixedLayerDepth * config_specific_heat_sea_water * rho_sw * (seaSurfaceTemperature - seaFreezingTemperature) - - freezingEnergy = max(0.0_RKIND, -potential) - newFrazilIceThickness = freezingEnergy / (config_frazil_heat_of_fusion * config_frazil_ice_density) - newFrazilIceThickness = min(newFrazilIceThickness, oceanMixedLayerDepth * config_frazil_fractional_thickness_limit) - newThicknessWeightedSaltContent = newFrazilIceThickness * config_frazil_sea_ice_reference_salinity * 0.001_RKIND - - frazilLayerThicknessTendency = - newFrazilIceThickness * (config_frazil_ice_density / seaiceDensitySeaWater) - frazilSalinityTendency = - newThicknessWeightedSaltContent - frazilTemperatureTendency = + (newFrazilIceThickness * config_frazil_heat_of_fusion * config_frazil_ice_density) / (config_specific_heat_sea_water * rho_sw) - - sumNewFrazilIceThickness = newFrazilIceThickness - accumulatedFrazilIceMass = sumNewFrazilIceThickness * config_frazil_ice_density - - !----------------------------------------------------------------------------------- - ! Modify ocean state - !----------------------------------------------------------------------------------- - - ! change in mixed layer depth - changeOceanMixedLayerDepth = (oceanFreshWaterFlux * timeStep) / seaiceDensitySeaWater + frazilLayerThicknessTendency - oceanMixedLayerDepth = oceanMixedLayerDepth + changeOceanMixedLayerDepth - - ! change in sea surface temperature - changeSeaSurfaceTemperature = (totalHeatFlux * timeStep) / (oceanMixedLayerDepth * seaiceDensitySeaWater * seaiceSeaWaterSpecificHeat) + frazilTemperatureTendency / oceanMixedLayerDepth - seaSurfaceTemperature = seaSurfaceTemperature + changeSeaSurfaceTemperature - (changeOceanMixedLayerDepth * seaSurfaceTemperature) / oceanMixedLayerDepth - - ! change in sea surface salinity - changeSeaSurfaceSalinity = (oceanSaltFlux * timeStep) / (oceanMixedLayerDepth * seaiceDensitySeaWater * 0.001_RKIND) + frazilSalinityTendency / oceanMixedLayerDepth - seaSurfaceSalinity = seaSurfaceSalinity + changeSeaSurfaceSalinity - (changeOceanMixedLayerDepth * seaSurfaceSalinity) / oceanMixedLayerDepth - - ! compute potential to freeze or melt ice - !maxFreezingMeltingPotential = 1000.0_RKIND - !freezingMeltingPotential = ((seaFreezingTemperature - seaSurfaceTemperature) * seaiceDensitySeaWater * seaiceSeaWaterSpecificHeat * oceanMixedLayerDepth) / timeStep - !freezingMeltingPotential = min(max(freezingMeltingPotential,-maxFreezingMeltingPotential),maxFreezingMeltingPotential) - - ! if sst is below freezing, reset sst to Tf - !if (seaSurfaceTemperature <= seaFreezingTemperature) seaSurfaceTemperature = seaFreezingTemperature - - !----------------------------------------------------------------------------------- - ! ocn_comp_mct - export - !----------------------------------------------------------------------------------- - if (accumulatedFrazilIceMass > 0.0_RKIND) then - seaIceEnergy = accumulatedFrazilIceMass * config_frazil_heat_of_fusion - else - seaIceEnergy = min(rho_sw*cp_sw*oceanMixedLayerDepth*(seaFreezingTemperature - seaSurfaceTemperature), 0.0_RKIND) - endif - - o2x_Fioo_q = seaIceEnergy / ocn_cpl_dt - o2x_Fioo_frazil = accumulatedFrazilIceMass / ocn_cpl_dt - - !----------------------------------------------------------------------------------- - ! coupler - !----------------------------------------------------------------------------------- - x2i_Fioo_q = o2x_Fioo_q - x2i_Fioo_frazil = o2x_Fioo_frazil - - !----------------------------------------------------------------------------------- - ! ice_comp_mct - import - !----------------------------------------------------------------------------------- - freezingMeltingPotential = x2i_Fioo_q - frazilMassFlux = x2i_Fioo_frazil - - call seaice_frazil_mass(freezingMeltingPotential, frazilMassFluxRev, seaSurfaceSalinity) - frazilMassAdjust = frazilMassFlux-frazilMassFluxRev - - end subroutine seaice_ocean_mixed_layer_e3sm - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_frazil_mass -! -!> \brief Calculate sea ice frazil formation from freezig potential -!> \author Adrian K. Turner, LANL -!> \date 9th July 2022 -!> \details Used in ice_comp_mct to determine frazil formation and -!> replicated here for use with the e3sm ocean coupling proxy -! -!----------------------------------------------------------------------- - - subroutine seaice_frazil_mass(freezingPotential, frazilMassFlux, seaSurfaceSalinity) - - use ice_mushy_physics, only: & - liquidus_temperature_mush, & - enthalpy_mush - - use ice_colpkg_shared, only: & - dSin0_frazil, & - phi_init - - use seaice_constants, only: & - seaiceDensityIce - - real (kind=RKIND), intent(in) :: freezingPotential - real (kind=RKIND), intent(in) :: seaSurfaceSalinity - - real (kind=RKIND), intent(out) :: frazilMassFlux - - real(kind=RKIND) :: & - Si0new, & - Ti, & - qi0new, & - vi0new - - if (freezingPotential > 0.0_RKIND) then - - if (seaSurfaceSalinity > 2.0_RKIND * dSin0_frazil) then - Si0new = seaSurfaceSalinity - dSin0_frazil - else - Si0new = seaSurfaceSalinity**2 / (4.0_RKIND*dSin0_frazil) - endif - Ti = liquidus_temperature_mush(Si0new/phi_init) - qi0new = enthalpy_mush(Ti, Si0new) - - frazilMassFlux = -freezingPotential*seaiceDensityIce/qi0new - - else - - frazilMassFlux = 0.0_RKIND - - endif - - end subroutine seaice_frazil_mass - -!----------------------------------------------------------------------- -! Other passthrough functions to column package -!----------------------------------------------------------------------- - - subroutine seaice_column_init_trcr(& - airTemperature, & - seaFreezingTemperature, & - initialSalinityProfile, & - initialMeltingTemperatureProfile, & - surfaceTemperature, & - nIceLayers, & - nSnowLayers, & - iceEnthalpy, & - snowEnthalpy) - - use ice_colpkg, only: & - colpkg_init_trcr - - integer, intent(in) :: & - nIceLayers, & ! number of ice layers - nSnowLayers ! number of snow layers - - real(kind=RKIND), intent(in) :: & - airTemperature, & ! air temperature (C) - seaFreezingTemperature ! freezing temperature (C) - - real(kind=RKIND), dimension(:), intent(in) :: & - initialSalinityProfile, & ! vertical salinity profile (ppt) - initialMeltingTemperatureProfile ! vertical temperature profile (C) - - real(kind=RKIND), intent(out) :: & - surfaceTemperature ! surface temperature (C) - - real(kind=RKIND), dimension(:), intent(out) :: & - iceEnthalpy, & ! ice enthalpy profile (J/m3) - snowEnthalpy ! snow enthalpy profile (J/m3) - - call colpkg_init_trcr(airTemperature, & - seaFreezingTemperature, & - initialSalinityProfile, & - initialMeltingTemperatureProfile, & - surfaceTemperature, & - nIceLayers, & - nSnowLayers, & - iceEnthalpy, & - snowEnthalpy) - - end subroutine seaice_column_init_trcr - - !----------------------------------------------------------------------- - - subroutine seaice_column_init_itd(& - nCategories, & - categoryThicknessLimits, & - abortFlag, & - abortMessage) - - use ice_colpkg, only: & - colpkg_init_itd - - integer, intent(in) :: & - nCategories ! number of thickness categories - - real(kind=RKIND), intent(out) :: & - categoryThicknessLimits(0:nCategories) ! category limits (m) - - logical, intent(inout) :: & - abortFlag ! if true, print diagnostics and abort model - - character(len=*), intent(out) :: & - abortMessage ! abort error message - - call colpkg_init_itd(& - nCategories, & - categoryThicknessLimits, & - abortFlag, & - abortMessage) - - end subroutine seaice_column_init_itd - - !----------------------------------------------------------------------- - - subroutine seaice_column_init_ocean_conc(& - oceanAmmoniumConc, & - oceanDMSPConc, & - oceanDMSConc, & - oceanAlgaeConc, & - oceanDOCConc, & - oceanDICConc, & - oceanDONConc, & - oceanDissolvedIronConc, & - oceanParticulateIronConc, & - oceanHumicsConc, & - oceanNitrateConc, & - oceanSilicateConc,& - oceanZAerosolConc, & - maxDICType, & - maxDONType, & - maxIronType, & - maxAerosolType, & - carbonToNitrogenRatioAlgae, & - carbonToNitrogenRatioDON) - - use ice_colpkg, only: & - colpkg_init_ocean_conc - - integer, intent(in) :: & - maxDICType, & - maxDONType, & - maxIronType, & - maxAerosolType - - real(kind=RKIND), intent(out):: & - oceanAmmoniumConc, & ! ammonium - oceanDMSPConc, & ! DMSPp - oceanDMSConc, & ! DMS - oceanHumicsConc, & ! humic material - oceanNitrateConc, & ! nitrate - oceanSilicateConc ! silicate - - real(kind=RKIND), dimension(:), intent(out):: & - oceanAlgaeConc, & ! algae - oceanDOCConc, & ! DOC - oceanDICConc, & ! DIC - oceanDONConc, & ! DON - oceanDissolvedIronConc, & ! Dissolved Iron - oceanParticulateIronConc, & ! Particulate Iron - oceanZAerosolConc ! BC and dust - - real(kind=RKIND), dimension(:), intent(inout), optional :: & - carbonToNitrogenRatioAlgae, & ! carbon to nitrogen ratio for algae - carbonToNitrogenRatioDON ! nitrogen to carbon ratio for proteins - - call colpkg_init_ocean_conc(& - oceanAmmoniumConc, & - oceanDMSPConc, & - oceanDMSConc, & - oceanAlgaeConc, & - oceanDOCConc, & - oceanDICConc, & - oceanDONConc, & - oceanDissolvedIronConc, & - oceanParticulateIronConc, & - oceanHumicsConc, & - oceanNitrateConc, & - oceanSilicateConc,& - oceanZAerosolConc, & - maxDICType, & - maxDONType, & - maxIronType, & - maxAerosolType, & - carbonToNitrogenRatioAlgae, & - carbonToNitrogenRatioDON) - - end subroutine seaice_column_init_ocean_conc - - !----------------------------------------------------------------------- - - subroutine seaice_column_ice_strength(& - nCategories, & - iceAreaCell, & - iceVolumeCell, & - openWaterArea, & - iceAreaCategory, & - iceVolumeCategory, & - icePressure) - - use ice_colpkg, only: & - colpkg_ice_strength - - integer, intent(in) :: & - nCategories ! number of thickness categories - - real(kind=RKIND), intent(in) :: & - iceAreaCell, & ! concentration of ice - iceVolumeCell, & ! volume per unit area of ice (m) - openWaterArea ! concentration of open water - - real(kind=RKIND), dimension(:), intent(in) :: & - iceAreaCategory, & ! concentration of ice - iceVolumeCategory ! volume per unit area of ice (m) - - real(kind=RKIND), intent(inout) :: & - icePressure ! ice strength (N/m) - - call colpkg_ice_strength(& - nCategories, & - iceAreaCell, & - iceVolumeCell, & - openWaterArea, & - iceAreaCategory, & - iceVolumeCategory, & - icePressure) - - end subroutine seaice_column_ice_strength - - !----------------------------------------------------------------------- - - function seaice_column_sea_freezing_temperature(seaSurfaceSalinity) result(seaFreezingTemperature) - - use ice_colpkg, only: & - colpkg_sea_freezing_temperature - - real(kind=RKIND), intent(in) :: seaSurfaceSalinity - real(kind=RKIND) :: seaFreezingTemperature - - seaFreezingTemperature = colpkg_sea_freezing_temperature(seaSurfaceSalinity) - - end function seaice_column_sea_freezing_temperature - - !----------------------------------------------------------------------- - - function seaice_column_liquidus_temperature(salinity) result(liquidusTemperature) - - use ice_colpkg, only: & - colpkg_liquidus_temperature - - real(kind=RKIND), intent(in) :: salinity - real(kind=RKIND) :: liquidusTemperature - - liquidusTemperature = colpkg_liquidus_temperature(salinity) - - end function seaice_column_liquidus_temperature - - !----------------------------------------------------------------------- - - function seaice_column_enthalpy_snow(snowTemperature) result(snowEnthalpy) - - use ice_colpkg, only: & - colpkg_enthalpy_snow - - real(kind=RKIND), intent(in) :: snowTemperature - real(kind=RKIND) :: snowEnthalpy - - snowEnthalpy = colpkg_enthalpy_snow(snowTemperature) - - end function seaice_column_enthalpy_snow - - !----------------------------------------------------------------------- - - function seaice_column_enthalpy_ice(iceTemperature, iceSalinity) result(iceEnthalpy) - - use ice_colpkg, only: & - colpkg_enthalpy_ice - - real(kind=RKIND), intent(in) :: iceTemperature - real(kind=RKIND), intent(in) :: iceSalinity - real(kind=RKIND) :: iceEnthalpy - - iceEnthalpy = colpkg_enthalpy_ice(iceTemperature, iceSalinity) - - end function seaice_column_enthalpy_ice - - !----------------------------------------------------------------------- - - function seaice_column_salinity_profile(depth) result(iceSalinity) - - use ice_colpkg, only: & - colpkg_salinity_profile - - real(kind=RKIND), intent(in) :: & - depth ! depth - - real(kind=RKIND) :: & - iceSalinity ! initial salinity profile - - iceSalinity = colpkg_salinity_profile(depth) - - end function seaice_column_salinity_profile - -!----------------------------------------------------------------------- -! initialize constants -!----------------------------------------------------------------------- - - subroutine seaice_init_column_constants() - - use seaice_constants, only: & - seaiceGravity, & - seaicePuny, & - seaiceDensityIce, & - seaiceDensitySnow, & - seaiceDensitySeaWater, & - seaiceDensityFreshwater, & - seaiceStefanBoltzmann, & - seaiceIceSnowEmissivity, & - seaiceFreshWaterFreezingPoint, & - seaiceAirSpecificHeat, & - seaiceWaterVaporSpecificHeat, & - seaiceSeaWaterSpecificHeat, & - seaiceLatentHeatVaporization, & - seaiceLatentHeatSublimation, & - seaiceLatentHeatMelting, & - seaiceReferenceSalinity, & - seaiceOceanAlbedo, & - seaiceVonKarmanConstant, & - seaiceIceSurfaceRoughness, & - seaiceStabilityReferenceHeight, & - seaiceIceStrengthConstantHiblerP, & - seaiceIceStrengthConstantHiblerC, & - skeletalLayerThickness, & - gramsCarbonPerMolCarbon, & - iceAreaMinimum, & - iceThicknessMinimum, & - snowThicknessMinimum - - use ice_constants_colpkg, only: & - gravit, & - rhoi, & - rhos, & - rhow, & - puny, & - stefan_boltzmann, & - emissivity, & - Tffresh, & - cp_air, & - cp_wv, & - cp_ocn, & - Lvap, & - Lsub, & - Lfresh, & - ice_ref_salinity, & - Pstar, & - Cstar, & - albocn, & - rhofresh, & - vonkar, & - iceruf, & - zref, & - sk_l, & - R_gC2molC - - seaiceGravity = gravit - seaicePuny = puny - seaiceDensityIce = rhoi - seaiceDensitySnow = rhos - seaiceDensitySeaWater = rhow - seaiceDensityFreshwater = rhofresh - seaiceStefanBoltzmann = stefan_boltzmann - seaiceIceSnowEmissivity = emissivity - seaiceFreshWaterFreezingPoint = Tffresh - seaiceAirSpecificHeat = cp_air - seaiceWaterVaporSpecificHeat = cp_wv - seaiceSeaWaterSpecificHeat = cp_ocn - seaiceLatentHeatVaporization = Lvap - seaiceLatentHeatSublimation = Lsub - seaiceLatentHeatMelting = Lfresh - seaiceReferenceSalinity = ice_ref_salinity - seaiceOceanAlbedo = albocn - seaiceVonKarmanConstant = vonkar - seaiceIceSurfaceRoughness = iceruf - seaiceStabilityReferenceHeight = zref - seaiceIceStrengthConstantHiblerP = Pstar - seaiceIceStrengthConstantHiblerC = Cstar - skeletalLayerThickness = sk_l - gramsCarbonPerMolCarbon = R_gC2molC - - iceAreaMinimum = seaicePuny - iceThicknessMinimum = seaicePuny - snowThicknessMinimum = seaicePuny - - end subroutine seaice_init_column_constants - -!----------------------------------------------------------------------- -! CICE tracer object -!----------------------------------------------------------------------- - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 22nd January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object(domain, tracerObject) - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - integer, pointer :: & - nCategories, & - nZBGCTracers - - logical, pointer :: & - config_use_column_biogeochemistry, & - config_use_zaerosols - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nCategories", nCategories) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nZBGCTracers", nZBGCTracers) - - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - - ! get the number of CICE tracers in trcrn - call init_column_tracer_object_tracer_number(domain, tracerObject) - - ! allocate other arrays - allocate(tracerObject % parentIndex(tracerObject % nTracers)) - allocate(tracerObject % firstAncestorMask(tracerObject % nTracers, tracerObject % nBaseTracers)) - allocate(tracerObject % ancestorIndices(tracerObject % nTracers, tracerObject % nMaxAncestorTracers)) - allocate(tracerObject % ancestorNumber(tracerObject % nTracers)) - - ! set the child indices - call init_column_tracer_object_child_indices(domain, tracerObject) - - ! set the parent indices - call init_column_tracer_object_parent_indices(domain, tracerObject) - - ! set the first ancestor mask - call init_column_tracer_object_first_ancestor_mask(domain, tracerObject) - - ! set the ancestor indices - call init_column_tracer_object_ancestor_indices(domain, tracerObject) - - ! biogeochemistry - if (config_use_column_biogeochemistry .or. config_use_zaerosols) then - - allocate(tracerObject % index_LayerIndexToDataArray(nZBGCTracers)) - allocate(tracerObject % index_LayerIndexToBioIndex(nZBGCTracers)) - - ! set all indices for biogeochemistry including parent, ancestor and ancestor mask - call init_column_tracer_object_for_biogeochemistry(domain, tracerObject) - - else - allocate(tracerObject % index_algaeConc(1)) - allocate(tracerObject % index_algalCarbon(1)) - allocate(tracerObject % index_algalChlorophyll(1)) - allocate(tracerObject % index_DOCConc(1)) - allocate(tracerObject % index_DONConc(1)) - allocate(tracerObject % index_DICConc(1)) - allocate(tracerObject % index_dissolvedIronConc(1)) - allocate(tracerObject % index_particulateIronConc(1)) - allocate(tracerObject % index_verticalAerosolsConc(1)) - - allocate(tracerObject % index_algaeConcLayer(1)) - allocate(tracerObject % index_algalCarbonLayer(1)) - allocate(tracerObject % index_algalChlorophyllLayer(1)) - allocate(tracerObject % index_DOCConcLayer(1)) - allocate(tracerObject % index_DONConcLayer(1)) - allocate(tracerObject % index_DICConcLayer(1)) - allocate(tracerObject % index_dissolvedIronConcLayer(1)) - allocate(tracerObject % index_particulateIronConcLayer(1)) - allocate(tracerObject % index_verticalAerosolsConcLayer(1)) - allocate(tracerObject % index_verticalAerosolsConcShortwave(1)) - - allocate(tracerObject % index_LayerIndexToDataArray(1)) - allocate(tracerObject % index_LayerIndexToBioIndex(1)) - endif - - ! allocate tracer arrays - !$omp parallel - allocate(tracerArrayCategory(tracerObject % nTracers, nCategories)) - !$omp end parallel - - allocate(tracerArrayCell(tracerObject % nTracers)) - - end subroutine init_column_tracer_object - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object_tracer_number -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 22nd January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object_tracer_number(domain, tracerObject) - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_brine, & - config_use_column_biogeochemistry, & - config_use_vertical_zsalinity, & - config_use_vertical_biochemistry, & - config_use_vertical_tracers, & - config_use_skeletal_biochemistry, & - config_use_nitrate, & - config_use_carbon, & - config_use_chlorophyll, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - integer, pointer :: & - nIceLayers, & - nSnowLayers, & - nAerosols, & - nBioLayers, & - nBioLayersP3, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nzAerosols - - integer :: & - iLayers, & - iBioTracers, & - nMobileTracers - - call MPAS_pool_get_config(domain % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(domain % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(domain % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(domain % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(domain % configs, "config_use_chlorophyll", config_use_chlorophyll) - call MPAS_pool_get_config(domain % configs, "config_use_ammonium", config_use_ammonium) - call MPAS_pool_get_config(domain % configs, "config_use_silicate", config_use_silicate) - call MPAS_pool_get_config(domain % configs, "config_use_DMS", config_use_DMS) - call MPAS_pool_get_config(domain % configs, "config_use_nonreactive", config_use_nonreactive) - call MPAS_pool_get_config(domain % configs, "config_use_humics", config_use_humics) - call MPAS_pool_get_config(domain % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(domain % configs, "config_use_iron", config_use_iron) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nAerosols", nAerosols) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDON", nDON) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDissolvedIron", nDissolvedIron) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nzAerosols", nzAerosols) - - !----------------------------------------------------------------------- - ! physics - !----------------------------------------------------------------------- - - ! surfaceTemperature - tracerObject % nTracers = 1 - - ! iceEnthalpy - tracerObject % nTracers = tracerObject % nTracers + nIceLayers - - ! snowEnthalpy - tracerObject % nTracers = tracerObject % nTracers + nSnowLayers - - ! ice Salinity - tracerObject % nTracers = tracerObject % nTracers + nIceLayers - - ! iceAge - if (config_use_ice_age) & - tracerObject % nTracers = tracerObject % nTracers + 1 - - ! firstYearIceArea - if (config_use_first_year_ice) & - tracerObject % nTracers = tracerObject % nTracers + 1 - - ! level ice tracers - if (config_use_level_ice) & - tracerObject % nTracers = tracerObject % nTracers + 2 - - ! pond tracers - if (config_use_cesm_meltponds .or. & - config_use_level_meltponds .or. & - config_use_topo_meltponds) & - tracerObject % nTracers = tracerObject % nTracers + 2 - - ! level or topo ponds - if (config_use_level_meltponds .or. & - config_use_topo_meltponds) & - tracerObject % nTracers = tracerObject % nTracers + 1 - - ! snow density (density from compaction) - if (config_use_effective_snow_density) then - tracerObject % nTracers = tracerObject % nTracers + nSnowLayers - endif - - ! snow grain radius (ice mass, liquid mass, and snow grain radius) - if (config_use_snow_grain_radius) then - tracerObject % nTracers = tracerObject % nTracers + nSnowLayers*3 - endif - - ! aerosols - if (config_use_aerosols) & - tracerObject % nTracers = tracerObject % nTracers + nAerosols*4 - - !----------------------------------------------------------------------- - ! biogeochemistry - !----------------------------------------------------------------------- - - if (config_use_column_biogeochemistry .or. config_use_zaerosols) then - - ! save tracer number without bio tracers counted - tracerObject % nTracersNotBio = tracerObject % nTracers - - ! biogeochemical tracers - tracerObject % nBioTracersLayer = 0 - - ! brine height tracer - if (config_use_brine) & - tracerObject % nTracers = tracerObject % nTracers + 1 - - ! vertical zSalinity - if (config_use_vertical_zsalinity) then - tracerObject % nTracers = tracerObject % nTracers + nBioLayers - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 - endif - nMobileTracers = 0 - - ! Skeletal Biogeochemistry - if (config_use_skeletal_biochemistry) then - iLayers = 1 - iBioTracers = 0 - - ! Vertical Biogeochemistry - elseif (config_use_vertical_tracers) then - iLayers = nBioLayersP3 - iBioTracers = 1 - - endif - - ! Algal nitrogen - if (config_use_vertical_biochemistry .or. config_use_skeletal_biochemistry) then - tracerObject % nTracers = tracerObject % nTracers + iLayers*nAlgae - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + nAlgae * iBioTracers - nMobileTracers = nMobileTracers + nAlgae - endif - - ! nitrate - if (config_use_nitrate) then - tracerObject % nTracers = tracerObject % nTracers + iLayers - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 * iBioTracers - nMobileTracers = nMobileTracers + 1 - endif - - ! carbon - if (config_use_carbon) then - tracerObject % nTracers = tracerObject % nTracers + iLayers * nDOC & - + iLayers * nDIC - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + (nDOC + nDIC) * iBioTracers - nMobileTracers = nMobileTracers + nDIC + nDOC - endif - - ! Algal chorophyll - if (config_use_chlorophyll) then - tracerObject % nTracers = tracerObject % nTracers + iLayers*nAlgae - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + nAlgae * iBioTracers - nMobileTracers = nMobileTracers + nAlgae - endif - - ! ammonium - if (config_use_ammonium) then - tracerObject % nTracers = tracerObject % nTracers + iLayers - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 * iBioTracers - nMobileTracers = nMobileTracers + 1 - endif - - ! silicate - if (config_use_silicate) then - tracerObject % nTracers = tracerObject % nTracers + iLayers - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 * iBioTracers - nMobileTracers = nMobileTracers + 1 - endif - - ! DMS - if (config_use_DMS) then - tracerObject % nTracers = tracerObject % nTracers + iLayers * 3 - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 3 * iBioTracers - nMobileTracers = nMobileTracers + 3 - endif - - ! nonreactive mobile tracer - if (config_use_nonreactive) then - tracerObject % nTracers = tracerObject % nTracers + iLayers - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 * iBioTracers - nMobileTracers = nMobileTracers + 1 - endif - - ! DON - if (config_use_DON) then - tracerObject % nTracers = tracerObject % nTracers + iLayers * nDON - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + nDON * iBioTracers - nMobileTracers = nMobileTracers + nDON - endif - - ! iron - if (config_use_iron) then - tracerObject % nTracers = tracerObject % nTracers + iLayers * nParticulateIron & - + iLayers * nDissolvedIron - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + & - (nParticulateIron + nDissolvedIron) * iBioTracers - nMobileTracers = nMobileTracers + nParticulateIron + nDissolvedIron - endif - - ! humic material - if (config_use_humics) then - tracerObject % nTracers = tracerObject % nTracers + iLayers - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 * iBioTracers - nMobileTracers = nMobileTracers + 1 - endif - - ! zAerosols - if (config_use_zaerosols) then - tracerObject % nTracers = tracerObject % nTracers + iLayers * nzAerosols - tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + nzAerosols * iBioTracers - nMobileTracers = nMobileTracers + nzAerosols - endif - - ! mobile fraction of vertical tracers - if (config_use_vertical_tracers) & - tracerObject % nTracers = tracerObject % nTracers + nMobileTracers - - endif ! config_use_column_biogeochemistry - - end subroutine init_column_tracer_object_tracer_number - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object_child_indices -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 22nd January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object_child_indices(domain, tracerObject) - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - integer :: & - nTracers - - integer, pointer :: & - nIceLayers, & - nSnowLayers - - integer, parameter :: indexMissingValue = 0 - - call MPAS_pool_get_config(domain % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(domain % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(domain % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nSnowLayers", nSnowLayers) - - ! ice/snow surface temperature - tracerObject % index_surfaceTemperature = 1 - nTracers = 1 - - ! ice enthalpy - tracerObject % index_iceEnthalpy = nTracers + 1 - nTracers = nTracers + nIceLayers - - ! snow enthalpy - tracerObject % index_snowEnthalpy = nTracers + 1 - nTracers = nTracers + nSnowLayers - - ! ice salinity - tracerObject % index_iceSalinity = nTracers + 1 - nTracers = nTracers + nIceLayers - - ! ice age - tracerObject % index_iceAge = indexMissingValue - if (config_use_ice_age) then - nTracers = nTracers + 1 - tracerObject % index_iceAge = nTracers - endif - - ! first year ice - tracerObject % index_firstYearIceArea = indexMissingValue - if (config_use_first_year_ice) then - nTracers = nTracers + 1 - tracerObject % index_firstYearIceArea = nTracers - endif - - ! level ice - tracerObject % index_levelIceArea = indexMissingValue - tracerObject % index_levelIceVolume = indexMissingValue - if (config_use_level_ice) then - nTracers = nTracers + 1 - tracerObject % index_levelIceArea = nTracers - nTracers = nTracers + 1 - tracerObject % index_levelIceVolume = nTracers - endif - - ! ponds - tracerObject % index_pondArea = indexMissingValue - tracerObject % index_pondDepth = indexMissingValue - tracerObject % index_pondLidThickness = indexMissingValue - - if (config_use_cesm_meltponds .or. & - config_use_level_meltponds .or. & - config_use_topo_meltponds) then - nTracers = nTracers + 1 - tracerObject % index_pondArea = nTracers - nTracers = nTracers + 1 - tracerObject % index_pondDepth = nTracers - endif - if (config_use_level_meltponds) then - nTracers = nTracers + 1 - tracerObject % index_pondLidThickness = nTracers - endif - if (config_use_topo_meltponds) then - nTracers = nTracers + 1 - tracerObject % index_pondLidThickness = nTracers - endif - - ! snow density - tracerObject % index_snowDensity = indexMissingValue - if (config_use_effective_snow_density) then - tracerObject % index_snowDensity = nTracers + 1 - nTracers = nTracers + nSnowLayers - endif - - ! snow grain radius - tracerObject % index_snowIceMass = indexMissingValue - tracerObject % index_snowLiquidMass = indexMissingValue - tracerObject % index_snowGrainRadius = indexMissingValue - if (config_use_snow_grain_radius) then - tracerObject % index_snowIceMass = nTracers + 1 - nTracers = nTracers + nSnowLayers - tracerObject % index_snowLiquidMass = nTracers + 1 - nTracers = nTracers + nSnowLayers - tracerObject % index_snowGrainRadius = nTracers + 1 - nTracers = nTracers + nSnowLayers - endif - - ! aerosols - tracerObject % index_aerosols = indexMissingValue - if (config_use_aerosols) then - tracerObject % index_aerosols = nTracers + 1 - endif - - !----------------------------------------------------------------------- - ! BGC indices are calculated in the column package - !----------------------------------------------------------------------- - - end subroutine init_column_tracer_object_child_indices - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object_parent_indices -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 22nd January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object_parent_indices(domain, tracerObject) - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - integer :: & - iIceLayer, & - iSnowLayer, & - iAerosol - - integer, pointer :: & - nIceLayers, & - nSnowLayers, & - nAerosols - - call MPAS_pool_get_config(domain % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(domain % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(domain % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nAerosols", nAerosols) - - ! ice/snow surface temperature - tracerObject % parentIndex(tracerObject % index_surfaceTemperature) = 0 - - ! ice enthalpy and salinity - do iIceLayer = 1, nIceLayers - tracerObject % parentIndex(tracerObject % index_iceEnthalpy + iIceLayer - 1) = 1 - tracerObject % parentIndex(tracerObject % index_iceSalinity + iIceLayer - 1) = 1 - enddo ! iIceLayer - - ! snow enthalpy - do iSnowLayer = 1, nSnowLayers - tracerObject % parentIndex(tracerObject % index_snowEnthalpy + iSnowLayer - 1) = 2 - enddo ! iSnowLayer - - ! ice age - if (config_use_ice_age) & - tracerObject % parentIndex(tracerObject % index_iceAge) = 1 - - ! first year ice - if (config_use_first_year_ice) & - tracerObject % parentIndex(tracerObject % index_firstYearIceArea) = 0 - - ! level ice area - if (config_use_level_ice) then - tracerObject % parentIndex(tracerObject % index_levelIceArea) = 0 - tracerObject % parentIndex(tracerObject % index_levelIceVolume) = 1 - endif - - ! cesm melt ponds - if (config_use_cesm_meltponds) then - tracerObject % parentIndex(tracerObject % index_pondArea) = 0 - tracerObject % parentIndex(tracerObject % index_pondDepth) = 2 + tracerObject % index_pondArea - endif - - ! level ice ponds - if (config_use_level_meltponds) then - tracerObject % parentIndex(tracerObject % index_pondArea) = 2 + tracerObject % index_levelIceArea - tracerObject % parentIndex(tracerObject % index_pondDepth) = 2 + tracerObject % index_pondArea - tracerObject % parentIndex(tracerObject % index_pondLidThickness) = 2 + tracerObject % index_pondArea - endif - - ! topo melt ponds - if (config_use_topo_meltponds) then - tracerObject % parentIndex(tracerObject % index_pondArea) = 0 - tracerObject % parentIndex(tracerObject % index_pondDepth) = 2 + tracerObject % index_pondArea - tracerObject % parentIndex(tracerObject % index_pondLidThickness) = 2 + tracerObject % index_pondArea - endif - - ! snow density - if (config_use_effective_snow_density) then - do iSnowLayer = 1, nSnowLayers - tracerObject % parentIndex(tracerObject % index_snowDensity + iSnowLayer - 1) = 2 - enddo ! iSnowLayer - endif - - ! snow grain radius - if (config_use_snow_grain_radius) then - do iSnowLayer = 1, nSnowLayers - tracerObject % parentIndex(tracerObject % index_snowIceMass + iSnowLayer - 1) = 2 - tracerObject % parentIndex(tracerObject % index_snowLiquidMass + iSnowLayer - 1) = 2 - tracerObject % parentIndex(tracerObject % index_snowGrainRadius + iSnowLayer - 1) = 2 - enddo ! iSnowLayer - endif - - ! aerosols - if (config_use_aerosols) then - do iAerosol = 1, nAerosols - tracerObject % parentIndex(tracerObject % index_aerosols + (iAerosol-1)*4 ) = 2 ! snow - tracerObject % parentIndex(tracerObject % index_aerosols + (iAerosol-1)*4 + 1) = 2 ! snow - tracerObject % parentIndex(tracerObject % index_aerosols + (iAerosol-1)*4 + 2) = 1 ! ice - tracerObject % parentIndex(tracerObject % index_aerosols + (iAerosol-1)*4 + 3) = 1 ! ice - enddo ! iAerosol - endif - - !----------------------------------------------------------------------- - ! BGC parentIndices are calculated in the column package - !----------------------------------------------------------------------- - - end subroutine init_column_tracer_object_parent_indices - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object_first_ancestor_mask -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 3rd Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object_first_ancestor_mask(domain, tracerObject) - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - integer :: & - iTracer - - ! mask for base quantity on which tracers are carried - - tracerObject % firstAncestorMask = 0.0_RKIND - - do iTracer = 1, tracerObject % nTracers - - if (tracerObject % parentIndex(iTracer) == 0) then - - ! ice area - tracerObject % firstAncestorMask(iTracer,1) = 1.0_RKIND - - elseif (tracerObject % parentIndex(iTracer) == 1) then ! ice volume - - ! ice volume - tracerObject % firstAncestorMask(iTracer,2) = 1.0_RKIND - - elseif (tracerObject % parentIndex(iTracer) == 2) then ! snow volume - - ! snow volume - tracerObject % firstAncestorMask(iTracer,3) = 1.0_RKIND - - else - - ! default: ice area - tracerObject % firstAncestorMask(iTracer,1) = 1.0_RKIND - - endif - - enddo ! iTracer - - !----------------------------------------------------------------------- - ! BGC firstAncestorMasks are calculated in the column package - !----------------------------------------------------------------------- - - end subroutine init_column_tracer_object_first_ancestor_mask - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object_ancestor_indices -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 3rd Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object_ancestor_indices(domain, tracerObject) - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - logical, pointer :: & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds - - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - - ! initialize - tracerObject % ancestorNumber = 0 - tracerObject % ancestorIndices = 0 - - ! cesm meltponds - if (config_use_cesm_meltponds) then - - ! melt pond depth - tracerObject % ancestorNumber (tracerObject % index_pondDepth) = 1 - tracerObject % ancestorIndices(tracerObject % index_pondDepth,1) = tracerObject % index_pondArea ! on melt pond area - - endif - - ! level melt ponds - if (config_use_level_meltponds) then - - ! melt pond area - tracerObject % ancestorNumber (tracerObject % index_pondArea) = 1 - tracerObject % ancestorIndices(tracerObject % index_pondArea,1) = tracerObject % index_levelIceArea ! on level ice area - - ! melt pond depth - tracerObject % ancestorNumber (tracerObject % index_pondDepth) = 2 - tracerObject % ancestorIndices(tracerObject % index_pondDepth,2) = tracerObject % index_pondArea ! on melt pond area - tracerObject % ancestorIndices(tracerObject % index_pondDepth,1) = tracerObject % index_levelIceArea ! on level ice area - - ! refrozen pond lid - tracerObject % ancestorNumber (tracerObject % index_pondLidThickness) = 2 - tracerObject % ancestorIndices(tracerObject % index_pondLidThickness,2) = tracerObject % index_pondArea ! on melt pond area - tracerObject % ancestorIndices(tracerObject % index_pondLidThickness,1) = & - tracerObject % index_levelIceArea ! on level ice area - - endif - - ! topographic melt ponds - if (config_use_topo_meltponds) then - - ! melt pond depth - tracerObject % ancestorNumber (tracerObject % index_pondDepth) = 1 - tracerObject % ancestorIndices(tracerObject % index_pondDepth,1) = tracerObject % index_pondArea ! on melt pond area - - ! refrozen pond lid - tracerObject % ancestorNumber (tracerObject % index_pondLidThickness) = 1 - tracerObject % ancestorIndices(tracerObject % index_pondLidThickness,1) = tracerObject % index_pondArea ! on melt pond area - - endif - - !----------------------------------------------------------------------- - ! BGC ancestorNumbers and ancestorIndices are calculated in the column package - !----------------------------------------------------------------------- - - end subroutine init_column_tracer_object_ancestor_indices - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_cice_tracer_array_category -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_cice_tracer_array_category(block, tracerObject, tracerArrayCategory, iCell, setPhysicsTracers, setBGCTracers) - - type(block_type), intent(inout) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:,:), intent(inout) :: & - tracerArrayCategory - - integer, intent(in) :: & - iCell - - logical, intent(in) :: & - setPhysicsTracers, & - setBGCTracers - - ! get physics tracers - if (setPhysicsTracers) & - call set_cice_physics_tracer_array_category(block, tracerArrayCategory, iCell) - - ! get BGC tracers - if (setBGCTracers) & - call set_cice_biogeochemistry_tracer_array_category(block, tracerObject, tracerArrayCategory, iCell) - - end subroutine set_cice_tracer_array_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_cice_tracer_array_category -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_cice_tracer_array_category(block, tracerObject, tracerArrayCategory, iCell, getPhysicsTracers, getBGCTracers) - - type(block_type), intent(inout) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:,:), intent(in) :: & - tracerArrayCategory - - integer, intent(in) :: & - iCell - - logical, intent(in) :: & - getPhysicsTracers, & - getBGCTracers - - ! get physics tracers - if (getPhysicsTracers) & - call get_cice_physics_tracer_array_category(block, tracerArrayCategory, iCell) - - ! get BGC tracers - if (getBGCTracers) & - call get_cice_biogeochemistry_tracer_array_category(block, tracerObject, tracerArrayCategory, iCell) - - end subroutine get_cice_tracer_array_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_cice_tracer_array_cell -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_cice_tracer_array_cell(block, tracerObject, tracerArrayCell, iCell, setPhysicsTracers, setBGCTracers) - - type(block_type), intent(inout) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:), intent(inout) :: & - tracerArrayCell - - integer, intent(in) :: & - iCell - - logical, intent(in) :: & - setPhysicsTracers, & - setBGCTracers - - ! get physics tracers - if (setPhysicsTracers) & - call set_cice_physics_tracer_array_cell(block, tracerArrayCell, iCell) - - ! get BGC tracers - if (setBGCTracers) & - call set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, tracerArrayCell, iCell) - - end subroutine set_cice_tracer_array_cell - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_cice_tracer_array_cell -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_cice_tracer_array_cell(block, tracerObject, tracerArrayCell, iCell, getPhysicsTracers, getBGCTracers) - - type(block_type), intent(inout) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:), intent(in) :: & - tracerArrayCell - - integer, intent(in) :: & - iCell - - logical, intent(in) :: & - getPhysicsTracers, & - getBGCTracers - - ! get physics tracers - if (getPhysicsTracers) & - call get_cice_physics_tracer_array_cell(block, tracerArrayCell, iCell) - - ! get BGC tracers - if (getBGCTracers) & - call get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, tracerArrayCell, iCell) - - end subroutine get_cice_tracer_array_cell - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_cice_physics_tracer_array_category -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_cice_physics_tracer_array_category(block, tracerArrayCategory, iCell) - - type(block_type), intent(in) :: & - block - - real(kind=RKIND), dimension(:,:), intent(inout) :: & - tracerArrayCategory - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - integer, pointer :: & - nIceLayers, & - nSnowLayers, & - nAerosols - - type(MPAS_pool_type), pointer :: & - tracers - - real(kind=RKIND), dimension(:,:,:), pointer :: & - surfaceTemperature, & - iceAge, & - firstYearIceArea, & - levelIceArea, & - levelIceVolume, & - pondArea, & - pondDepth, & - pondLidThickness, & - iceEnthalpy, & - snowEnthalpy, & - iceSalinity, & - snowScatteringAerosol, & - snowBodyAerosol, & - iceScatteringAerosol, & - iceBodyAerosol, & - snowIceMass, & - snowLiquidMass, & - snowGrainRadius, & - snowDensity - - integer :: & - nTracers, & - iAerosol - - call MPAS_pool_get_config(block % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(block % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(block % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(block % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(block % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(block % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(block % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(block % dimensions, "nAerosols", nAerosols) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_array(tracers, "surfaceTemperature", surfaceTemperature, 1) - call MPAS_pool_get_array(tracers, "iceEnthalpy", iceEnthalpy, 1) - call MPAS_pool_get_array(tracers, "snowEnthalpy", snowEnthalpy, 1) - call MPAS_pool_get_array(tracers, "iceSalinity", iceSalinity, 1) - call MPAS_pool_get_array(tracers, "iceAge", iceAge, 1) - call MPAS_pool_get_array(tracers, "firstYearIceArea", firstYearIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceArea", levelIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceVolume", levelIceVolume, 1) - call MPAS_pool_get_array(tracers, "pondArea", pondArea, 1) - call MPAS_pool_get_array(tracers, "pondDepth", pondDepth, 1) - call MPAS_pool_get_array(tracers, "pondLidThickness", pondLidThickness, 1) - call MPAS_pool_get_array(tracers, "snowScatteringAerosol", snowScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "snowBodyAerosol", snowBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "iceScatteringAerosol", iceScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "iceBodyAerosol", iceBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "snowIceMass", snowIceMass, 1) - call MPAS_pool_get_array(tracers, "snowLiquidMass", snowLiquidMass, 1) - call MPAS_pool_get_array(tracers, "snowDensity", snowDensity, 1) - call MPAS_pool_get_array(tracers, "snowGrainRadius", snowGrainRadius, 1) - - nTracers = 1 - - ! surfaceTemperature - tracerArrayCategory(nTracers,:) = surfaceTemperature(1,:,iCell) - nTracers = nTracers + 1 - - ! iceEnthalpy - tracerArrayCategory(nTracers:nTracers+nIceLayers-1,:) = iceEnthalpy(:,:,iCell) - nTracers = nTracers + nIceLayers - - ! snowEnthalpy - tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) = snowEnthalpy(:,:,iCell) - nTracers = nTracers + nSnowLayers - - ! ice Salinity - tracerArrayCategory(nTracers:nTracers+nIceLayers-1,:) = iceSalinity(:,:,iCell) - nTracers = nTracers + nIceLayers - - ! iceAge - if (config_use_ice_age) then - tracerArrayCategory(nTracers,:) = iceAge(1,:,iCell) - nTracers = nTracers + 1 - endif - - ! firstYearIceArea - if (config_use_first_year_ice) then - tracerArrayCategory(nTracers,:) = firstYearIceArea(1,:,iCell) - nTracers = nTracers + 1 - endif - - ! level ice tracers - if (config_use_level_ice) then - tracerArrayCategory(nTracers,:) = levelIceArea(1,:,iCell) - nTracers = nTracers + 1 - tracerArrayCategory(nTracers,:) = levelIceVolume(1,:,iCell) - nTracers = nTracers + 1 - endif - - ! pond tracers - if (config_use_cesm_meltponds .or. & - config_use_level_meltponds .or. & - config_use_topo_meltponds) then - tracerArrayCategory(nTracers,:) = pondArea(1,:,iCell) - nTracers = nTracers + 1 - tracerArrayCategory(nTracers,:) = pondDepth(1,:,iCell) - nTracers = nTracers + 1 - endif - - ! level or topo ponds - if (config_use_level_meltponds .or. & - config_use_topo_meltponds) then - tracerArrayCategory(nTracers,:) = pondLidThickness(1,:,iCell) - nTracers = nTracers + 1 - end if - - ! snow density (density from compaction) - if (config_use_effective_snow_density) then - tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) = snowDensity(:,:,iCell) - nTracers = nTracers + nSnowLayers - endif - - ! snow grain radius - if (config_use_snow_grain_radius) then - tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) = snowIceMass(:,:,iCell) - nTracers = nTracers + nSnowLayers - tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) = snowLiquidMass(:,:,iCell) - nTracers = nTracers + nSnowLayers - tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) = snowGrainRadius(:,:,iCell) - nTracers = nTracers + nSnowLayers - endif - - ! aerosols - if (config_use_aerosols) then - do iAerosol = 1, nAerosols - - tracerArrayCategory(nTracers+4*(iAerosol-1) ,:) = snowScatteringAerosol(iAerosol,:,iCell) - tracerArrayCategory(nTracers+4*(iAerosol-1)+1,:) = snowBodyAerosol(iAerosol,:,iCell) - tracerArrayCategory(nTracers+4*(iAerosol-1)+2,:) = iceScatteringAerosol(iAerosol,:,iCell) - tracerArrayCategory(nTracers+4*(iAerosol-1)+3,:) = iceBodyAerosol(iAerosol,:,iCell) - - enddo ! iAerosol - endif - - end subroutine set_cice_physics_tracer_array_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_cice_physics_tracer_array_category -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_cice_physics_tracer_array_category(block, tracerArrayCategory, iCell) - - type(block_type), intent(inout) :: & - block - - real(kind=RKIND), dimension(:,:), intent(in) :: & - tracerArrayCategory - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - - integer, pointer :: & - nIceLayers, & - nSnowLayers, & - nAerosols - - type(MPAS_pool_type), pointer :: & - tracers - - real(kind=RKIND), dimension(:,:,:), pointer :: & - surfaceTemperature, & - iceAge, & - firstYearIceArea, & - levelIceArea, & - levelIceVolume, & - pondArea, & - pondDepth, & - pondLidThickness, & - iceEnthalpy, & - snowEnthalpy, & - iceSalinity, & - snowScatteringAerosol, & - snowBodyAerosol, & - iceScatteringAerosol, & - iceBodyAerosol, & - snowIceMass, & - snowLiquidMass, & - snowGrainRadius, & - snowDensity - - integer :: & - nTracers, & - iAerosol - - call MPAS_pool_get_config(block % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(block % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(block % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(block % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(block % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(block % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(block % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(block % dimensions, "nAerosols", nAerosols) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_array(tracers, "surfaceTemperature", surfaceTemperature, 1) - call MPAS_pool_get_array(tracers, "iceEnthalpy", iceEnthalpy, 1) - call MPAS_pool_get_array(tracers, "snowEnthalpy", snowEnthalpy, 1) - call MPAS_pool_get_array(tracers, "iceSalinity", iceSalinity, 1) - call MPAS_pool_get_array(tracers, "iceAge", iceAge, 1) - call MPAS_pool_get_array(tracers, "firstYearIceArea", firstYearIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceArea", levelIceArea, 1) - call MPAS_pool_get_array(tracers, "levelIceVolume", levelIceVolume, 1) - call MPAS_pool_get_array(tracers, "pondArea", pondArea, 1) - call MPAS_pool_get_array(tracers, "pondDepth", pondDepth, 1) - call MPAS_pool_get_array(tracers, "pondLidThickness", pondLidThickness, 1) - call MPAS_pool_get_array(tracers, "snowScatteringAerosol", snowScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "snowBodyAerosol", snowBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "iceScatteringAerosol", iceScatteringAerosol, 1) - call MPAS_pool_get_array(tracers, "iceBodyAerosol", iceBodyAerosol, 1) - call MPAS_pool_get_array(tracers, "snowIceMass", snowIceMass, 1) - call MPAS_pool_get_array(tracers, "snowLiquidMass", snowLiquidMass, 1) - call MPAS_pool_get_array(tracers, "snowDensity", snowDensity, 1) - call MPAS_pool_get_array(tracers, "snowGrainRadius", snowGrainRadius, 1) - - nTracers = 1 - - ! surfaceTemperature - surfaceTemperature(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - - ! iceEnthalpy - iceEnthalpy(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nIceLayers-1,:) - nTracers = nTracers + nIceLayers - - ! snowEnthalpy - snowEnthalpy(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) - nTracers = nTracers + nSnowLayers - - ! ice Salinity - iceSalinity(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nIceLayers-1,:) - nTracers = nTracers + nIceLayers - - ! iceAge - if (config_use_ice_age) then - iceAge(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - endif - - ! firstYearIceArea - if (config_use_first_year_ice) then - firstYearIceArea(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - endif - - ! level ice tracers - if (config_use_level_ice) then - levelIceArea(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - levelIceVolume(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - endif - - ! pond tracers - if (config_use_cesm_meltponds .or. & - config_use_level_meltponds .or. & - config_use_topo_meltponds) then - pondArea(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - pondDepth(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - endif - - ! level or topo ponds - if (config_use_level_meltponds .or. & - config_use_topo_meltponds) then - pondLidThickness(1,:,iCell) = tracerArrayCategory(nTracers,:) - nTracers = nTracers + 1 - end if - - ! snow density (density from compaction) - if (config_use_effective_snow_density) then - snowDensity(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) - nTracers = nTracers + nSnowLayers - endif - - ! snow grain radius - if (config_use_snow_grain_radius) then - snowIceMass(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) - nTracers = nTracers + nSnowLayers - snowLiquidMass(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) - nTracers = nTracers + nSnowLayers - snowGrainRadius(:,:,iCell) = tracerArrayCategory(nTracers:nTracers+nSnowLayers-1,:) - nTracers = nTracers + nSnowLayers - endif - - ! aerosols - if (config_use_aerosols) then - do iAerosol = 1, nAerosols - - snowScatteringAerosol(iAerosol,:,iCell) = tracerArrayCategory(nTracers+4*(iAerosol-1) ,:) - snowBodyAerosol(iAerosol,:,iCell) = tracerArrayCategory(nTracers+4*(iAerosol-1)+1,:) - iceScatteringAerosol(iAerosol,:,iCell) = tracerArrayCategory(nTracers+4*(iAerosol-1)+2,:) - iceBodyAerosol(iAerosol,:,iCell) = tracerArrayCategory(nTracers+4*(iAerosol-1)+3,:) - - enddo ! iAerosol - endif - - end subroutine get_cice_physics_tracer_array_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_cice_physics_tracer_array_cell -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_cice_physics_tracer_array_cell(block, tracerArrayCell, iCell) - - type(block_type), intent(in) :: & - block - - real(kind=RKIND), dimension(:), intent(inout) :: & - tracerArrayCell - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - integer, pointer :: & - nIceLayers, & - nSnowLayers, & - nAerosols - - type(MPAS_pool_type), pointer :: & - tracers_aggregate - - real(kind=RKIND), dimension(:), pointer :: & - surfaceTemperatureCell, & - iceAgeCell, & - firstYearIceAreaCell, & - levelIceAreaCell, & - levelIceVolumeCell, & - pondAreaCell, & - pondDepthCell, & - pondLidThicknessCell - - real(kind=RKIND), dimension(:,:), pointer :: & - iceEnthalpyCell, & - snowEnthalpyCell, & - iceSalinityCell, & - snowScatteringAerosolCell, & - snowBodyAerosolCell, & - iceScatteringAerosolCell, & - iceBodyAerosolCell, & - snowIceMassCell, & - snowLiquidMassCell, & - snowGrainRadiusCell, & - snowDensityCell - - integer :: & - nTracers, & - iAerosol - - call MPAS_pool_get_config(block % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(block % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(block % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(block % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(block % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(block % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(block % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(block % dimensions, "nAerosols", nAerosols) - - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - - call MPAS_pool_get_array(tracers_aggregate, "surfaceTemperatureCell", surfaceTemperatureCell) - call MPAS_pool_get_array(tracers_aggregate, "iceEnthalpyCell", iceEnthalpyCell) - call MPAS_pool_get_array(tracers_aggregate, "snowEnthalpyCell", snowEnthalpyCell) - call MPAS_pool_get_array(tracers_aggregate, "iceSalinityCell", iceSalinityCell) - call MPAS_pool_get_array(tracers_aggregate, "iceAgeCell", iceAgeCell) - call MPAS_pool_get_array(tracers_aggregate, "firstYearIceAreaCell", firstYearIceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "levelIceAreaCell", levelIceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "levelIceVolumeCell", levelIceVolumeCell) - call MPAS_pool_get_array(tracers_aggregate, "pondAreaCell", pondAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "pondDepthCell", pondDepthCell) - call MPAS_pool_get_array(tracers_aggregate, "pondLidThicknessCell", pondLidThicknessCell) - call MPAS_pool_get_array(tracers_aggregate, "snowScatteringAerosolCell", snowScatteringAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "snowBodyAerosolCell", snowBodyAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "iceScatteringAerosolCell", iceScatteringAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "iceBodyAerosolCell", iceBodyAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "snowIceMassCell", snowIceMassCell) - call MPAS_pool_get_array(tracers_aggregate, "snowLiquidMassCell", snowLiquidMassCell) - call MPAS_pool_get_array(tracers_aggregate, "snowDensityCell", snowDensityCell) - call MPAS_pool_get_array(tracers_aggregate, "snowGrainRadiusCell", snowGrainRadiusCell) - - nTracers = 1 - - ! surfaceTemperature - tracerArrayCell(nTracers) = surfaceTemperatureCell(iCell) - nTracers = nTracers + 1 - - ! iceEnthalpy - tracerArrayCell(nTracers:nTracers+nIceLayers-1) = iceEnthalpyCell(:,iCell) - nTracers = nTracers + nIceLayers - - ! snowEnthalpy - tracerArrayCell(nTracers:nTracers+nSnowLayers-1) = snowEnthalpyCell(:,iCell) - nTracers = nTracers + nSnowLayers - - ! ice Salinity - tracerArrayCell(nTracers:nTracers+nIceLayers-1) = iceSalinityCell(:,iCell) - nTracers = nTracers + nIceLayers - - ! iceAge - if (config_use_ice_age) then - tracerArrayCell(nTracers) = iceAgeCell(iCell) - nTracers = nTracers + 1 - endif - - ! firstYearIceArea - if (config_use_first_year_ice) then - tracerArrayCell(nTracers) = firstYearIceAreaCell(iCell) - nTracers = nTracers + 1 - endif - - ! level ice tracers - if (config_use_level_ice) then - tracerArrayCell(nTracers) = levelIceAreaCell(iCell) - nTracers = nTracers + 1 - tracerArrayCell(nTracers) = levelIceVolumeCell(iCell) - nTracers = nTracers + 1 - endif - - ! pond tracers - if (config_use_cesm_meltponds .or. & - config_use_level_meltponds .or. & - config_use_topo_meltponds) then - tracerArrayCell(nTracers) = pondAreaCell(iCell) - nTracers = nTracers + 1 - tracerArrayCell(nTracers) = pondDepthCell(iCell) - nTracers = nTracers + 1 - endif - - ! level or topo ponds - if (config_use_level_meltponds .or. & - config_use_topo_meltponds) then - tracerArrayCell(nTracers) = pondLidThicknessCell(iCell) - nTracers = nTracers + 1 - end if - - ! snow density (density from compaction) - if (config_use_effective_snow_density) then - tracerArrayCell(nTracers:nTracers+nSnowLayers-1) = snowDensityCell(:,iCell) - nTracers = nTracers + nSnowLayers - endif - - ! snow grain radius - if (config_use_snow_grain_radius) then - tracerArrayCell(nTracers:nTracers+nSnowLayers-1) = snowIceMassCell(:,iCell) - nTracers = nTracers + nSnowLayers - tracerArrayCell(nTracers:nTracers+nSnowLayers-1) = snowLiquidMassCell(:,iCell) - nTracers = nTracers + nSnowLayers - tracerArrayCell(nTracers:nTracers+nSnowLayers-1) = snowGrainRadiusCell(:,iCell) - nTracers = nTracers + nSnowLayers - endif - - ! aerosols - if (config_use_aerosols) then - do iAerosol = 1, nAerosols - - tracerArrayCell(nTracers+4*(iAerosol-1) ) = snowScatteringAerosolCell(iAerosol,iCell) - tracerArrayCell(nTracers+4*(iAerosol-1)+1) = snowBodyAerosolCell(iAerosol,iCell) - tracerArrayCell(nTracers+4*(iAerosol-1)+2) = iceScatteringAerosolCell(iAerosol,iCell) - tracerArrayCell(nTracers+4*(iAerosol-1)+3) = iceBodyAerosolCell(iAerosol,iCell) - - enddo ! iAerosol - endif - - end subroutine set_cice_physics_tracer_array_cell - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_cice_physics_tracer_array_cell -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 4th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_cice_physics_tracer_array_cell(block, tracerArrayCell, iCell) - - type(block_type), intent(inout) :: & - block - - real(kind=RKIND), dimension(:), intent(in) :: & - tracerArrayCell - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - integer, pointer :: & - nIceLayers, & - nSnowLayers, & - nAerosols - - type(MPAS_pool_type), pointer :: & - tracers_aggregate - - real(kind=RKIND), dimension(:), pointer :: & - surfaceTemperatureCell, & - iceAgeCell, & - firstYearIceAreaCell, & - levelIceAreaCell, & - levelIceVolumeCell, & - pondAreaCell, & - pondDepthCell, & - pondLidThicknessCell - - real(kind=RKIND), dimension(:,:), pointer :: & - iceEnthalpyCell, & - snowEnthalpyCell, & - iceSalinityCell, & - snowScatteringAerosolCell, & - snowBodyAerosolCell, & - iceScatteringAerosolCell, & - iceBodyAerosolCell, & - snowIceMassCell, & - snowLiquidMassCell, & - snowGrainRadiusCell, & - snowDensityCell - - integer :: & - nTracers, & - iAerosol - - call MPAS_pool_get_config(block % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(block % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(block % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(block % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(block % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(block % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(block % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(block % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(block % dimensions, "nAerosols", nAerosols) - - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - - call MPAS_pool_get_array(tracers_aggregate, "surfaceTemperatureCell", surfaceTemperatureCell) - call MPAS_pool_get_array(tracers_aggregate, "iceEnthalpyCell", iceEnthalpyCell) - call MPAS_pool_get_array(tracers_aggregate, "snowEnthalpyCell", snowEnthalpyCell) - call MPAS_pool_get_array(tracers_aggregate, "iceSalinityCell", iceSalinityCell) - call MPAS_pool_get_array(tracers_aggregate, "iceAgeCell", iceAgeCell) - call MPAS_pool_get_array(tracers_aggregate, "firstYearIceAreaCell", firstYearIceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "levelIceAreaCell", levelIceAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "levelIceVolumeCell", levelIceVolumeCell) - call MPAS_pool_get_array(tracers_aggregate, "pondAreaCell", pondAreaCell) - call MPAS_pool_get_array(tracers_aggregate, "pondDepthCell", pondDepthCell) - call MPAS_pool_get_array(tracers_aggregate, "pondLidThicknessCell", pondLidThicknessCell) - call MPAS_pool_get_array(tracers_aggregate, "snowScatteringAerosolCell", snowScatteringAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "snowBodyAerosolCell", snowBodyAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "iceScatteringAerosolCell", iceScatteringAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "iceBodyAerosolCell", iceBodyAerosolCell) - call MPAS_pool_get_array(tracers_aggregate, "snowIceMassCell", snowIceMassCell) - call MPAS_pool_get_array(tracers_aggregate, "snowLiquidMassCell", snowLiquidMassCell) - call MPAS_pool_get_array(tracers_aggregate, "snowDensityCell", snowDensityCell) - call MPAS_pool_get_array(tracers_aggregate, "snowGrainRadiusCell", snowGrainRadiusCell) - - nTracers = 1 - - ! surfaceTemperature - surfaceTemperatureCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - - ! iceEnthalpy - iceEnthalpyCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nIceLayers-1) - nTracers = nTracers + nIceLayers - - ! snowEnthalpy - snowEnthalpyCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nSnowLayers-1) - nTracers = nTracers + nSnowLayers - - ! ice Salinity - iceSalinityCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nIceLayers-1) - nTracers = nTracers + nIceLayers - - ! iceAge - if (config_use_ice_age) then - iceAgeCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - endif - - ! firstYearIceArea - if (config_use_first_year_ice) then - firstYearIceAreaCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - endif - - ! level ice tracers - if (config_use_level_ice) then - levelIceAreaCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - levelIceVolumeCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - endif - - ! pond tracers - if (config_use_cesm_meltponds .or. & - config_use_level_meltponds .or. & - config_use_topo_meltponds) then - pondAreaCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - pondDepthCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - endif - - ! level or topo ponds - if (config_use_level_meltponds .or. & - config_use_topo_meltponds) then - pondLidThicknessCell(iCell) = tracerArrayCell(nTracers) - nTracers = nTracers + 1 - end if - - ! snow density (density from compaction) - if (config_use_effective_snow_density) then - snowDensityCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nSnowLayers-1) - nTracers = nTracers + nSnowLayers - endif - - ! snow grain radius - if (config_use_snow_grain_radius) then - snowIceMassCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nSnowLayers-1) - nTracers = nTracers + nSnowLayers - snowLiquidMassCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nSnowLayers-1) - nTracers = nTracers + nSnowLayers - snowGrainRadiusCell(:,iCell) = tracerArrayCell(nTracers:nTracers+nSnowLayers-1) - nTracers = nTracers + nSnowLayers - endif - - ! aerosols - if (config_use_aerosols) then - do iAerosol = 1, nAerosols - - snowScatteringAerosolCell(iAerosol,iCell) = tracerArrayCell(nTracers+4*(iAerosol-1) ) - snowBodyAerosolCell(iAerosol,iCell) = tracerArrayCell(nTracers+4*(iAerosol-1)+1) - iceScatteringAerosolCell(iAerosol,iCell) = tracerArrayCell(nTracers+4*(iAerosol-1)+2) - iceBodyAerosolCell(iAerosol,iCell) = tracerArrayCell(nTracers+4*(iAerosol-1)+3) - - enddo ! iAerosol - endif - - end subroutine get_cice_physics_tracer_array_cell - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_cice_biogeochemistry_array_category -! -!> \brief -!> \author Nicole Jeffery -!> \date 12th September 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_cice_biogeochemistry_tracer_array_category(block, tracerObject, tracerArrayCategory, iCell) - - type(block_type), intent(in) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:,:), intent(inout) :: & - tracerArrayCategory - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_skeletal_biochemistry, & - config_use_vertical_biochemistry, & - config_use_vertical_zsalinity, & - config_use_vertical_tracers, & - config_use_brine, & - config_use_nitrate, & - config_use_carbon, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - integer, pointer :: & - nBioLayersP3, & - nBioLayers, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nzAerosols - - type(MPAS_pool_type), pointer :: & - tracers - - real(kind=RKIND), dimension(:,:,:), pointer :: & - skeletalAlgaeConc, & - skeletalDOCConc, & - skeletalDICConc, & - skeletalDONConc, & - skeletalDissolvedIronConc, & - skeletalParticulateIronConc, & - skeletalNitrateConc, & - skeletalSilicateConc, & - skeletalAmmoniumConc, & - skeletalDMSConc, & - skeletalDMSPpConc, & - skeletalDMSPdConc, & - skeletalNonreactiveConc, & - skeletalHumicsConc, & - verticalAlgaeConc, & - verticalDOCConc, & - verticalDICConc, & - verticalDONConc, & - verticalNitrateConc, & - verticalSilicateConc, & - verticalAmmoniumConc, & - verticalDMSConc, & - verticalDMSPpConc, & - verticalDMSPdConc, & - verticalNonreactiveConc, & - verticalHumicsConc, & - verticalParticulateIronConc, & - verticalDissolvedIronConc, & - verticalAerosolsConc, & - verticalSalinity, & - brineFraction, & - mobileFraction - - integer :: & - iBioTracers, & - iBioCount, & - iLayers - - call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_ammonium",config_use_ammonium) - call MPAS_pool_get_config(block % configs, "config_use_silicate",config_use_silicate) - call MPAS_pool_get_config(block % configs, "config_use_DMS",config_use_DMS) - call MPAS_pool_get_config(block % configs, "config_use_nonreactive",config_use_nonreactive) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_use_DON",config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_iron",config_use_iron) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(block % dimensions, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - call MPAS_pool_get_dimension(block % dimensions, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(block % dimensions, "nDissolvedIron", nDissolvedIron) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_array(tracers, "skeletalAlgaeConc", skeletalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDOCConc", skeletalDOCConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDICConc", skeletalDICConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDONConc", skeletalDONConc, 1) - call MPAS_pool_get_array(tracers, "skeletalNitrateConc", skeletalNitrateConc, 1) - call MPAS_pool_get_array(tracers, "skeletalSilicateConc", skeletalSilicateConc, 1) - call MPAS_pool_get_array(tracers, "skeletalAmmoniumConc", skeletalAmmoniumConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDMSConc", skeletalDMSConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDMSPpConc", skeletalDMSPpConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDMSPdConc", skeletalDMSPdConc, 1) - call MPAS_pool_get_array(tracers, "skeletalNonreactiveConc", skeletalNonreactiveConc, 1) - call MPAS_pool_get_array(tracers, "skeletalHumicsConc", skeletalHumicsConc, 1) - call MPAS_pool_get_array(tracers, "skeletalParticulateIronConc", skeletalParticulateIronConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDissolvedIronConc", skeletalDissolvedIronConc, 1) - call MPAS_pool_get_array(tracers, "verticalAlgaeConc", verticalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "verticalDOCConc", verticalDOCConc, 1) - call MPAS_pool_get_array(tracers, "verticalDICConc", verticalDICConc, 1) - call MPAS_pool_get_array(tracers, "verticalDONConc", verticalDONConc, 1) - call MPAS_pool_get_array(tracers, "verticalNitrateConc", verticalNitrateConc, 1) - call MPAS_pool_get_array(tracers, "verticalSilicateConc", verticalSilicateConc, 1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumConc", verticalAmmoniumConc, 1) - call MPAS_pool_get_array(tracers, "verticalDMSConc", verticalDMSConc, 1) - call MPAS_pool_get_array(tracers, "verticalDMSPpConc", verticalDMSPpConc, 1) - call MPAS_pool_get_array(tracers, "verticalDMSPdConc", verticalDMSPdConc, 1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveConc", verticalNonreactiveConc, 1) - call MPAS_pool_get_array(tracers, "verticalHumicsConc", verticalHumicsConc, 1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronConc", verticalParticulateIronConc, 1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronConc", verticalDissolvedIronConc, 1) - call MPAS_pool_get_array(tracers, "verticalAerosolsConc", verticalAerosolsConc, 1) - call MPAS_pool_get_array(tracers, "verticalSalinity", verticalSalinity, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - call MPAS_pool_get_array(tracers, "mobileFraction", mobileFraction, 1) - - ! biogeochemistry - - ! brine height fraction - if (config_use_brine) & - tracerArrayCategory(tracerObject % index_brineFraction,:) = brineFraction(1,:,iCell) - - if (config_use_skeletal_biochemistry) then - - ! algal nitrogen - do iBioTracers = 1, nAlgae - tracerArrayCategory(tracerObject % index_algaeConc(iBioTracers),:) = & - skeletalAlgaeConc(iBioTracers,:,iCell) - enddo - - ! nitrate - if (config_use_nitrate) & - tracerArrayCategory(tracerObject % index_nitrateConc,:) = skeletalNitrateConc(1,:,iCell) - - ! DOC - if (config_use_carbon) then - do iBioTracers = 1, nDOC - tracerArrayCategory(tracerObject % index_DOCConc(iBioTracers),:) = skeletalDOCConc(iBioTracers,:,iCell) - enddo - - ! DIC - do iBioTracers = 1, nDIC - tracerArrayCategory(tracerObject % index_DICConc(iBioTracers),:) = skeletalDICConc(iBioTracers,:,iCell) - enddo - endif - - ! DON - if (config_use_DON) then - do iBioTracers = 1, nDON - tracerArrayCategory(tracerObject % index_DONConc(iBioTracers),:) = skeletalDONConc(iBioTracers,:,iCell) - enddo - endif - - ! ammonium - if (config_use_ammonium) & - tracerArrayCategory(tracerObject % index_ammoniumConc,:) = skeletalAmmoniumConc(1,:,iCell) - - ! silicate - if (config_use_silicate) & - tracerArrayCategory(tracerObject % index_silicateConc,:) = skeletalSilicateConc(1,:,iCell) - - ! DMS, DMSPp, DMSPd - if (config_use_DMS) then - tracerArrayCategory(tracerObject % index_DMSConc,:) = skeletalDMSConc(1,:,iCell) - tracerArrayCategory(tracerObject % index_DMSPpConc,:) = skeletalDMSPpConc(1,:,iCell) - tracerArrayCategory(tracerObject % index_DMSPdConc,:) = skeletalDMSPdConc(1,:,iCell) - endif - - ! nonreactive mobile tracer - if (config_use_nonreactive) & - tracerArrayCategory(tracerObject % index_nonreactiveConc,:) = skeletalNonreactiveConc(1,:,iCell) - ! humic material - if (config_use_humics) & - tracerArrayCategory(tracerObject % index_humicsConc,:) = skeletalHumicsConc(1,:,iCell) - - ! Particulate and dissovled Iron - if (config_use_iron) then - do iBioTracers = 1, nParticulateIron - tracerArrayCategory(tracerObject % index_particulateIronConc(iBioTracers),:) = & - skeletalParticulateIronConc(iBioTracers,:,iCell) - enddo - do iBioTracers = 1, nDissolvedIron - tracerArrayCategory(tracerObject % index_dissolvedIronConc(iBioTracers),:) = & - skeletalDissolvedIronConc(iBioTracers,:,iCell) - enddo - endif - - elseif (config_use_vertical_tracers) then - - ! Fraction of biogeochemical tracer in the mobile phase - do iLayers = 1, tracerObject % nBioTracers - tracerArrayCategory(tracerObject % index_mobileFraction+iLayers-1,:) = mobileFraction(iLayers,:,iCell) - enddo - - ! algal nitrogen - if (config_use_vertical_biochemistry) then - iBioCount = 0 - do iBioTracers = 1, nAlgae - do iLayers = 1,nBioLayersP3 - iBiocount = iBiocount + 1 - tracerArrayCategory(tracerObject % index_algaeConc(iBioTracers)+iLayers-1,:) = & - verticalAlgaeConc(iBioCount,:,iCell) - enddo - enddo - endif - - ! nitrate - if (config_use_nitrate) then - do iLayers = 1, nBioLayersP3 - tracerArrayCategory(tracerObject % index_nitrateConc + iLayers-1,:) = & - verticalNitrateConc(iLayers,:,iCell) - enddo - endif - - ! DOC - if (config_use_carbon) then - iBioCount = 0 - do iBioTracers = 1, nDOC - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCategory(tracerObject % index_DOCConc(iBioTracers) + iLayers-1,:) = & - verticalDOCConc(iBioCount,:,iCell) - enddo - enddo - iBioCount = 0 - - ! DIC - do iBioTracers = 1, nDIC - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCategory(tracerObject % index_DICConc(iBioTracers) + iLayers-1,:) = & - verticalDICConc(iBioCount,:,iCell) - enddo - enddo - endif - - ! DON - if (config_use_DON) then - iBioCount = 0 - do iBioTracers = 1, nDON - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCategory(tracerObject % index_DONConc(iBioTracers) + iLayers-1,:) = & - verticalDONConc(iBioCount,:,iCell) - enddo - enddo - endif - - ! ammonium - if (config_use_ammonium) then - do iLayers = 1, nBioLayersP3 - tracerArrayCategory(tracerObject % index_ammoniumConc + iLayers-1,:) = & - verticalAmmoniumConc(iLayers,:,iCell) - enddo - endif - - ! silicate - if (config_use_silicate) then - do iLayers = 1, nBioLayersP3 - tracerArrayCategory(tracerObject % index_silicateConc+iLayers-1,:) = & - verticalSilicateConc(iLayers,:,iCell) - enddo - endif - - ! DMS, DMSPp, DMSPd - if (config_use_DMS) then - do iLayers = 1, nBioLayersP3 - tracerArrayCategory(tracerObject % index_DMSConc+iLayers-1,:) = verticalDMSConc(iLayers,:,iCell) - tracerArrayCategory(tracerObject % index_DMSPpConc+iLayers-1,:) = verticalDMSPpConc(iLayers,:,iCell) - tracerArrayCategory(tracerObject % index_DMSPdConc+iLayers-1,:) = verticalDMSPdConc(iLayers,:,iCell) - enddo - endif - - ! nonreactive purely mobile tracers - if (config_use_nonreactive) then - do iLayers = 1, nBioLayersP3 - tracerArrayCategory(tracerObject % index_nonreactiveConc+iLayers-1,:) = & - verticalNonreactiveConc(iLayers,:,iCell) - enddo - endif - - ! humic material - if (config_use_humics) then - do iLayers = 1, nBioLayersP3 - tracerArrayCategory(tracerObject % index_humicsConc+iLayers-1,:) = verticalHumicsConc(iLayers,:,iCell) - enddo - endif - - ! particulate and dissolved Iron - if (config_use_iron) then - iBioCount = 0 - do iBioTracers = 1, nParticulateIron - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCategory(tracerObject % index_particulateIronConc(iBioTracers)+iLayers-1,:) = & - verticalParticulateIronConc(iBioCount,:,iCell) - enddo - enddo - iBioCount = 0 - do iBioTracers = 1, nDissolvedIron - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCategory(tracerObject % index_dissolvedIronConc(iBioTracers)+iLayers-1,:) = & - verticalDissolvedIronConc(iBioCount,:,iCell) - enddo - enddo - endif - - ! black carbon and dust aerosols - if (config_use_zaerosols) then - iBioCount = 0 - do iBioTracers = 1, nzAerosols - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCategory(tracerObject % index_verticalAerosolsConc(iBioTracers)+iLayers-1,:) = & - verticalAerosolsConc(iBioCount,:,iCell) - enddo - enddo - endif - - ! salinity used with BL99 thermodynamics - if (config_use_vertical_zsalinity) then - do iLayers = 1, nBioLayers - tracerArrayCategory(tracerObject % index_verticalSalinity+iLayers-1,:) = & - verticalSalinity(iLayers,:,iCell) - enddo - endif - endif - - end subroutine set_cice_biogeochemistry_tracer_array_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_cice_biogeochemistry_array_category -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 23rd September 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_cice_biogeochemistry_tracer_array_category(block, tracerObject, tracerArrayCategory, iCell) - - type(block_type), intent(inout) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:,:), intent(in) :: & - tracerArrayCategory - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_skeletal_biochemistry, & - config_use_vertical_biochemistry, & - config_use_vertical_zsalinity, & - config_use_vertical_tracers, & - config_use_brine, & - config_use_nitrate, & - config_use_carbon, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - integer, pointer :: & - nBioLayersP3, & - nBioLayers, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nzAerosols - - type(MPAS_pool_type), pointer :: & - tracers - - real(kind=RKIND), dimension(:,:,:), pointer :: & - skeletalAlgaeConc, & - skeletalDOCConc, & - skeletalDICConc, & - skeletalDONConc, & - skeletalDissolvedIronConc, & - skeletalParticulateIronConc, & - skeletalNitrateConc, & - skeletalSilicateConc, & - skeletalAmmoniumConc, & - skeletalDMSConc, & - skeletalDMSPpConc, & - skeletalDMSPdConc, & - skeletalNonreactiveConc, & - skeletalHumicsConc, & - verticalAlgaeConc, & - verticalDOCConc, & - verticalDICConc, & - verticalDONConc, & - verticalNitrateConc, & - verticalSilicateConc, & - verticalAmmoniumConc, & - verticalDMSConc, & - verticalDMSPpConc, & - verticalDMSPdConc, & - verticalNonreactiveConc, & - verticalHumicsConc, & - verticalParticulateIronConc, & - verticalDissolvedIronConc, & - verticalAerosolsConc, & - verticalSalinity, & - brineFraction, & - mobileFraction - - integer :: & - iBioTracers, & - iBioCount, & - iLayers - - call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_ammonium",config_use_ammonium) - call MPAS_pool_get_config(block % configs, "config_use_silicate",config_use_silicate) - call MPAS_pool_get_config(block % configs, "config_use_DMS",config_use_DMS) - call MPAS_pool_get_config(block % configs, "config_use_nonreactive",config_use_nonreactive) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_use_DON",config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_iron",config_use_iron) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(block % dimensions, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - call MPAS_pool_get_dimension(block % dimensions, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(block % dimensions, "nDissolvedIron", nDissolvedIron) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_array(tracers, "skeletalAlgaeConc", skeletalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDOCConc", skeletalDOCConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDICConc", skeletalDICConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDONConc", skeletalDONConc, 1) - call MPAS_pool_get_array(tracers, "skeletalNitrateConc", skeletalNitrateConc, 1) - call MPAS_pool_get_array(tracers, "skeletalSilicateConc", skeletalSilicateConc, 1) - call MPAS_pool_get_array(tracers, "skeletalAmmoniumConc", skeletalAmmoniumConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDMSConc", skeletalDMSConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDMSPpConc", skeletalDMSPpConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDMSPdConc", skeletalDMSPdConc, 1) - call MPAS_pool_get_array(tracers, "skeletalNonreactiveConc", skeletalNonreactiveConc, 1) - call MPAS_pool_get_array(tracers, "skeletalHumicsConc", skeletalHumicsConc, 1) - call MPAS_pool_get_array(tracers, "skeletalParticulateIronConc", skeletalParticulateIronConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDissolvedIronConc", skeletalDissolvedIronConc, 1) - call MPAS_pool_get_array(tracers, "verticalAlgaeConc", verticalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "verticalDOCConc", verticalDOCConc, 1) - call MPAS_pool_get_array(tracers, "verticalDICConc", verticalDICConc, 1) - call MPAS_pool_get_array(tracers, "verticalDONConc", verticalDONConc, 1) - call MPAS_pool_get_array(tracers, "verticalNitrateConc", verticalNitrateConc, 1) - call MPAS_pool_get_array(tracers, "verticalSilicateConc", verticalSilicateConc, 1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumConc", verticalAmmoniumConc, 1) - call MPAS_pool_get_array(tracers, "verticalDMSConc", verticalDMSConc, 1) - call MPAS_pool_get_array(tracers, "verticalDMSPpConc", verticalDMSPpConc, 1) - call MPAS_pool_get_array(tracers, "verticalDMSPdConc", verticalDMSPdConc, 1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveConc", verticalNonreactiveConc, 1) - call MPAS_pool_get_array(tracers, "verticalHumicsConc", verticalHumicsConc, 1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronConc", verticalParticulateIronConc, 1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronConc", verticalDissolvedIronConc, 1) - call MPAS_pool_get_array(tracers, "verticalAerosolsConc", verticalAerosolsConc, 1) - call MPAS_pool_get_array(tracers, "verticalSalinity", verticalSalinity, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - call MPAS_pool_get_array(tracers, "mobileFraction", mobileFraction, 1) - - ! biogeochemistry - ! brine height fraction - if (config_use_brine) & - brineFraction(1,:,iCell) = tracerArrayCategory(tracerObject % index_brineFraction,:) - - if (config_use_skeletal_biochemistry) then - - ! algal nitrogen - do iBioTracers = 1, nAlgae - skeletalAlgaeConc(iBioTracers,:,iCell) = & - tracerArrayCategory(tracerObject % index_algaeConc(iBioTracers),:) - enddo - - ! nitrate - if (config_use_nitrate) & - skeletalNitrateConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_nitrateConc,:) - - if (config_use_carbon) then - - ! DOC - do iBioTracers = 1, nDOC - skeletalDOCConc(iBioTracers,:,iCell) = & - tracerArrayCategory(tracerObject % index_DOCConc(iBioTracers),:) - enddo - - ! DIC - do iBioTracers = 1, nDIC - skeletalDICConc(iBioTracers,:,iCell) = & - tracerArrayCategory(tracerObject % index_DICConc(iBioTracers),:) - enddo - endif - - ! DON - if (config_use_DON) then - do iBioTracers = 1, nDON - skeletalDONConc(iBioTracers,:,iCell) = tracerArrayCategory(tracerObject % index_DONConc(iBioTracers),:) - enddo - endif - - ! ammonium - if (config_use_ammonium) & - skeletalAmmoniumConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_ammoniumConc,:) - ! silicate - if (config_use_silicate) & - skeletalSilicateConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_silicateConc,:) - ! DNS, DMSPp, DMSPd - if (config_use_DMS) then - skeletalDMSConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_DMSConc,:) - skeletalDMSPpConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_DMSPpConc,:) - skeletalDMSPdConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_DMSPdConc,:) - endif - - ! nonreactive tracer - if (config_use_nonreactive) & - skeletalNonreactiveConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_nonreactiveConc,:) - ! humic material - if (config_use_humics) & - skeletalHumicsConc(1,:,iCell) = tracerArrayCategory(tracerObject % index_humicsConc,:) - - if (config_use_iron) then - - ! Particulate Iron - do iBioTracers = 1, nParticulateIron - skeletalParticulateIronConc(iBioTracers,:,iCell) = & - tracerArrayCategory(tracerObject % index_particulateIronConc(iBioTracers),:) - enddo - - ! Dissolved Iron - do iBioTracers = 1, nDissolvedIron - skeletalDissolvedIronConc(iBioTracers,:,iCell) = & - tracerArrayCategory(tracerObject % index_dissolvedIronConc(iBioTracers),:) - enddo - endif - - elseif (config_use_vertical_tracers) then - - ! fraction of biogeochemical tracer in the mobile phase - do iLayers = 1, tracerObject % nBioTracers - mobileFraction(iLayers,:,iCell) = tracerArrayCategory(tracerObject % index_mobileFraction+iLayers-1,:) - enddo - - if (config_use_vertical_biochemistry) then - iBioCount = 0 - - ! algal nitrogen - do iBioTracers = 1, nAlgae - do iLayers = 1,nBioLayersP3 - iBiocount = iBiocount + 1 - verticalAlgaeConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_algaeConc(iBioTracers)+iLayers-1,:) - enddo - enddo - endif - - ! nitrate - if (config_use_nitrate) then - do iLayers = 1, nBioLayersP3 - verticalNitrateConc(iLayers,:,iCell) = & - tracerArrayCategory(tracerObject % index_nitrateConc + iLayers-1,:) - enddo - endif - - if (config_use_carbon) then - iBioCount = 0 - - ! DOC - do iBioTracers = 1, nDOC - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDOCConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_DOCConc(iBioTracers) + iLayers-1,:) - enddo - enddo - iBioCount = 0 - - ! DIC - do iBioTracers = 1, nDIC - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDICConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_DICConc(iBioTracers) + iLayers-1,:) - enddo - enddo - endif - - ! DON - if (config_use_DON) then - iBioCount = 0 - do iBioTracers = 1, nDON - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDONConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_DONConc(iBioTracers) + iLayers-1,:) - enddo - enddo - endif - - ! ammonium - if (config_use_ammonium) then - do iLayers = 1, nBioLayersP3 - verticalAmmoniumConc(iLayers,:,iCell) = & - tracerArrayCategory(tracerObject % index_ammoniumConc + iLayers-1,:) - enddo - endif - - ! silicate - if (config_use_silicate) then - do iLayers = 1, nBioLayersP3 - verticalSilicateConc(iLayers,:,iCell) = & - tracerArrayCategory(tracerObject % index_silicateConc+iLayers-1,:) - enddo - endif - - ! DMS, DMSPp, DMSPd - if (config_use_DMS) then - do iLayers = 1, nBioLayersP3 - verticalDMSConc(iLayers,:,iCell) = tracerArrayCategory(tracerObject % index_DMSConc+iLayers-1,:) - verticalDMSPpConc(iLayers,:,iCell) = tracerArrayCategory(tracerObject % index_DMSPpConc+iLayers-1,:) - verticalDMSPdConc(iLayers,:,iCell) = tracerArrayCategory(tracerObject % index_DMSPdConc+iLayers-1,:) - enddo - endif - - ! nonreactive tracer - if (config_use_nonreactive) then - do iLayers = 1, nBioLayersP3 - verticalNonreactiveConc(iLayers,:,iCell) = & - tracerArrayCategory(tracerObject % index_nonreactiveConc+iLayers-1,:) - enddo - endif - - ! humic material - if (config_use_humics) then - do iLayers = 1, nBioLayersP3 - verticalHumicsConc(iLayers,:,iCell) = tracerArrayCategory(tracerObject % index_humicsConc+iLayers-1,:) - enddo - endif - - if (config_use_iron) then - iBioCount = 0 - - ! particulate iron - do iBioTracers = 1, nParticulateIron - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalParticulateIronConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_particulateIronConc(iBioTracers)+iLayers-1,:) - enddo - enddo - iBioCount = 0 - - ! dissolved iron - do iBioTracers = 1, nDissolvedIron - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDissolvedIronConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_dissolvedIronConc(iBioTracers)+iLayers-1,:) - enddo - enddo - endif - - ! black carbon and dust aerosols - if (config_use_zaerosols) then - iBioCount = 0 - do iBioTracers = 1, nzAerosols - do iLayers = 1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalAerosolsConc(iBioCount,:,iCell) = & - tracerArrayCategory(tracerObject % index_verticalAerosolsConc(iBioTracers)+iLayers-1,:) - enddo - enddo - endif - - ! salinity used with BL99 thermodynamics - if (config_use_vertical_zsalinity) then - do iLayers = 1, nBioLayers - verticalSalinity(iLayers,:,iCell) = & - tracerArrayCategory(tracerObject % index_verticalSalinity+iLayers-1,:) - enddo - endif - endif - - end subroutine get_cice_biogeochemistry_tracer_array_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_cice_biogeochemistry_array_cell -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 23rd September 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, tracerArrayCell, iCell) - - type(block_type), intent(in) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:), intent(inout) :: & - tracerArrayCell - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_skeletal_biochemistry, & - config_use_vertical_biochemistry, & - config_use_vertical_zsalinity, & - config_use_vertical_tracers, & - config_use_brine, & - config_use_nitrate, & - config_use_carbon, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - integer, pointer :: & - nBioLayersP3, & - nBioLayersP1, & - nBioLayers, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nzAerosols - - type(MPAS_pool_type), pointer :: & - tracers_aggregate - - real(kind=RKIND), dimension(:), pointer :: & - brineFractionCell - - real(kind=RKIND), dimension(:,:), pointer :: & - skeletalAlgaeConcCell, & - skeletalDOCConcCell, & - skeletalDICConcCell, & - skeletalDONConcCell, & - skeletalDissolvedIronConcCell, & - skeletalParticulateIronConcCell, & - skeletalNitrateConcCell, & - skeletalSilicateConcCell, & - skeletalAmmoniumConcCell, & - skeletalDMSConcCell, & - skeletalDMSPpConcCell, & - skeletalDMSPdConcCell, & - skeletalNonreactiveConcCell, & - skeletalHumicsConcCell, & - verticalAlgaeConcCell, & - verticalDOCConcCell, & - verticalDICConcCell, & - verticalDONConcCell, & - verticalNitrateConcCell, & - verticalSilicateConcCell, & - verticalAmmoniumConcCell, & - verticalDMSConcCell, & - verticalDMSPpConcCell, & - verticalDMSPdConcCell, & - verticalNonreactiveConcCell, & - verticalHumicsConcCell, & - verticalParticulateIronConcCell, & - verticalDissolvedIronConcCell, & - verticalAerosolsConcCell, & - verticalSalinityCell, & - verticalAlgaeIceCell, & - verticalDOCIceCell, & - verticalDICIceCell, & - verticalDONIceCell, & - verticalNitrateIceCell, & - verticalSilicateIceCell, & - verticalAmmoniumIceCell, & - verticalDMSIceCell, & - verticalDMSPpIceCell, & - verticalDMSPdIceCell, & - verticalNonreactiveIceCell, & - verticalHumicsIceCell, & - verticalParticulateIronIceCell, & - verticalDissolvedIronIceCell, & - verticalAerosolsIceCell - - integer :: & - iBioTracers, & - iBioCount, & - iLayers, & - iSnowCount, & - iIceCount, & - iBioData - - call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_ammonium",config_use_ammonium) - call MPAS_pool_get_config(block % configs, "config_use_silicate",config_use_silicate) - call MPAS_pool_get_config(block % configs, "config_use_DMS",config_use_DMS) - call MPAS_pool_get_config(block % configs, "config_use_nonreactive",config_use_nonreactive) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_use_DON",config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_iron",config_use_iron) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(block % dimensions, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - call MPAS_pool_get_dimension(block % dimensions, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(block % dimensions, "nDissolvedIron", nDissolvedIron) - - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - - call MPAS_pool_get_array(tracers_aggregate, "skeletalAlgaeConcCell", skeletalAlgaeConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDOCConcCell", skeletalDOCConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDICConcCell", skeletalDICConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDONConcCell", skeletalDONConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalNitrateConcCell", skeletalNitrateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalSilicateConcCell", skeletalSilicateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalAmmoniumConcCell", skeletalAmmoniumConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDMSConcCell", skeletalDMSConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDMSPpConcCell", skeletalDMSPpConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDMSPdConcCell", skeletalDMSPdConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalNonreactiveConcCell", skeletalNonreactiveConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalHumicsConcCell", skeletalHumicsConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalParticulateIronConcCell", skeletalParticulateIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDissolvedIronConcCell", skeletalDissolvedIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAlgaeConcCell", verticalAlgaeConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDOCConcCell", verticalDOCConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDICConcCell", verticalDICConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDONConcCell", verticalDONConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNitrateConcCell", verticalNitrateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSilicateConcCell", verticalSilicateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAmmoniumConcCell", verticalAmmoniumConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSConcCell", verticalDMSConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPpConcCell", verticalDMSPpConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPdConcCell", verticalDMSPdConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNonreactiveConcCell", verticalNonreactiveConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalHumicsConcCell", verticalHumicsConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalParticulateIronConcCell", verticalParticulateIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDissolvedIronConcCell", verticalDissolvedIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsConcCell", verticalAerosolsConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAlgaeIceCell", verticalAlgaeIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDOCIceCell", verticalDOCIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDICIceCell", verticalDICIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDONIceCell", verticalDONIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNitrateIceCell", verticalNitrateIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSilicateIceCell", verticalSilicateIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAmmoniumIceCell", verticalAmmoniumIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSIceCell", verticalDMSIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPpIceCell", verticalDMSPpIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPdIceCell", verticalDMSPdIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNonreactiveIceCell", verticalNonreactiveIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalHumicsIceCell", verticalHumicsIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalParticulateIronIceCell", verticalParticulateIronIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDissolvedIronIceCell", verticalDissolvedIronIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsIceCell", verticalAerosolsIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSalinityCell", verticalSalinityCell) - call MPAS_pool_get_array(tracers_aggregate, "brineFractionCell", brineFractionCell) - - ! biogeochemistry - ! brine height fraction - if (config_use_brine) & - tracerArrayCell(tracerObject % index_brineFraction) = brineFractionCell(iCell) - - if (config_use_skeletal_biochemistry) then - - ! algal nitrogen - do iBioTracers = 1, nAlgae - tracerArrayCell(tracerObject % index_algaeConc(iBioTracers)) = skeletalAlgaeConcCell(iBioTracers,iCell) - enddo - - ! nitrate - if (config_use_nitrate) & - tracerArrayCell(tracerObject % index_nitrateConc) = skeletalNitrateConcCell(1,iCell) - - if (config_use_carbon) then - - ! DOC - do iBioTracers = 1, nDOC - tracerArrayCell(tracerObject % index_DOCConc(iBioTracers)) = skeletalDOCConcCell(iBioTracers,iCell) - enddo - - ! DIC - do iBioTracers = 1, nDIC - tracerArrayCell(tracerObject % index_DICConc(iBioTracers)) = skeletalDICConcCell(iBioTracers,iCell) - enddo - endif - - ! DON - if (config_use_DON) then - do iBioTracers = 1, nDON - tracerArrayCell(tracerObject % index_DONConc(iBioTracers)) = skeletalDONConcCell(iBioTracers,iCell) - enddo - endif - - ! ammonium - if (config_use_ammonium) & - tracerArrayCell(tracerObject % index_ammoniumConc) = skeletalAmmoniumConcCell(1,iCell) - - ! silicate - if (config_use_silicate) & - tracerArrayCell(tracerObject % index_silicateConc) = skeletalSilicateConcCell(1,iCell) - - ! DMS, DMSPp, DMSPd - if (config_use_DMS) then - tracerArrayCell(tracerObject % index_DMSConc) = skeletalDMSConcCell(1,iCell) - tracerArrayCell(tracerObject % index_DMSPpConc) = skeletalDMSPpConcCell(1,iCell) - tracerArrayCell(tracerObject % index_DMSPdConc) = skeletalDMSPdConcCell(1,iCell) - endif - - ! nonreactive tracer - if (config_use_nonreactive) & - tracerArrayCell(tracerObject % index_nonreactiveConc) = skeletalNonreactiveConcCell(1,iCell) - ! humic material - if (config_use_humics) & - tracerArrayCell(tracerObject % index_humicsConc) = skeletalHumicsConcCell(1,iCell) - - if (config_use_iron) then - - ! particulate iron - do iBioTracers = 1, nParticulateIron - tracerArrayCell(tracerObject % index_particulateIronConc(iBioTracers)) = & - skeletalParticulateIronConcCell(iBioTracers,iCell) - enddo - - ! dissolved iron - do iBioTracers = 1, nDissolvedIron - tracerArrayCell(tracerObject % index_dissolvedIronConc(iBioTracers)) = & - skeletalDissolvedIronConcCell(iBioTracers,iCell) - enddo - endif - - elseif (config_use_vertical_tracers) then - - if (config_use_vertical_biochemistry) then - iBioCount = 0 - - ! algal nitrogen - do iBioTracers = 1, nAlgae - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBiocount = iBiocount + 1 - tracerArrayCell(tracerObject % index_algaeConc(iBioTracers)+iLayers-1) = & - verticalAlgaeConcCell(iBioCount,iCell) - verticalAlgaeIceCell(iLayers+iIceCount,iCell) = verticalAlgaeConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBiocount = iBiocount + 1 - tracerArrayCell(tracerObject % index_algaeConc(iBioTracers)+iLayers-1) = & - verticalAlgaeConcCell(iBioCount,iCell) - enddo - enddo - endif - - ! nitrate - if (config_use_nitrate) then - do iLayers = 1, nBioLayersP1 - tracerArrayCell(tracerObject % index_nitrateConc + iLayers-1) = verticalNitrateConcCell(iLayers,iCell) - verticalNitrateIceCell(iLayers,iCell) = verticalNitrateConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - tracerArrayCell(tracerObject % index_nitrateConc + iLayers-1) = verticalNitrateConcCell(iLayers,iCell) - enddo - endif - - if (config_use_carbon) then - iBioCount = 0 - - ! DOC - do iBioTracers = 1, nDOC - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_DOCConc(iBioTracers) + iLayers-1) = & - verticalDOCConcCell(iBioCount,iCell) - verticalDOCIceCell(iLayers+iIceCount,iCell) = verticalDOCConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_DOCConc(iBioTracers) + iLayers-1) = & - verticalDOCConcCell(iBioCount,iCell) - enddo - enddo - iBioCount = 0 - - ! DIC - do iBioTracers = 1, nDIC - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_DICConc(iBioTracers) + iLayers-1) = & - verticalDICConcCell(iBioCount,iCell) - verticalDICIceCell(iLayers+iIceCount,iCell) = verticalDICConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_DICConc(iBioTracers) + iLayers-1) = & - verticalDICConcCell(iBioCount,iCell) - enddo - enddo - endif - - ! DON - if (config_use_DON) then - iBioCount = 0 - do iBioTracers = 1, nDON - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_DONConc(iBioTracers) + iLayers-1) = & - verticalDONConcCell(iBioCount,iCell) - verticalDONIceCell(iLayers+iIceCount,iCell) = verticalDONConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_DONConc(iBioTracers) + iLayers-1) = & - verticalDONConcCell(iBioCount,iCell) - enddo - enddo - endif - - ! ammonium - if (config_use_ammonium) then - do iLayers = 1, nBioLayersP1 - tracerArrayCell(tracerObject % index_ammoniumConc + iLayers-1) = & - verticalAmmoniumConcCell(iLayers,iCell) - verticalAmmoniumIceCell(iLayers,iCell) = verticalAmmoniumConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - tracerArrayCell(tracerObject % index_ammoniumConc + iLayers-1) = & - verticalAmmoniumConcCell(iLayers,iCell) - enddo - endif - - ! silicate - if (config_use_silicate) then - do iLayers = 1, nBioLayersP1 - tracerArrayCell(tracerObject % index_silicateConc+iLayers-1) = verticalSilicateConcCell(iLayers,iCell) - verticalSilicateIceCell(iLayers,iCell) = verticalSilicateConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - tracerArrayCell(tracerObject % index_silicateConc+iLayers-1) = verticalSilicateConcCell(iLayers,iCell) - enddo - endif - - ! DMS, DMSPp, DMSPd - if (config_use_DMS) then - do iLayers = 1, nBioLayersP1 - tracerArrayCell(tracerObject % index_DMSConc+iLayers-1) = verticalDMSConcCell(iLayers,iCell) - tracerArrayCell(tracerObject % index_DMSPpConc+iLayers-1) = verticalDMSPpConcCell(iLayers,iCell) - tracerArrayCell(tracerObject % index_DMSPdConc+iLayers-1) = verticalDMSPdConcCell(iLayers,iCell) - verticalDMSIceCell(iLayers,iCell) = verticalDMSConcCell(iLayers,iCell) - verticalDMSPpIceCell(iLayers,iCell) = verticalDMSPpConcCell(iLayers,iCell) - verticalDMSPdIceCell(iLayers,iCell) = verticalDMSPdConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - tracerArrayCell(tracerObject % index_DMSConc+iLayers-1) = verticalDMSConcCell(iLayers,iCell) - tracerArrayCell(tracerObject % index_DMSPpConc+iLayers-1) = verticalDMSPpConcCell(iLayers,iCell) - tracerArrayCell(tracerObject % index_DMSPdConc+iLayers-1) = verticalDMSPdConcCell(iLayers,iCell) - enddo - endif - - ! nonreactive - if (config_use_nonreactive) then - do iLayers = 1, nBioLayersP1 - tracerArrayCell(tracerObject % index_nonreactiveConc+iLayers-1) = & - verticalNonreactiveConcCell(iLayers,iCell) - verticalNonreactiveIceCell(iLayers,iCell) = verticalNonreactiveConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - tracerArrayCell(tracerObject % index_nonreactiveConc+iLayers-1) = & - verticalNonreactiveConcCell(iLayers,iCell) - enddo - endif - - ! humic material - if (config_use_humics) then - do iLayers = 1, nBioLayersP1 - tracerArrayCell(tracerObject % index_humicsConc+iLayers-1) = verticalHumicsConcCell(iLayers,iCell) - verticalHumicsIceCell(iLayers,iCell) = verticalHumicsConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - tracerArrayCell(tracerObject % index_humicsConc+iLayers-1) = verticalHumicsConcCell(iLayers,iCell) - enddo - endif - - if (config_use_iron) then - iBioCount = 0 - - ! particulate iron - do iBioTracers = 1, nParticulateIron - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_particulateIronConc(iBioTracers)+iLayers-1) = & - verticalParticulateIronConcCell(iBioCount,iCell) - verticalParticulateIronIceCell(iLayers+iIceCount,iCell) = verticalParticulateIronConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_particulateIronConc(iBioTracers)+iLayers-1) = & - verticalParticulateIronConcCell(iBioCount,iCell) - enddo - enddo - iBioCount = 0 - - ! dissolved iron - do iBioTracers = 1, nDissolvedIron - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_dissolvedIronConc(iBioTracers)+iLayers-1) = & - verticalDissolvedIronConcCell(iBioCount,iCell) - verticalDissolvedIronIceCell(iLayers+iIceCount,iCell) = verticalDissolvedIronConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_dissolvedIronConc(iBioTracers)+iLayers-1) = & - verticalDissolvedIronConcCell(iBioCount,iCell) - enddo - enddo - endif - - ! black carbon and dust aerosols - if (config_use_zaerosols) then - iBioCount = 0 - do iBioTracers = 1, nzAerosols - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_verticalAerosolsConc(iBioTracers)+iLayers-1) = & - verticalAerosolsConcCell(iBioCount,iCell) - verticalAerosolsIceCell(iLayers+iIceCount,iCell) = verticalAerosolsConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - tracerArrayCell(tracerObject % index_verticalAerosolsConc(iBioTracers)+iLayers-1) = & - verticalAerosolsConcCell(iBioCount,iCell) - enddo - enddo - endif - - ! salinity for use with BL99 thermodynamics - if (config_use_vertical_zsalinity) then - do iLayers = 1, nBioLayers - tracerArrayCell(tracerObject % index_verticalSalinity+iLayers-1) = verticalSalinityCell(iLayers,iCell) - enddo - endif - endif - - end subroutine set_cice_biogeochemistry_tracer_array_cell - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! get_cice_biogeochemistry_tracer_array_cell -! -!> \brief -!> \author Nicole Jeffery -!> \date 23rd September 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, tracerArrayCell, iCell) - - type(block_type), intent(inout) :: & - block - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - real(kind=RKIND), dimension(:), intent(in) :: & - tracerArrayCell - - integer, intent(in) :: & - iCell - - logical, pointer :: & - config_use_skeletal_biochemistry, & - config_use_vertical_biochemistry, & - config_use_vertical_zsalinity, & - config_use_vertical_tracers, & - config_use_brine, & - config_use_nitrate, & - config_use_carbon, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - integer, pointer :: & - nBioLayersP3, & - nBioLayersP1, & - nBioLayers, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nzAerosols - - type(MPAS_pool_type), pointer :: & - tracers_aggregate - - real(kind=RKIND), dimension(:), pointer :: & - brineFractionCell - - real(kind=RKIND), dimension(:,:), pointer :: & - skeletalAlgaeConcCell, & - skeletalDOCConcCell, & - skeletalDICConcCell, & - skeletalDONConcCell, & - skeletalDissolvedIronConcCell, & - skeletalParticulateIronConcCell, & - skeletalNitrateConcCell, & - skeletalSilicateConcCell, & - skeletalAmmoniumConcCell, & - skeletalDMSConcCell, & - skeletalDMSPpConcCell, & - skeletalDMSPdConcCell, & - skeletalNonreactiveConcCell, & - skeletalHumicsConcCell, & - verticalAlgaeConcCell, & - verticalDOCConcCell, & - verticalDICConcCell, & - verticalDONConcCell, & - verticalNitrateConcCell, & - verticalSilicateConcCell, & - verticalAmmoniumConcCell, & - verticalDMSConcCell, & - verticalDMSPpConcCell, & - verticalDMSPdConcCell, & - verticalNonreactiveConcCell, & - verticalHumicsConcCell, & - verticalParticulateIronConcCell, & - verticalDissolvedIronConcCell, & - verticalAerosolsConcCell, & - verticalSalinityCell, & - verticalAlgaeIceCell, & - verticalDOCIceCell, & - verticalDICIceCell, & - verticalDONIceCell, & - verticalNitrateIceCell, & - verticalSilicateIceCell, & - verticalAmmoniumIceCell, & - verticalDMSIceCell, & - verticalDMSPpIceCell, & - verticalDMSPdIceCell, & - verticalNonreactiveIceCell, & - verticalHumicsIceCell, & - verticalParticulateIronIceCell, & - verticalDissolvedIronIceCell, & - verticalAerosolsIceCell, & - verticalAerosolsSnowCell - - integer :: & - iBioTracers, & - iBioCount, & - iLayers, & - iIceCount, & - iSnowCount - - call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_ammonium",config_use_ammonium) - call MPAS_pool_get_config(block % configs, "config_use_silicate",config_use_silicate) - call MPAS_pool_get_config(block % configs, "config_use_DMS",config_use_DMS) - call MPAS_pool_get_config(block % configs, "config_use_nonreactive",config_use_nonreactive) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_use_DON",config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_iron",config_use_iron) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(block % dimensions, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - call MPAS_pool_get_dimension(block % dimensions, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(block % dimensions, "nDissolvedIron", nDissolvedIron) - - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregate) - - call MPAS_pool_get_array(tracers_aggregate, "skeletalAlgaeConcCell", skeletalAlgaeConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDOCConcCell", skeletalDOCConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDICConcCell", skeletalDICConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDONConcCell", skeletalDONConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalNitrateConcCell", skeletalNitrateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalSilicateConcCell", skeletalSilicateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalAmmoniumConcCell", skeletalAmmoniumConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDMSConcCell", skeletalDMSConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDMSPpConcCell", skeletalDMSPpConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDMSPdConcCell", skeletalDMSPdConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalNonreactiveConcCell", skeletalNonreactiveConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalHumicsConcCell", skeletalHumicsConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalParticulateIronConcCell", skeletalParticulateIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "skeletalDissolvedIronConcCell", skeletalDissolvedIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAlgaeConcCell", verticalAlgaeConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDOCConcCell", verticalDOCConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDICConcCell", verticalDICConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDONConcCell", verticalDONConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNitrateConcCell", verticalNitrateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSilicateConcCell", verticalSilicateConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAmmoniumConcCell", verticalAmmoniumConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSConcCell", verticalDMSConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPpConcCell", verticalDMSPpConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPdConcCell", verticalDMSPdConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNonreactiveConcCell", verticalNonreactiveConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalHumicsConcCell", verticalHumicsConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalParticulateIronConcCell", verticalParticulateIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDissolvedIronConcCell", verticalDissolvedIronConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsConcCell", verticalAerosolsConcCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAlgaeIceCell", verticalAlgaeIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDOCIceCell", verticalDOCIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDICIceCell", verticalDICIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDONIceCell", verticalDONIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNitrateIceCell", verticalNitrateIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSilicateIceCell", verticalSilicateIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAmmoniumIceCell", verticalAmmoniumIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSIceCell", verticalDMSIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPpIceCell", verticalDMSPpIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDMSPdIceCell", verticalDMSPdIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalNonreactiveIceCell", verticalNonreactiveIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalHumicsIceCell", verticalHumicsIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalParticulateIronIceCell", verticalParticulateIronIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalDissolvedIronIceCell", verticalDissolvedIronIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsIceCell", verticalAerosolsIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsSnowCell", verticalAerosolsSnowCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSalinityCell", verticalSalinityCell) - call MPAS_pool_get_array(tracers_aggregate, "brineFractionCell", brineFractionCell) - - ! biogeochemistry - ! brine height fraction - if (config_use_brine) & - brineFractionCell(iCell) = tracerArrayCell(tracerObject % index_brineFraction) - - if (config_use_skeletal_biochemistry) then - - ! algal nitrogen - do iBioTracers = 1, nAlgae - skeletalAlgaeConcCell(iBioTracers,iCell) = tracerArrayCell(tracerObject % index_algaeConc(iBioTracers)) - enddo - - ! nitrate - if (config_use_nitrate) & - skeletalNitrateConcCell(1,iCell) = tracerArrayCell(tracerObject % index_nitrateConc) - - if (config_use_carbon) then - - ! DOC - do iBioTracers = 1, nDOC - skeletalDOCConcCell(iBioTracers,iCell) = tracerArrayCell(tracerObject % index_DOCConc(iBioTracers)) - enddo - - ! DIC - do iBioTracers = 1, nDIC - skeletalDICConcCell(iBioTracers,iCell) = tracerArrayCell(tracerObject % index_DICConc(iBioTracers)) - enddo - endif - - ! DON - if (config_use_DON) then - do iBioTracers = 1, nDON - skeletalDONConcCell(iBioTracers,iCell) = tracerArrayCell(tracerObject % index_DONConc(iBioTracers)) - enddo - endif - - ! ammonium - if (config_use_ammonium) & - skeletalAmmoniumConcCell(1,iCell) = tracerArrayCell(tracerObject % index_ammoniumConc) - - ! silicate - if (config_use_silicate) & - skeletalSilicateConcCell(1,iCell) = tracerArrayCell(tracerObject % index_silicateConc) - - ! DMS - if (config_use_DMS) then - skeletalDMSConcCell(1,iCell) = tracerArrayCell(tracerObject % index_DMSConc) - skeletalDMSPpConcCell(1,iCell) = tracerArrayCell(tracerObject % index_DMSPpConc) - skeletalDMSPdConcCell(1,iCell) = tracerArrayCell(tracerObject % index_DMSPdConc) - endif - - ! nonreactive tracer - if (config_use_nonreactive) & - skeletalNonreactiveConcCell(1,iCell) = tracerArrayCell(tracerObject % index_nonreactiveConc) - ! humic material - if (config_use_humics) & - skeletalHumicsConcCell(1,iCell) = tracerArrayCell(tracerObject % index_humicsConc) - - if (config_use_iron) then - - ! particulate iron - do iBioTracers = 1, nParticulateIron - skeletalParticulateIronConcCell(iBioTracers,iCell) = & - tracerArrayCell(tracerObject % index_particulateIronConc(iBioTracers)) - enddo - - ! dissolved iron - do iBioTracers = 1, nDissolvedIron - skeletalDissolvedIronConcCell(iBioTracers,iCell) = & - tracerArrayCell(tracerObject % index_dissolvedIronConc(iBioTracers)) - enddo - endif - - elseif (config_use_vertical_tracers) then - - if (config_use_vertical_biochemistry) then - iBioCount = 0 - - ! algal nitrogen - do iBioTracers = 1, nAlgae - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBiocount = iBiocount + 1 - verticalAlgaeConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_algaeConc(iBioTracers)+iLayers-1) - verticalAlgaeIceCell(iLayers+iIceCount,iCell) = verticalAlgaeConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBiocount = iBiocount + 1 - verticalAlgaeConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_algaeConc(iBioTracers)+iLayers-1) - enddo - enddo - endif - - ! nitrate - if (config_use_nitrate) then - do iLayers = 1, nBioLayersP1 - verticalNitrateConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_nitrateConc + iLayers-1) - verticalNitrateIceCell(iLayers,iCell) = verticalNitrateConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - verticalNitrateConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_nitrateConc + iLayers-1) - enddo - endif - - if (config_use_carbon) then - iBioCount = 0 - - ! DOC - do iBioTracers = 1, nDOC - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - verticalDOCConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_DOCConc(iBioTracers) + iLayers-1) - verticalDOCIceCell(iLayers+iIceCount,iCell) = verticalDOCConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDOCConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_DOCConc(iBioTracers) + iLayers-1) - enddo - enddo - iBioCount = 0 - - ! DIC - do iBioTracers = 1, nDIC - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - verticalDICConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_DICConc(iBioTracers) + iLayers-1) - verticalDICIceCell(iLayers+iIceCount,iCell) = verticalDICConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDICConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_DICConc(iBioTracers) + iLayers-1) - enddo - enddo - endif - - ! DON - if (config_use_DON) then - iBioCount = 0 - do iBioTracers = 1, nDON - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - verticalDONConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_DONConc(iBioTracers) + iLayers-1) - verticalDONIceCell(iLayers+iIceCount,iCell) = verticalDONConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDONConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_DONConc(iBioTracers) + iLayers-1) - enddo - enddo - endif - - ! ammonium - if (config_use_ammonium) then - do iLayers = 1, nBioLayersP1 - verticalAmmoniumConcCell(iLayers,iCell) = & - tracerArrayCell(tracerObject % index_ammoniumConc + iLayers-1) - verticalAmmoniumIceCell(iLayers,iCell) = verticalAmmoniumConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - verticalAmmoniumConcCell(iLayers,iCell) = & - tracerArrayCell(tracerObject % index_ammoniumConc + iLayers-1) - enddo - endif - - ! silicate - if (config_use_silicate) then - do iLayers = 1, nBioLayersP1 - verticalSilicateConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_silicateConc+iLayers-1) - verticalSilicateIceCell(iLayers,iCell) = verticalSilicateConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - verticalSilicateConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_silicateConc+iLayers-1) - enddo - endif - - ! DMS, DMSPp, DMSPd - if (config_use_DMS) then - do iLayers = 1, nBioLayersP1 - verticalDMSConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_DMSConc+iLayers-1) - verticalDMSPpConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_DMSPpConc+iLayers-1) - verticalDMSPdConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_DMSPdConc+iLayers-1) - verticalDMSIceCell(iLayers,iCell) = verticalDMSConcCell(iLayers,iCell) - verticalDMSPpIceCell(iLayers,iCell) = verticalDMSPpConcCell(iLayers,iCell) - verticalDMSPdIceCell(iLayers,iCell) = verticalDMSPdConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - verticalDMSConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_DMSConc+iLayers-1) - verticalDMSPpConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_DMSPpConc+iLayers-1) - verticalDMSPdConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_DMSPdConc+iLayers-1) - enddo - endif - - ! nonreactive tracer - if (config_use_nonreactive) then - do iLayers = 1, nBioLayersP1 - verticalNonreactiveConcCell(iLayers,iCell) = & - tracerArrayCell(tracerObject % index_nonreactiveConc+iLayers-1) - verticalNonreactiveIceCell(iLayers,iCell) = verticalNonreactiveConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - verticalNonreactiveConcCell(iLayers,iCell) = & - tracerArrayCell(tracerObject % index_nonreactiveConc+iLayers-1) - enddo - endif - - ! humic material - if (config_use_humics) then - do iLayers = 1, nBioLayersP1 - verticalHumicsConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_humicsConc+iLayers-1) - verticalHumicsIceCell(iLayers,iCell) = verticalHumicsConcCell(iLayers,iCell) - enddo - do iLayers = nBioLayersP1+1, nBioLayersP3 - verticalHumicsConcCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_humicsConc+iLayers-1) - enddo - endif - - if (config_use_iron) then - iBioCount = 0 - - ! particulate iron - do iBioTracers = 1, nParticulateIron - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - verticalParticulateIronConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_particulateIronConc(iBioTracers)+iLayers-1) - verticalDissolvedIronIceCell(iLayers+iIceCount,iCell) = verticalDissolvedIronConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalParticulateIronConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_particulateIronConc(iBioTracers)+iLayers-1) - enddo - enddo - iBioCount = 0 - - ! dissolved iron - do iBioTracers = 1, nDissolvedIron - iIceCount = (iBioTracers-1)*nBioLayersP1 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - verticalDissolvedIronConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_dissolvedIronConc(iBioTracers)+iLayers-1) - verticalDissolvedIronIceCell(iLayers+iIceCount,iCell) = verticalDissolvedIronConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalDissolvedIronConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_dissolvedIronConc(iBioTracers)+iLayers-1) - enddo - enddo - endif - - ! black carbon and dust aerosols - if (config_use_zaerosols) then - iBioCount = 0 - do iBioTracers = 1, nzAerosols - iIceCount = (iBioTracers-1)*nBioLayersP1 - iSnowCount = (iBioTracers-1)*2 - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - verticalAerosolsConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_verticalAerosolsConc(iBioTracers)+iLayers-1) - verticalAerosolsIceCell(iLayers+iIceCount,iCell) = verticalAerosolsConcCell(iBioCount,iCell) - enddo - do iLayers = nBioLayersP1+1,nBioLayersP3 - iBioCount = iBioCount + 1 - verticalAerosolsConcCell(iBioCount,iCell) = & - tracerArrayCell(tracerObject % index_verticalAerosolsConc(iBioTracers)+iLayers-1) - verticalAerosolsSnowCell(iLayers-nBioLayersP1+iSnowCount,iCell) = & - verticalAerosolsConcCell(iBioCount,iCell) - enddo - enddo - endif - - ! salinity for use with BL99 thermodynamics - if (config_use_vertical_zsalinity) then - do iLayers = 1, nBioLayers - verticalSalinityCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_verticalSalinity+iLayers-1) - enddo - endif - endif - - end subroutine get_cice_biogeochemistry_tracer_array_cell - -!----------------------------------------------------------------------- -! Init CICE parameters -!----------------------------------------------------------------------- - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_package_parameters -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 2nd Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_package_parameters(domain, tracerObject) - - type(domain_type), intent(inout) :: domain - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - ! check column configs - call check_column_package_configs(domain) - - ! set the tracer flags - call init_column_package_tracer_flags(domain) - - ! set the tracer numbers - call init_column_package_tracer_numbers(tracerObject) - - ! set the tracers indices - call init_column_package_tracer_indices(tracerObject) - - ! set the column parameters - call init_column_package_configs(domain) - - end subroutine init_column_package_parameters - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! check_column_package_configs -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine check_column_package_configs(domain) - - use seaice_constants, only: & - seaicePuny - - type(domain_type), intent(inout) :: & - domain - - integer, pointer :: & - nCategories, & - nSnowLayers, & - nIceLayers, & - config_nSnowLayers, & - config_nIceLayers - - character(len=strKIND), pointer :: & - config_thermodynamics_type, & - config_heat_conductivity_type, & - config_shortwave_type, & - config_albedo_type, & - config_ice_strength_formulation, & - config_ridging_participation_function, & - config_ridging_redistribution_function, & - config_atmos_boundary_method, & - config_itd_conversion_type, & - config_category_bounds_type, & - config_pond_refreezing_type, & - config_ocean_heat_transfer_type, & - config_sea_freezing_temperature_type, & - config_snow_redistribution_scheme - - logical, pointer :: & - config_calc_surface_stresses, & - config_calc_surface_temperature, & - config_use_form_drag, & - config_use_level_ice, & - config_use_cesm_meltponds, & ! deprecated - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_vertical_zsalinity, & - config_use_brine, & - config_use_vertical_tracers, & - config_use_vertical_biochemistry, & - config_use_skeletal_biochemistry, & - config_use_zaerosols, & - config_use_shortwave_bioabsorption, & - config_use_nitrate, & - config_use_carbon, & - config_use_chlorophyll, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_modal_aerosols, & - config_use_column_biogeochemistry, & - config_use_column_snow_tracers, & - config_use_effective_snow_density, & - config_use_snow_liquid_ponds, & - config_use_snow_grain_radius - - logical :: & - use_meltponds - - integer :: & - nPondSchemesActive - - real(kind=RKIND), pointer :: & - config_max_meltwater_retained_fraction, & - config_min_meltwater_retained_fraction, & - config_snow_to_ice_transition_depth - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nCategories", nCategories) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nIceLayers", nIceLayers) - - call MPAS_pool_get_config(domain % configs, "config_thermodynamics_type", config_thermodynamics_type) - call MPAS_pool_get_config(domain % configs, "config_heat_conductivity_type", config_heat_conductivity_type) - call MPAS_pool_get_config(domain % configs, "config_shortwave_type", config_shortwave_type) - call MPAS_pool_get_config(domain % configs, "config_albedo_type", config_albedo_type) - call MPAS_pool_get_config(domain % configs, "config_ice_strength_formulation", config_ice_strength_formulation) - call MPAS_pool_get_config(domain % configs, "config_ridging_participation_function", config_ridging_participation_function) - call MPAS_pool_get_config(domain % configs, "config_ridging_redistribution_function", config_ridging_redistribution_function) - call MPAS_pool_get_config(domain % configs, "config_atmos_boundary_method", config_atmos_boundary_method) - call MPAS_pool_get_config(domain % configs, "config_itd_conversion_type", config_itd_conversion_type) - call MPAS_pool_get_config(domain % configs, "config_category_bounds_type", config_category_bounds_type) - call MPAS_pool_get_config(domain % configs, "config_pond_refreezing_type", config_pond_refreezing_type) - call MPAS_pool_get_config(domain % configs, "config_calc_surface_stresses", config_calc_surface_stresses) - call MPAS_pool_get_config(domain % configs, "config_calc_surface_temperature", config_calc_surface_temperature) - call MPAS_pool_get_config(domain % configs, "config_max_meltwater_retained_fraction", config_max_meltwater_retained_fraction) - call MPAS_pool_get_config(domain % configs, "config_min_meltwater_retained_fraction", config_min_meltwater_retained_fraction) - call MPAS_pool_get_config(domain % configs, "config_snow_to_ice_transition_depth", config_snow_to_ice_transition_depth) - call MPAS_pool_get_config(domain % configs, "config_use_form_drag", config_use_form_drag) - call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) ! deprecated - call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(domain % configs, "config_ocean_heat_transfer_type", config_ocean_heat_transfer_type) - call MPAS_pool_get_config(domain % configs, "config_sea_freezing_temperature_type", config_sea_freezing_temperature_type) - call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(domain % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(domain % configs, "config_use_chlorophyll", config_use_chlorophyll) - call MPAS_pool_get_config(domain % configs, "config_use_ammonium", config_use_ammonium) - call MPAS_pool_get_config(domain % configs, "config_use_silicate", config_use_silicate) - call MPAS_pool_get_config(domain % configs, "config_use_DMS", config_use_DMS) - call MPAS_pool_get_config(domain % configs, "config_use_nonreactive", config_use_nonreactive) - call MPAS_pool_get_config(domain % configs, "config_use_humics", config_use_humics) - call MPAS_pool_get_config(domain % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(domain % configs, "config_use_iron", config_use_iron) - call MPAS_pool_get_config(domain % configs, "config_use_modal_aerosols", config_use_modal_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(domain % configs, "config_nSnowLayers", config_nSnowLayers) - call MPAS_pool_get_config(domain % configs, "config_nIceLayers", config_nIceLayers) - call MPAS_pool_get_config(domain % configs, "config_use_column_snow_tracers", config_use_column_snow_tracers) - call MPAS_pool_get_config(domain % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(domain % configs, "config_snow_redistribution_scheme", config_snow_redistribution_scheme) - call MPAS_pool_get_config(domain % configs, "config_use_snow_liquid_ponds", config_use_snow_liquid_ponds) - call MPAS_pool_get_config(domain % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - !----------------------------------------------------------------------- - ! Check values - !----------------------------------------------------------------------- - - ! check config_thermodynamics_type value - if (trim(config_thermodynamics_type) == "zero layer") then - call mpas_log_write(& - "check_column_package_configs: config_thermodynamics_type) = zero layer but 0-layer thermo is being deprecated", & - messageType=MPAS_LOG_WARN) - endif - - if (.not. (trim(config_thermodynamics_type) == "BL99" .or. & - trim(config_thermodynamics_type) == "mushy")) then - call config_error("config_thermodynamics_type", config_thermodynamics_type, "'BL99' or 'mushy'") - endif - - ! check config_heat_conductivity_type value - if (.not. (trim(config_heat_conductivity_type) == "MU71" .or. & - trim(config_heat_conductivity_type) == "bubbly")) then - call config_error("config_heat_conductivity_type", config_heat_conductivity_type, "'MU71' or 'bubbly'") - endif - - ! check config_shortwave_type value - if (.not. (trim(config_shortwave_type) == "ccsm3" .or. & - trim(config_shortwave_type) == "dEdd")) then - call config_error("config_shortwave_type", config_shortwave_type, "'ccsm3' or 'dEdd'") - endif - - ! check config_albedo_type value - if (.not. (trim(config_albedo_type) == "ccsm3" .or. & - trim(config_albedo_type) == "constant")) then - call config_error("config_albedo_type", config_albedo_type, "'ccsm3' or 'constant'") - endif - - ! check config_ice_strength_formulation value - if (.not. (trim(config_ice_strength_formulation) == "Hibler79" .or. & - trim(config_ice_strength_formulation) == "Rothrock75")) then - call config_error("config_ice_strength_formulation", config_ice_strength_formulation, "'Hibler79' or 'Rothrock75'") - endif - - ! check config_ridging_participation_function value - if (.not. (trim(config_ridging_participation_function) == "Thorndike75" .or. & - trim(config_ridging_participation_function) == "exponential")) then - call config_error("config_ridging_participation_function", & - config_ridging_participation_function, "'Thorndike75' or 'exponential'") - endif - - ! check config_ridging_redistribution_function value - if (.not. (trim(config_ridging_redistribution_function) == "Hibler80" .or. & - trim(config_ridging_redistribution_function) == "exponential")) then - call config_error("config_ridging_redistribution_function", & - config_ridging_redistribution_function, "'Hibler80' or 'exponential'") - endif - - ! check config_atmos_boundary_method value - if (.not. (trim(config_atmos_boundary_method) == "ccsm3" .or. & - trim(config_atmos_boundary_method) == "constant" .or. & - trim(config_atmos_boundary_method) == "similarity")) then ! similarity = ccsm3 = default - call config_error("config_atmos_boundary_method", config_atmos_boundary_method, "'similarity' or 'constant' or 'cccsm3'") - endif - - ! check config_itd_conversion_type value - if (.not. (trim(config_itd_conversion_type) == "delta function" .or. & - trim(config_itd_conversion_type) == "linear remap")) then - call config_error("config_itd_conversion_type", config_itd_conversion_type, "'delta function' or 'linear remap'") - endif - - ! check config_category_bounds_type value - if (.not. (trim(config_category_bounds_type) == "single category" .or. & - trim(config_category_bounds_type) == "original" .or. & - trim(config_category_bounds_type) == "new" .or. & - trim(config_category_bounds_type) == "WMO" .or. & - trim(config_category_bounds_type) == "asymptotic")) then - call config_error("config_category_bounds_type", & - config_category_bounds_type, "'single category', 'original', 'new', 'WMO' or 'asymptotic'") - endif - - ! check config_pond_refreezing_type value - if (.not. (trim(config_pond_refreezing_type) == "cesm" .or. & - trim(config_pond_refreezing_type) == "hlid")) then - call config_error("config_pond_refreezing_type", config_pond_refreezing_type, "'cesm' or 'hlid'") - endif - - ! check for consistency in snow vertical dimension - if (config_nSnowLayers /= nSnowlayers) & - call mpas_log_write(& - 'Check for inconsistencies in restart file: config_nSnowLayers /= nSnowLayers', & - messageType=MPAS_LOG_CRIT) - - ! check for consistency in ice vertical dimension - if (config_nIceLayers /= nIcelayers) & - call mpas_log_write(& - 'Check for inconsistencies in restart file: config_nIceLayers /= nIceLayers', & - messageType=MPAS_LOG_CRIT) - - ! deprecate cesm ponds - if (config_use_cesm_meltponds) then - call mpas_log_write(& - "check_column_package_configs: config_use_cesm_meltponds = .true. but cesm ponds are being deprecated", & - messageType=MPAS_LOG_CRIT) - endif - - !----------------------------------------------------------------------- - ! Check combinations - !----------------------------------------------------------------------- - - ! check only single meltpond option on - nPondSchemesActive = 0 - if (config_use_cesm_meltponds) nPondSchemesActive = nPondSchemesActive + 1 - if (config_use_level_meltponds) nPondSchemesActive = nPondSchemesActive + 1 - if (config_use_topo_meltponds) nPondSchemesActive = nPondSchemesActive + 1 - if (nPondSchemesActive > 1) then - call mpas_log_write(& - 'check_column_package_configs: More than one melt pond scheme active', & - messageType=MPAS_LOG_CRIT) - endif - - ! check for itd remapping with only one category - if (nCategories == 1 .and. trim(config_itd_conversion_type) == "linear remap") then - call mpas_log_write(& - 'check_column_package_configs: Remapping the ITD is not allowed for nCategories=1', & - messageType=MPAS_LOG_ERR) - call mpas_log_write(& - "Use config_itd_conversion_type = 'delta function' with config_category_bounds_type = 'original'", & - messageType=MPAS_LOG_ERR) - call mpas_log_write(& - "or for column configurations use config_category_bounds_type = 'single category'", & - messageType=MPAS_LOG_CRIT) - endif - - ! check itd and category bounds discrepancy - if (nCategories /= 1 .and. trim(config_category_bounds_type) == 'single category') then - call mpas_log_write(& - "check_column_package_configs: nCategories /= 1 .and. config_category_bounds_type = 'single category'", & - messageType=MPAS_LOG_CRIT) - endif - - ! check config_snow_to_ice_transition_depth and level ponds - if (config_use_level_meltponds .and. abs(config_snow_to_ice_transition_depth) > seaicePuny) then - call mpas_log_write(& - "check_column_package_configs: config_use_level_meltponds = .true. and config_snow_to_ice_transition_depth /= 0", & - messageType=MPAS_LOG_CRIT) - endif - - ! check config_snow_redistribution_scheme - if ((trim(config_snow_redistribution_scheme) == "ITDrdg" .or. & - trim(config_snow_redistribution_scheme) == "ITDsd") .and. .not. config_use_effective_snow_density) then - call mpas_log_write(& - "check_column_package_configs: config_snow_redistribution = 'ITD' but config_use_effective_snow_density is false", & - messageType=MPAS_LOG_CRIT) - endif - - ! check config_use_snow_liquid_ponds and config_use_snow_grain_radius - if (config_use_snow_liquid_ponds .and. .not. config_use_snow_grain_radius) then - call mpas_log_write(& - "check_column_package_configs: config_use_snow_liquid_ponds = true but config_use_snow_grain_radius = false", & - messageType=MPAS_LOG_CRIT) - endif - - ! check cesm ponds and freezing lids inconsistency - if (config_use_cesm_meltponds .and. trim(config_pond_refreezing_type) /= "cesm") then - call mpas_log_write(& - "check_column_package_configs: config_use_cesm_meltponds = .true. and config_pond_refreezing_type /= 'cesm'", & - messageType=MPAS_LOG_CRIT) - endif - - ! check dEdd shortwave if using ponds - use_meltponds = (config_use_cesm_meltponds .or. config_use_level_meltponds .or. config_use_topo_meltponds) - if (trim(config_shortwave_type) /= 'dEdd' .and. use_meltponds .and. config_calc_surface_temperature) then - call mpas_log_write(& - "check_column_package_configs: config_shortwave_type) /= 'dEdd' .and. use_meltponds = .true.", & - messageType=MPAS_LOG_ERR) - call mpas_log_write(& - ".and. config_calc_surface_temperature ==.true.", & - messageType=MPAS_LOG_CRIT) - endif - - ! check range of config_min_meltwater_retained_fraction and config_max_meltwater_retained_fraction - if (config_min_meltwater_retained_fraction < 0.0_RKIND .or. & - config_min_meltwater_retained_fraction > 1.0_RKIND) then - call mpas_log_write(& - 'check_column_package_configs: config_min_meltwater_retained_fraction out of bounds', & - messageType=MPAS_LOG_CRIT) - endif - if (config_max_meltwater_retained_fraction < 0.0_RKIND .or. & - config_max_meltwater_retained_fraction > 1.0_RKIND) then - call mpas_log_write(& - 'check_column_package_configs: config_max_meltwater_retained_fraction out of bounds', & - messageType=MPAS_LOG_CRIT) - endif - - ! check not mushy physics and dont calculate surface temperature - if (trim(config_thermodynamics_type) == "mushy" .and. .not. config_calc_surface_temperature) then - call mpas_log_write(& - "check_column_package_configs: config_thermodynamics_type = 'mushy' and config_calc_surface_temperature = .false.", & - messageType=MPAS_LOG_CRIT) - endif - - ! check not form drag with constant atmosphere boundary method - if (config_use_form_drag .and. trim(config_atmos_boundary_method) == "constant") then - call mpas_log_write(& - "check_column_package_configs: config_use_form_drag = .true. and config_atmos_boundary_method = 'constant'", & - messageType=MPAS_LOG_CRIT) - endif - - ! check not form drag with not calculating surface stresses - if (config_use_form_drag .and. .not. config_calc_surface_stresses) then - call mpas_log_write(& - "check_column_package_configs: config_use_form_drag = .true. and config_calc_surface_stresses = .false.", & - messageType=MPAS_LOG_CRIT) - endif - - ! check am not using form drag with cesm ponds - if (config_use_form_drag .and. config_use_cesm_meltponds) then - call mpas_log_write(& - "check_column_package_configs: config_use_form_drag = .true. and config_use_cesm_meltponds = .true.", & - messageType=MPAS_LOG_CRIT) - endif - - ! check using form drag but not level ice - if (config_use_form_drag .and. .not. config_use_level_ice) then - call mpas_log_write(& - "check_column_package_configs: config_use_form_drag = .true. and config_use_level_ice = .false.", & - messageType=MPAS_LOG_CRIT) - endif - - ! check form drag and ocean heat flux type - if (.not. config_use_form_drag .and. trim(config_ocean_heat_transfer_type) == "Cdn_ocn") then - call mpas_log_write(& - "check_column_package_configs: config_use_form_drag = .false. and config_ocean_heat_transfer_type == 'Cdn_ocn'", & - messageType=MPAS_LOG_CRIT) - endif - - ! check thermodynamic type and sea freezing temperature type - if (trim(config_thermodynamics_type) == "BL99" .and. trim(config_sea_freezing_temperature_type) /= "linear_salt") then - call mpas_log_write(& - "check_column_package_configs: config_thermodynamics_type == 'BL99' "//& - "and config_sea_freezing_temperature_type /= 'linear_salt'", & - messageType=MPAS_LOG_CRIT) - endif - if (trim(config_thermodynamics_type) == "mushy" .and. trim(config_sea_freezing_temperature_type) /= "mushy") then - call mpas_log_write(& - "check_column_package_configs: config_thermodynamics_type == 'mushy' and "//& - "config_sea_freezing_temperature_type /= 'mushy'", & - messageType=MPAS_LOG_CRIT) - endif - - ! deprecate zsalinity - if (config_use_vertical_zsalinity) then - call mpas_log_write(& - "check_column_package_configs: vertical zSalinity has been deprecated", & - messageType=MPAS_LOG_CRIT) - endif - - ! check biogeochemistry flags: - if (.not. config_use_column_biogeochemistry .and. (config_use_vertical_zsalinity .or. & - config_use_vertical_biochemistry .or. & - config_use_skeletal_biochemistry .or. config_use_nitrate .or. config_use_carbon .or. config_use_chlorophyll .or. & - config_use_ammonium .or. config_use_silicate .or. config_use_DMS .or. config_use_nonreactive .or. config_use_humics .or. & - config_use_DON .or. config_use_iron)) then - call mpas_log_write(& - "check_column_package_configs: config_use_column_biogeochemistry = false. "//& - "All biogeochemistry namelist flags must also be false", & - messageType=MPAS_LOG_CRIT) - endif - - ! check vertical zSalinity requirements - if (config_use_vertical_zsalinity .and. ((.not. config_use_brine) .or. & - (.not. (trim(config_thermodynamics_type) == "BL99")))) then - call mpas_log_write(& - "check_column_package_configs: vertical zSalinity requires config_use_brine = true and 'BL99' ", & - messageType=MPAS_LOG_CRIT) - endif - - ! check that vertical bio tracers use brine height - if ((config_use_vertical_biochemistry .or. config_use_zaerosols) .and. & - (.not. config_use_brine .or. .not. config_use_vertical_tracers )) then - call mpas_log_write(& - "check_column_package_configs: vertical biochemistry and zaerosols require " //& - "config_use_brine and config_use_vertical_tracer = true", & - messageType=MPAS_LOG_CRIT) - endif - - ! check that vertical bio tracers use brine height - if ((config_use_vertical_biochemistry .or. config_use_zaerosols) .and. & - (.not. config_use_brine .or. .not. config_use_vertical_tracers )) then - call mpas_log_write(& - "check_column_package_configs: vertical biochemistry and zaerosols require " //& - "config_use_brine and config_use_vertical_tracer = true", & - messageType=MPAS_LOG_CRIT) - endif - - ! check that brine height is used with either aerosols or bgc - if (config_use_brine .and. & - (.not. config_use_column_biogeochemistry .and. .not. config_use_zaerosols)) then - call mpas_log_write(& - "check_column_package_configs: brine tracer must be used with vertical tracers - config_use_column_biogeochemistry and/or config_use_zaerosols equal to true", & - messageType=MPAS_LOG_CRIT) - endif - - ! check that the shortwave scheme and bioabsorption is consistent - if (config_use_shortwave_bioabsorption .and. .not. (trim(config_shortwave_type) == "dEdd")) then - call mpas_log_write(& - "check_column_package_configs: shortwave bioabsorption requires config_shortwave_type == 'dEdd'", & - messageType=MPAS_LOG_CRIT) - endif - - ! check that nitrate is true for biogeochemistry - if ((config_use_vertical_biochemistry .or. config_use_skeletal_biochemistry) .and. .not. config_use_nitrate) then - call mpas_log_write(& - "check_column_package_configs: biochemistry needs at the very least config_use_nitrate = true", & - messageType=MPAS_LOG_CRIT) - endif - - end subroutine check_column_package_configs - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_active_processes -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 14th September 2022 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_active_processes(domain) - - use ice_colpkg, only: & - colpkg_init_active_processes - - type(domain_type), intent(inout) :: domain - - logical, pointer :: & - config_use_latent_processes, & - config_use_lateral_melt, & - config_use_congelation_basal_melt - - call MPAS_pool_get_config(domain % configs, "config_use_latent_processes", config_use_latent_processes) - call MPAS_pool_get_config(domain % configs, "config_use_lateral_melt", config_use_lateral_melt) - call MPAS_pool_get_config(domain % configs, "config_use_congelation_basal_melt", config_use_congelation_basal_melt) - - call colpkg_init_active_processes(& - config_use_latent_processes, & - config_use_lateral_melt, & - config_use_congelation_basal_melt) - - end subroutine init_column_active_processes - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_package_tracer_flags -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 2nd Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_package_tracer_flags(domain) - - !use ice_colpkg_tracers, only: & - ! tr_iage , & ! if .true., use age tracer - ! tr_FY , & ! if .true., use first-year area tracer - ! tr_lvl , & ! if .true., use level ice tracer - ! tr_pond , & ! if .true., use melt pond tracer - ! tr_pond_cesm , & ! if .true., use cesm pond tracer - ! tr_pond_lvl , & ! if .true., use level-ice pond tracer - ! tr_pond_topo , & ! if .true., use explicit topography-based ponds - ! tr_aero , & ! if .true., use aerosol tracers - ! tr_brine ! if .true., brine height differs from ice thickness - - use ice_colpkg, only: & - colpkg_init_tracer_flags - - type(domain_type), intent(inout) :: domain - - logical, pointer :: & - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_aerosols, & - config_use_brine, & - config_use_vertical_zsalinity, & - config_use_zaerosols, & - config_use_nitrate, & - config_use_DON, & - config_use_carbon, & - config_use_chlorophyll, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_iron, & - config_use_humics, & - config_use_nonreactive, & - config_use_vertical_biochemistry, & - config_use_skeletal_biochemistry, & - config_use_effective_snow_density, & - config_use_snow_grain_radius - - logical :: & - use_meltponds, & - use_nitrogen - - call MPAS_pool_get_config(domain % configs, "config_use_ice_age", config_use_ice_age) - call MPAS_pool_get_config(domain % configs, "config_use_first_year_ice", config_use_first_year_ice) - call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) - call MPAS_pool_get_config(domain % configs, "config_use_aerosols", config_use_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(domain % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(domain % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(domain % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(domain % configs, "config_use_chlorophyll", config_use_chlorophyll) - call MPAS_pool_get_config(domain % configs, "config_use_ammonium", config_use_ammonium) - call MPAS_pool_get_config(domain % configs, "config_use_silicate", config_use_silicate) - call MPAS_pool_get_config(domain % configs, "config_use_DMS", config_use_DMS) - call MPAS_pool_get_config(domain % configs, "config_use_iron", config_use_iron) - call MPAS_pool_get_config(domain % configs, "config_use_humics", config_use_humics) - call MPAS_pool_get_config(domain % configs, "config_use_nonreactive", config_use_nonreactive) - call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_effective_snow_density", config_use_effective_snow_density) - call MPAS_pool_get_config(domain % configs, "config_use_snow_grain_radius", config_use_snow_grain_radius) - - use_nitrogen = .false. - if (config_use_skeletal_biochemistry .or. config_use_vertical_biochemistry) & - use_nitrogen = .true. - - use_meltponds = (config_use_cesm_meltponds .or. config_use_level_meltponds .or. config_use_topo_meltponds) - - call colpkg_init_tracer_flags(& - config_use_ice_age, & - config_use_first_year_ice, & - config_use_level_ice, & - use_meltponds, & - config_use_cesm_meltponds, & - config_use_level_meltponds, & - config_use_topo_meltponds, & - config_use_effective_snow_density, & - config_use_snow_grain_radius, & - config_use_aerosols, & - config_use_brine, & - config_use_vertical_zsalinity, & - config_use_zaerosols, & - config_use_nitrate, & - use_nitrogen, & - config_use_DON, & - config_use_carbon, & - config_use_chlorophyll, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_iron, & - config_use_humics, & - config_use_nonreactive) - - !tr_iage = config_use_ice_age - !tr_FY = config_use_first_year_ice - !tr_lvl = config_use_level_ice - !tr_pond = use_meltponds - !tr_pond_cesm = config_use_cesm_meltponds - !tr_pond_lvl = config_use_level_meltponds - !tr_pond_topo = config_use_topo_meltponds - !tr_snow = config_use_effective_snow_density - !tr_rsnw = config_use_snow_grain_radius - !tr_aero = config_use_aerosols - !tr_brine = config_use_brine - !tr_bgc_S = config_use_vertical_zsalinity - !tr_zaero = config_use_zaerosols - !tr_bgc_Nit = config_use_nitrate - !tr_bgc_N = use_nitrogen - !tr_bgc_DON = config_use_DON - !tr_bgc_C = config_use_carbon - !tr_bgc_chl = config_use_chlorophyll - !tr_bgc_Am = config_use_ammonium - !tr_bgc_Sil = config_use_silicate - !tr_bgc_DMS = config_use_DMS - !tr_bgc_Fe = config_use_iron - !tr_bgc_hum = config_use_humics - !tr_bgc_PON = config_use_nonreactive - - end subroutine init_column_package_tracer_flags - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_package_tracer_numbers -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 9th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_package_tracer_numbers(tracerObject) - - !use ice_colpkg_tracers, only: & - ! ntrcr, & - ! nbtrcr, & - ! nbtrcr_sw - - use ice_colpkg, only: & - colpkg_init_tracer_numbers - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - call colpkg_init_tracer_numbers(& - tracerObject % nTracers, & - tracerObject % nBioTracers, & - tracerObject % nBioTracersShortwave) - - !ntrcr = tracerObject % nTracers - !nbtrcr = tracerObject % nBioTracers - !nbtrcr_sw = tracerObject % nBioTracersShortwave - - end subroutine init_column_package_tracer_numbers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_package_tracer_indices -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_package_tracer_indices(tracerObject) - - !use ice_colpkg_tracers, only: & - ! nt_Tsfc, & ! ice/snow temperature - ! nt_qice, & ! volume-weighted ice enthalpy (in layers) - ! nt_qsno, & ! volume-weighted snow enthalpy (in layers) - ! nt_sice, & ! volume-weighted ice bulk salinity (CICE grid layers) - ! nt_fbri, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - ! nt_iage, & ! volume-weighted ice age - ! nt_FY, & ! area-weighted first-year ice area - ! nt_alvl, & ! level ice area fraction - ! nt_vlvl, & ! level ice volume fraction - ! nt_apnd, & ! melt pond area fraction - ! nt_hpnd, & ! melt pond depth - ! nt_ipnd, & ! melt pond refrozen lid thickness - ! nt_aero, & ! starting index for aerosols in ice - ! nt_smice, & ! snow ice mass - ! nt_smliq, & ! snow liquid mass - ! nt_rsnw, & ! snow grain radius - ! nt_rhos, & ! snow density tracer - ! nt_fbri, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) - ! nt_bgc_Nit, & ! nutrients - ! nt_bgc_Am, & ! - ! nt_bgc_Sil, & ! - ! nt_bgc_DMSPp, & ! trace gases (skeletal layer) - ! nt_bgc_DMSPd, & ! - ! nt_bgc_DMS, & ! - ! nt_bgc_PON, & ! zooplankton and detritus - ! nt_bgc_hum, & ! humic material - ! ! bio layer indicess - ! nlt_bgc_Nit, & ! nutrients - ! nlt_bgc_Am, & ! - ! nlt_bgc_Sil, & ! - ! nlt_bgc_DMSPp, & ! trace gases (skeletal layer) - ! nlt_bgc_DMSPd, & ! - ! nlt_bgc_DMS, & ! - ! nlt_bgc_PON, & ! zooplankton and detritus - ! nlt_bgc_hum, & ! humic material - ! nlt_chl_sw, & ! points to total chla in trcrn_sw - ! nt_zbgc_frac, & ! fraction of tracer in the mobile phase - ! nt_bgc_S, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid) - ! nt_bgc_N, & ! diatoms, phaeocystis, pico/small - ! nt_bgc_C, & ! diatoms, phaeocystis, pico/small - ! nt_bgc_chl, & ! diatoms, phaeocystis, pico/small - ! nlt_bgc_N, & ! diatoms, phaeocystis, pico/small - ! nlt_bgc_C, & ! diatoms, phaeocystis, pico/small - ! nlt_bgc_chl, & ! diatoms, phaeocystis, pico/small - ! nt_bgc_DOC, & ! dissolved organic carbon - ! nlt_bgc_DOC, & ! dissolved organic carbon - ! nt_bgc_DON, & ! dissolved organic nitrogen - ! nlt_bgc_DON, & ! dissolved organic nitrogen - ! nt_bgc_DIC, & ! dissolved inorganic carbon - ! nlt_bgc_DIC, & ! dissolved inorganic carbon - ! nt_bgc_Fed, & ! dissolved iron - ! nt_bgc_Fep, & ! particulate iron - ! nlt_bgc_Fed, & ! dissolved iron - ! nlt_bgc_Fep, & ! particulate iron - ! nt_zaero, & ! black carbon and other aerosols - ! nlt_zaero, & ! black carbon and other aerosols - ! nlt_zaero_sw ! black carbon and other aerosols - - use ice_colpkg, only: & - colpkg_init_tracer_indices - - type(ciceTracerObjectType), intent(in) :: & - tracerObject - - call colpkg_init_tracer_indices(& - tracerObject % index_surfaceTemperature, & - tracerObject % index_iceEnthalpy, & - tracerObject % index_snowEnthalpy, & - tracerObject % index_iceSalinity, & - tracerObject % index_brineFraction, & - tracerObject % index_iceAge, & - tracerObject % index_firstYearIceArea, & - tracerObject % index_levelIceArea, & - tracerObject % index_levelIceVolume, & - tracerObject % index_pondArea, & - tracerObject % index_pondDepth, & - tracerObject % index_pondLidThickness, & - tracerObject % index_aerosols, & - tracerObject % index_snowIceMass, & - tracerObject % index_snowLiquidMass, & - tracerObject % index_snowGrainRadius, & - tracerObject % index_snowDensity, & - tracerObject % index_verticalAerosolsConc, & - tracerObject % index_algaeConc, & - tracerObject % index_algalCarbon, & - tracerObject % index_algalChlorophyll, & - tracerObject % index_DOCConc, & - tracerObject % index_DONConc, & - tracerObject % index_DICConc, & - tracerObject % index_dissolvedIronConc, & - tracerObject % index_particulateIronConc, & - tracerObject % index_nitrateConc, & - tracerObject % index_ammoniumConc, & - tracerObject % index_silicateConc, & - tracerObject % index_DMSPpConc, & - tracerObject % index_DMSPdConc, & - tracerObject % index_DMSConc, & - tracerObject % index_humicsConc, & - tracerObject % index_nonreactiveConc, & - tracerObject % index_verticalAerosolsConcLayer, & - tracerObject % index_algaeConcLayer, & - tracerObject % index_algalCarbonLayer, & - tracerObject % index_algalChlorophyllLayer, & - tracerObject % index_DOCConcLayer, & - tracerObject % index_DONConcLayer, & - tracerObject % index_DICConcLayer, & - tracerObject % index_dissolvedIronConcLayer, & - tracerObject % index_particulateIronConcLayer, & - tracerObject % index_nitrateConcLayer, & - tracerObject % index_ammoniumConcLayer, & - tracerObject % index_silicateConcLayer, & - tracerObject % index_DMSPpConcLayer, & - tracerObject % index_DMSPdConcLayer, & - tracerObject % index_DMSConcLayer, & - tracerObject % index_humicsConcLayer, & - tracerObject % index_nonreactiveConcLayer, & - tracerObject % index_mobileFraction, & - tracerObject % index_verticalSalinity, & - tracerObject % index_chlorophyllShortwave, & - tracerObject % index_verticalAerosolsConcShortwave, & - tracerObject % nAlgaeIndex, & - tracerObject % nAlgalCarbonIndex, & - tracerObject % nAlgalChlorophyllIndex, & - tracerObject % nDOCIndex, & - tracerObject % nDONIndex, & - tracerObject % nDICIndex, & - tracerObject % nDissolvedIronIndex, & - tracerObject % nParticulateIronIndex, & - tracerObject % nzAerosolsIndex, & - tracerObject % index_LayerIndexToDataArray, & - tracerObject % index_LayerIndexToBioIndex, & - tracerObject % nBioTracers) - - !nt_Tsfc = tracerObject % index_surfaceTemperature - !nt_qice = tracerObject % index_iceEnthalpy - !nt_qsno = tracerObject % index_snowEnthalpy - !nt_sice = tracerObject % index_iceSalinity - !nt_iage = tracerObject % index_iceAge - !nt_FY = tracerObject % index_firstYearIceArea - !nt_alvl = tracerObject % index_levelIceArea - !nt_vlvl = tracerObject % index_levelIceVolume - !nt_apnd = tracerObject % index_pondArea - !nt_hpnd = tracerObject % index_pondDepth - !nt_ipnd = tracerObject % index_pondLidThickness - !nt_aero = tracerObject % index_aerosols - !nt_smice = tracerObject % index_snowIceMass - !nt_rsnw = tracerObject % index_snowGrainRadius - !nt_rhos = tracerObject % index_snowDensity - !nt_smliq = tracerObject % index_snowLiquidMass - !nt_fbri = tracerObject % index_brineFraction - !nt_zaeros = tracerObject % index_verticalAerosolsConc - !nt_bgc_N = tracerObject % index_algaeConc - !nt_bgc_C = tracerObject % index_algalCarbon - !nt_bgc_chl = tracerObject % index_algalChlorophyll - !nt_bgc_DOC = tracerObject % index_DOCConc - !nt_bgc_DON = tracerObject % index_DONConc - !nt_bgc_DIC = tracerObject % index_DICConc - !nt_bgc_Fed = tracerObject % index_dissolvedIronConc - !nt_bgc_Fep = tracerObject % index_particulateIronConc - !nt_bgc_Nit = tracerObject % index_nitrateConc - !nt_bgc_Am = tracerObject % index_ammoniumConc - !nt_bgc_Sil = tracerObject % index_silicateConc - !nt_bgc_DMSPp = tracerObject % index_DMSPpConc - !nt_bgc_DMSPd = tracerObject % index_DMSPdConc - !nt_bgc_DMS = tracerObject % index_DMSConc - !nt_bgc_hum = tracerObject % index_humicsConc - !nt_bgc_PON = tracerObject % index_nonreactiveConc - !nlt_zaero = tracerObject % index_verticalAerosolsConcLayer - !nlt_bgc_N = tracerObject % index_algaeConcLayer - !nlt_bgc_C = tracerObject % index_algalCarbonLayer - !nlt_bgc_chl = tracerObject % index_algalChlorophyllLayer - !nlt_bgc_DOC = tracerObject % index_DOCConcLayer - !nlt_bgc_DON = tracerObject % index_DONConcLayer - !nlt_bgc_DIC = tracerObject % index_DICConcLayer - !nlt_bgc_Fed = tracerObject % index_dissolvedIronConcLayer - !nlt_bgc_Fep = tracerObject % index_particulateIronConcLayer - !nlt_bgc_Nit = tracerObject % index_nitrateConcLayer - !nlt_bgc_Am = tracerObject % index_ammoniumConcLayer - !nlt_bgc_Sil = tracerObject % index_silicateConcLayer - !nlt_bgc_DMSPp = tracerObject % index_DMSPpConcLayer - !nlt_bgc_DMSPd = tracerObject % index_DMSPdConcLayer - !nlt_bgc_DMS = tracerObject % index_DMSConcLayer - !nlt_bgc_hum = tracerObject % index_humicsConcLayer - !nlt_bgc_PON = tracerObject % index_nonreactiveConcLayer - !nt_zbgc_frac = tracerObject % index_mobileFraction - !nt_zbgc_S = tracerObject % index_verticalSalinity - !nlt_chl_sw = tracerObject % index_chlorophyllShortwave - !nlt_zaero_sw = tracerObject % index_verticalAerosolsConcShortwave - !max_algae = tracerObject % nAlgaeIndex - !max_algae = tracerObject % nAlgalCarbonIndex - !max_algae = tracerObject % nAlgalChlorophyllIndex - !max_doc = tracerObject % nDOCIndex - !max_don = tracerObject % nDONIndex - !max_dic = tracerObject % nDICIndex - !max_fe = tracerObject % nDissolvedIronIndex - !max_fe = tracerObject % nParticulateIronIndex - !max_aero = tracerObject % nzAerosolsIndex - !bio_index_o = tracerObject % index_LayerIndexToDataArray - !bio_index = tracerObject % index_LayerIndexToBioIndex - !nbtrcr = tracerObject % nBioTracers - - end subroutine init_column_package_tracer_indices - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_package_configs -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 2nd Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_package_configs(domain) - - !use ice_colpkg_shared, only: & - ! ktherm, & - ! conduct, & - ! fbot_xfer_type, & - ! heat_capacity, & - ! calc_Tsfc, & - ! ustar_min, & - ! a_rapid_mode, & - ! Rac_rapid_mode, & - ! aspect_rapid_mode, & - ! dSdt_slow_mode, & - ! phi_c_slow_mode, & - ! phi_i_mushy, & - ! shortwave, & - ! albedo_type, & - ! albicev, & - ! albicei, & - ! albsnowv, & - ! albsnowi, & - ! ahmax, & - ! R_ice, & - ! R_pnd, & - ! R_snw, & - ! dT_mlt, & - ! rsnw_mlt, & - ! kalg, & - ! kstrength, & - ! krdg_partic, & - ! krdg_redist, & - ! mu_rdg, & - ! Cf, & - ! atmbndy, & - ! calc_strair, & - ! formdrag, & - ! highfreq, & - ! natmiter, & - ! oceanmixed_ice, & - ! tfrz_option, & - ! kitd, & - ! kcatbound, & - ! hs0, & - ! frzpnd, & - ! dpscale, & - ! rfracmin, & - ! rfracmax, & - ! pndaspect, & - ! hs1, & - ! hp1 - ! bgc_flux_type, & - ! z_tracers, & - ! scale_bgc, & - ! solve_zbgc, & - ! dEdd_algae, & - ! modal_aero, & - ! skl_bgc, & - ! solve_zsal, & - ! grid_o, & - ! l_sk, & - ! grid_o_t, & - ! initbio_frac, & - ! frazil_scav, & - ! grid_oS, & - ! l_skS, & - ! phi_snow, & - ! ratio_Si2N_diatoms, & - ! ratio_Si2N_sp , & - ! ratio_Si2N_phaeo , & - ! ratio_S2N_diatoms , & - ! ratio_S2N_sp , & - ! ratio_S2N_phaeo , & - ! ratio_Fe2C_diatoms, & - ! ratio_Fe2C_sp , & - ! ratio_Fe2C_phaeo , & - ! ratio_Fe2N_diatoms, & - ! ratio_Fe2N_sp , & - ! ratio_Fe2N_phaeo , & - ! ratio_Fe2DON , & - ! ratio_Fe2DOC_s , & - ! ratio_Fe2DOC_l , & - ! fr_resp , & - ! tau_min , & - ! tau_max , & - ! algal_vel , & - ! R_dFe2dust , & - ! dustFe_sol , & - ! chlabs_diatoms , & - ! chlabs_sp , & - ! chlabs_phaeo , & - ! alpha2max_low_diatoms , & - ! alpha2max_low_sp , & - ! alpha2max_low_phaeo , & - ! beta2max_diatoms , & - ! beta2max_sp , & - ! beta2max_phaeo , & - ! mu_max_diatoms , & - ! mu_max_sp , & - ! mu_max_phaeo , & - ! grow_Tdep_diatoms, & - ! grow_Tdep_sp , & - ! grow_Tdep_phaeo , & - ! fr_graze_diatoms , & - ! fr_graze_sp , & - ! fr_graze_phaeo , & - ! mort_pre_diatoms , & - ! mort_pre_sp , & - ! mort_pre_phaeo , & - ! mort_Tdep_diatoms, & - ! mort_Tdep_sp , & - ! mort_Tdep_phaeo , & - ! k_exude_diatoms , & - ! k_exude_sp , & - ! k_exude_phaeo , & - ! K_Nit_diatoms , & - ! K_Nit_sp , & - ! K_Nit_phaeo , & - ! K_Am_diatoms , & - ! K_Am_sp , & - ! K_Am_phaeo , & - ! K_Sil_diatoms , & - ! K_Sil_sp , & - ! K_Sil_phaeo , & - ! K_Fe_diatoms , & - ! K_Fe_sp , & - ! K_Fe_phaeo , & - ! f_don_protein , & - ! kn_bac_protein , & - ! f_don_Am_protein , & - ! f_doc_s , & - ! f_doc_l , & - ! f_exude_s , & - ! f_exude_l , & - ! k_bac_s , & - ! k_bac_l , & - ! T_max , & - ! fsal , & - ! op_dep_min , & - ! fr_graze_s , & - ! fr_graze_e , & - ! fr_mort2min , & - ! fr_dFe , & - ! k_nitrif , & - ! t_iron_conv , & - ! max_loss , & - ! max_dfe_doc1 , & - ! fr_resp_s , & - ! y_sk_DMS , & - ! t_sk_conv , & - ! t_sk_ox , & - ! algaltype_diatoms , & - ! algaltype_sp , & - ! algaltype_phaeo , & - ! nitratetype , & - ! ammoniumtype , & - ! silicatetype , & - ! dmspptype , & - ! dmspdtype , & - ! humtype , & - ! doctype_s , & - ! doctype_l , & - ! dontype_protein , & - ! fedtype_1 , & - ! feptype_1 , & - ! zaerotype_bc1 , & - ! zaerotype_bc2 , & - ! zaerotype_dust1 , & - ! zaerotype_dust2 , & - ! zaerotype_dust3 , & - ! zaerotype_dust4 , & - ! ratio_C2N_diatoms , & - ! ratio_C2N_sp , & - ! ratio_C2N_phaeo , & - ! ratio_chl2N_diatoms, & - ! ratio_chl2N_sp , & - ! ratio_chl2N_phaeo , & - ! F_abs_chl_diatoms , & - ! F_abs_chl_sp , & - ! F_abs_chl_phaeo , & - ! ratio_C2N_proteins - - use ice_colpkg, only: & - colpkg_init_parameters - - type(domain_type), intent(inout) :: & - domain - - character(len=strKIND), pointer :: & - config_thermodynamics_type, & - config_heat_conductivity_type, & - config_shortwave_type, & - config_albedo_type, & - config_ice_strength_formulation, & - config_ridging_participation_function, & - config_ridging_redistribution_function, & - config_atmos_boundary_method, & - config_itd_conversion_type, & - config_category_bounds_type, & - config_pond_refreezing_type, & - config_ocean_heat_transfer_type, & - config_sea_freezing_temperature_type, & - config_skeletal_bgc_flux_type, & - config_snow_redistribution_scheme - - logical, pointer :: & - config_calc_surface_temperature, & - config_use_form_drag, & - config_use_high_frequency_coupling, & - config_use_ocean_mixed_layer, & - config_calc_surface_stresses, & - config_use_vertical_tracers, & - config_scale_initial_vertical_bgc, & - config_use_vertical_biochemistry, & - config_use_shortwave_bioabsorption, & - config_use_skeletal_biochemistry, & - config_use_vertical_zsalinity, & - config_use_modal_aerosols, & - config_use_snicar_ad, & - config_use_snow_liquid_ponds - - real(kind=RKIND), pointer :: & - config_min_friction_velocity, & - config_ice_ocean_drag_coefficient, & - config_snow_thermal_conductivity, & - config_rapid_mode_channel_radius, & - config_rapid_model_critical_Ra, & - config_rapid_mode_aspect_ratio, & - config_slow_mode_drainage_strength, & - config_slow_mode_critical_porosity, & - config_congelation_ice_porosity, & - config_visible_ice_albedo, & - config_infrared_ice_albedo, & - config_visible_snow_albedo, & - config_infrared_snow_albedo, & - config_variable_albedo_thickness_limit, & - config_ice_shortwave_tuning_parameter, & - config_pond_shortwave_tuning_parameter, & - config_snow_shortwave_tuning_parameter, & - config_temp_change_snow_grain_radius_change, & - config_max_melting_snow_grain_radius, & - config_algae_absorption_coefficient, & - config_ridging_efolding_scale, & - config_ratio_ridging_work_to_PE, & - config_snow_to_ice_transition_depth, & - config_pond_flushing_factor, & - config_min_meltwater_retained_fraction, & - config_max_meltwater_retained_fraction, & - config_pond_depth_to_fraction_ratio, & - config_snow_on_pond_ice_tapering_parameter, & - config_critical_pond_ice_thickness, & - config_biogrid_bottom_molecular_sublayer, & - config_bio_gravity_drainage_length_scale, & - config_biogrid_top_molecular_sublayer, & - config_new_ice_fraction_biotracer, & - config_fraction_biotracer_in_frazil, & - config_zsalinity_molecular_sublayer, & - config_zsalinity_gravity_drainage_scale, & - config_snow_porosity_at_ice_surface, & - config_ratio_Si_to_N_diatoms, & - config_ratio_Si_to_N_small_plankton, & - config_ratio_Si_to_N_phaeocystis, & - config_ratio_S_to_N_diatoms, & - config_ratio_S_to_N_small_plankton, & - config_ratio_S_to_N_phaeocystis, & - config_ratio_Fe_to_C_diatoms, & - config_ratio_Fe_to_C_small_plankton, & - config_ratio_Fe_to_C_phaeocystis, & - config_ratio_Fe_to_N_diatoms, & - config_ratio_Fe_to_N_small_plankton, & - config_ratio_Fe_to_N_phaeocystis, & - config_ratio_Fe_to_DON, & - config_ratio_Fe_to_DOC_saccharids, & - config_ratio_Fe_to_DOC_lipids, & - config_respiration_fraction_of_growth, & - config_rapid_mobile_to_stationary_time, & - config_long_mobile_to_stationary_time, & - config_algal_maximum_velocity, & - config_ratio_Fe_to_dust, & - config_solubility_of_Fe_in_dust, & - config_chla_absorptivity_of_diatoms, & - config_chla_absorptivity_of_small_plankton, & - config_chla_absorptivity_of_phaeocystis, & - config_light_attenuation_diatoms, & - config_light_attenuation_small_plankton, & - config_light_attenuation_phaeocystis, & - config_light_inhibition_diatoms, & - config_light_inhibition_small_plankton, & - config_light_inhibition_phaeocystis, & - config_maximum_growth_rate_diatoms, & - config_maximum_growth_rate_small_plankton, & - config_maximum_growth_rate_phaeocystis, & - config_temperature_growth_diatoms, & - config_temperature_growth_small_plankton, & - config_temperature_growth_phaeocystis, & - config_grazed_fraction_diatoms, & - config_grazed_fraction_small_plankton, & - config_grazed_fraction_phaeocystis, & - config_mortality_diatoms, & - config_mortality_small_plankton, & - config_mortality_phaeocystis, & - config_temperature_mortality_diatoms, & - config_temperature_mortality_small_plankton, & - config_temperature_mortality_phaeocystis, & - config_exudation_diatoms, & - config_exudation_small_plankton, & - config_exudation_phaeocystis, & - config_nitrate_saturation_diatoms, & - config_nitrate_saturation_small_plankton, & - config_nitrate_saturation_phaeocystis, & - config_ammonium_saturation_diatoms, & - config_ammonium_saturation_small_plankton, & - config_ammonium_saturation_phaeocystis, & - config_silicate_saturation_diatoms, & - config_silicate_saturation_small_plankton, & - config_silicate_saturation_phaeocystis, & - config_iron_saturation_diatoms, & - config_iron_saturation_small_plankton, & - config_iron_saturation_phaeocystis, & - config_fraction_spilled_to_DON, & - config_degredation_of_DON, & - config_fraction_DON_ammonium, & - config_fraction_loss_to_saccharids, & - config_fraction_loss_to_lipids, & - config_fraction_exudation_to_saccharids, & - config_fraction_exudation_to_lipids, & - config_remineralization_saccharids, & - config_remineralization_lipids, & - config_maximum_brine_temperature, & - config_salinity_dependence_of_growth, & - config_minimum_optical_depth, & - config_slopped_grazing_fraction, & - config_excreted_fraction, & - config_fraction_mortality_to_ammonium, & - config_fraction_iron_remineralized, & - config_nitrification_rate, & - config_desorption_loss_particulate_iron, & - config_maximum_loss_fraction, & - config_maximum_ratio_iron_to_saccharids, & - config_respiration_loss_to_DMSPd, & - config_DMSP_to_DMS_conversion_fraction, & - config_DMSP_to_DMS_conversion_time, & - config_DMS_oxidation_time, & - config_mobility_type_diatoms, & - config_mobility_type_small_plankton, & - config_mobility_type_phaeocystis, & - config_mobility_type_nitrate, & - config_mobility_type_ammonium, & - config_mobility_type_silicate, & - config_mobility_type_DMSPp, & - config_mobility_type_DMSPd, & - config_mobility_type_humics, & - config_mobility_type_saccharids, & - config_mobility_type_lipids, & - config_mobility_type_inorganic_carbon, & - config_mobility_type_proteins, & - config_mobility_type_dissolved_iron, & - config_mobility_type_particulate_iron, & - config_mobility_type_black_carbon1, & - config_mobility_type_black_carbon2, & - config_mobility_type_dust1, & - config_mobility_type_dust2, & - config_mobility_type_dust3, & - config_mobility_type_dust4, & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_chla_to_N_diatoms, & - config_ratio_chla_to_N_small_plankton, & - config_ratio_chla_to_N_phaeocystis, & - config_scales_absorption_diatoms, & - config_scales_absorption_small_plankton, & - config_scales_absorption_phaeocystis, & - config_ratio_C_to_N_proteins, & - config_fallen_snow_radius, & - config_new_snow_density, & - config_max_snow_density, & - config_minimum_wind_compaction, & - config_snow_redistribution_factor, & - config_wind_compaction_factor, & - config_max_dry_snow_radius - - integer, pointer :: & - config_boundary_layer_iteration_number - - call MPAS_pool_get_config(domain % configs, "config_thermodynamics_type", config_thermodynamics_type) - call MPAS_pool_get_config(domain % configs, "config_heat_conductivity_type", config_heat_conductivity_type) - call MPAS_pool_get_config(domain % configs, "config_ocean_heat_transfer_type", config_ocean_heat_transfer_type) - call MPAS_pool_get_config(domain % configs, "config_calc_surface_temperature", config_calc_surface_temperature) - call MPAS_pool_get_config(domain % configs, "config_min_friction_velocity", config_min_friction_velocity) - call MPAS_pool_get_config(domain % configs, "config_ice_ocean_drag_coefficient", config_ice_ocean_drag_coefficient) - call MPAS_pool_get_config(domain % configs, "config_snow_thermal_conductivity", config_snow_thermal_conductivity) - call MPAS_pool_get_config(domain % configs, "config_rapid_mode_channel_radius", config_rapid_mode_channel_radius) - call MPAS_pool_get_config(domain % configs, "config_rapid_model_critical_Ra", config_rapid_model_critical_Ra) - call MPAS_pool_get_config(domain % configs, "config_rapid_mode_aspect_ratio", config_rapid_mode_aspect_ratio) - call MPAS_pool_get_config(domain % configs, "config_slow_mode_drainage_strength", config_slow_mode_drainage_strength) - call MPAS_pool_get_config(domain % configs, "config_slow_mode_critical_porosity", config_slow_mode_critical_porosity) - call MPAS_pool_get_config(domain % configs, "config_congelation_ice_porosity", config_congelation_ice_porosity) - call MPAS_pool_get_config(domain % configs, "config_shortwave_type", config_shortwave_type) - call MPAS_pool_get_config(domain % configs, "config_use_snicar_ad", config_use_snicar_ad) - call MPAS_pool_get_config(domain % configs, "config_albedo_type", config_albedo_type) - call MPAS_pool_get_config(domain % configs, "config_visible_ice_albedo", config_visible_ice_albedo) - call MPAS_pool_get_config(domain % configs, "config_infrared_ice_albedo", config_infrared_ice_albedo) - call MPAS_pool_get_config(domain % configs, "config_visible_snow_albedo", config_visible_snow_albedo) - call MPAS_pool_get_config(domain % configs, "config_infrared_snow_albedo", config_infrared_snow_albedo) - call MPAS_pool_get_config(domain % configs, "config_variable_albedo_thickness_limit", config_variable_albedo_thickness_limit) - call MPAS_pool_get_config(domain % configs, "config_ice_shortwave_tuning_parameter", config_ice_shortwave_tuning_parameter) - call MPAS_pool_get_config(domain % configs, "config_pond_shortwave_tuning_parameter", config_pond_shortwave_tuning_parameter) - call MPAS_pool_get_config(domain % configs, "config_snow_shortwave_tuning_parameter", config_snow_shortwave_tuning_parameter) - call MPAS_pool_get_config(domain % configs, "config_temp_change_snow_grain_radius_change", & - config_temp_change_snow_grain_radius_change) - call MPAS_pool_get_config(domain % configs, "config_max_melting_snow_grain_radius", config_max_melting_snow_grain_radius) - call MPAS_pool_get_config(domain % configs, "config_algae_absorption_coefficient", config_algae_absorption_coefficient) - call MPAS_pool_get_config(domain % configs, "config_ice_strength_formulation", config_ice_strength_formulation) - call MPAS_pool_get_config(domain % configs, "config_ridging_participation_function", config_ridging_participation_function) - call MPAS_pool_get_config(domain % configs, "config_ridging_redistribution_function", config_ridging_redistribution_function) - call MPAS_pool_get_config(domain % configs, "config_ridging_efolding_scale", config_ridging_efolding_scale) - call MPAS_pool_get_config(domain % configs, "config_ratio_ridging_work_to_PE", config_ratio_ridging_work_to_PE) - call MPAS_pool_get_config(domain % configs, "config_atmos_boundary_method", config_atmos_boundary_method) - call MPAS_pool_get_config(domain % configs, "config_calc_surface_stresses", config_calc_surface_stresses) - call MPAS_pool_get_config(domain % configs, "config_use_form_drag", config_use_form_drag) - call MPAS_pool_get_config(domain % configs, "config_use_high_frequency_coupling", config_use_high_frequency_coupling) - call MPAS_pool_get_config(domain % configs, "config_boundary_layer_iteration_number", config_boundary_layer_iteration_number) - call MPAS_pool_get_config(domain % configs, "config_use_ocean_mixed_layer", config_use_ocean_mixed_layer) - call MPAS_pool_get_config(domain % configs, "config_sea_freezing_temperature_type", config_sea_freezing_temperature_type) - call MPAS_pool_get_config(domain % configs, "config_itd_conversion_type", config_itd_conversion_type) - call MPAS_pool_get_config(domain % configs, "config_category_bounds_type", config_category_bounds_type) - call MPAS_pool_get_config(domain % configs, "config_snow_to_ice_transition_depth", config_snow_to_ice_transition_depth) - call MPAS_pool_get_config(domain % configs, "config_pond_refreezing_type", config_pond_refreezing_type) - call MPAS_pool_get_config(domain % configs, "config_pond_flushing_factor", config_pond_flushing_factor) - call MPAS_pool_get_config(domain % configs, "config_min_meltwater_retained_fraction", config_min_meltwater_retained_fraction) - call MPAS_pool_get_config(domain % configs, "config_max_meltwater_retained_fraction", config_max_meltwater_retained_fraction) - call MPAS_pool_get_config(domain % configs, "config_pond_depth_to_fraction_ratio", config_pond_depth_to_fraction_ratio) - call MPAS_pool_get_config(domain % configs, "config_snow_on_pond_ice_tapering_parameter", & - config_snow_on_pond_ice_tapering_parameter) - call MPAS_pool_get_config(domain % configs, "config_critical_pond_ice_thickness", config_critical_pond_ice_thickness) - call MPAS_pool_get_config(domain % configs, "config_skeletal_bgc_flux_type", config_skeletal_bgc_flux_type) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(domain % configs, "config_scale_initial_vertical_bgc", config_scale_initial_vertical_bgc) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) - call MPAS_pool_get_config(domain % configs, "config_use_modal_aerosols", config_use_modal_aerosols) - call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_biogrid_bottom_molecular_sublayer", & - config_biogrid_bottom_molecular_sublayer) - call MPAS_pool_get_config(domain % configs, "config_bio_gravity_drainage_length_scale", & - config_bio_gravity_drainage_length_scale) - call MPAS_pool_get_config(domain % configs, "config_biogrid_top_molecular_sublayer", config_biogrid_top_molecular_sublayer) - call MPAS_pool_get_config(domain % configs, "config_zsalinity_gravity_drainage_scale", config_zsalinity_gravity_drainage_scale) - call MPAS_pool_get_config(domain % configs, "config_new_ice_fraction_biotracer", config_new_ice_fraction_biotracer) - call MPAS_pool_get_config(domain % configs, "config_fraction_biotracer_in_frazil", config_fraction_biotracer_in_frazil) - call MPAS_pool_get_config(domain % configs, "config_zsalinity_molecular_sublayer", config_zsalinity_molecular_sublayer) - call MPAS_pool_get_config(domain % configs, "config_snow_porosity_at_ice_surface", config_snow_porosity_at_ice_surface) - call MPAS_pool_get_config(domain % configs, "config_ratio_Si_to_N_diatoms", config_ratio_Si_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_Si_to_N_small_plankton", config_ratio_Si_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_Si_to_N_phaeocystis", config_ratio_Si_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_S_to_N_diatoms", config_ratio_S_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_S_to_N_small_plankton", config_ratio_S_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_S_to_N_phaeocystis", config_ratio_S_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_C_diatoms", config_ratio_Fe_to_C_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_C_small_plankton", config_ratio_Fe_to_C_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_C_phaeocystis", config_ratio_Fe_to_C_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_N_diatoms", config_ratio_Fe_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_N_small_plankton", config_ratio_Fe_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_N_phaeocystis", config_ratio_Fe_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_DON", config_ratio_Fe_to_DON) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_DOC_saccharids", config_ratio_Fe_to_DOC_saccharids) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_DOC_lipids", config_ratio_Fe_to_DOC_lipids) - call MPAS_pool_get_config(domain % configs, "config_respiration_fraction_of_growth", config_respiration_fraction_of_growth) - call MPAS_pool_get_config(domain % configs, "config_rapid_mobile_to_stationary_time", config_rapid_mobile_to_stationary_time) - call MPAS_pool_get_config(domain % configs, "config_long_mobile_to_stationary_time", config_long_mobile_to_stationary_time) - call MPAS_pool_get_config(domain % configs, "config_algal_maximum_velocity", config_algal_maximum_velocity) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_dust", config_ratio_Fe_to_dust) - call MPAS_pool_get_config(domain % configs, "config_solubility_of_Fe_in_dust", config_solubility_of_Fe_in_dust) - call MPAS_pool_get_config(domain % configs, "config_chla_absorptivity_of_diatoms", config_chla_absorptivity_of_diatoms) - call MPAS_pool_get_config(domain % configs, "config_chla_absorptivity_of_small_plankton", & - config_chla_absorptivity_of_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_chla_absorptivity_of_phaeocystis", config_chla_absorptivity_of_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_light_attenuation_diatoms", config_light_attenuation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_light_attenuation_small_plankton", config_light_attenuation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_light_attenuation_phaeocystis", config_light_attenuation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_light_inhibition_diatoms", config_light_inhibition_diatoms) - call MPAS_pool_get_config(domain % configs, "config_light_inhibition_small_plankton", config_light_inhibition_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_light_inhibition_phaeocystis", config_light_inhibition_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_maximum_growth_rate_diatoms", config_maximum_growth_rate_diatoms) - call MPAS_pool_get_config(domain % configs, "config_maximum_growth_rate_small_plankton", & - config_maximum_growth_rate_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_maximum_growth_rate_phaeocystis", config_maximum_growth_rate_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_temperature_growth_diatoms", config_temperature_growth_diatoms) - call MPAS_pool_get_config(domain % configs, "config_temperature_growth_small_plankton", & - config_temperature_growth_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_temperature_growth_phaeocystis", config_temperature_growth_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_grazed_fraction_diatoms", config_grazed_fraction_diatoms) - call MPAS_pool_get_config(domain % configs, "config_grazed_fraction_small_plankton", config_grazed_fraction_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_grazed_fraction_phaeocystis", config_grazed_fraction_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_mortality_diatoms", config_mortality_diatoms) - call MPAS_pool_get_config(domain % configs, "config_mortality_small_plankton", config_mortality_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_mortality_phaeocystis", config_mortality_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_temperature_mortality_diatoms", config_temperature_mortality_diatoms) - call MPAS_pool_get_config(domain % configs, "config_temperature_mortality_small_plankton", & - config_temperature_mortality_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_temperature_mortality_phaeocystis", & - config_temperature_mortality_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_exudation_diatoms", config_exudation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_exudation_small_plankton", config_exudation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_exudation_phaeocystis", config_exudation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_nitrate_saturation_diatoms", config_nitrate_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_nitrate_saturation_small_plankton", & - config_nitrate_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_nitrate_saturation_phaeocystis", config_nitrate_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ammonium_saturation_diatoms", config_ammonium_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ammonium_saturation_small_plankton", & - config_ammonium_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ammonium_saturation_phaeocystis", & - config_ammonium_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_silicate_saturation_diatoms", config_silicate_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_silicate_saturation_small_plankton", & - config_silicate_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_silicate_saturation_phaeocystis", config_silicate_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_iron_saturation_diatoms", config_iron_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_iron_saturation_small_plankton", config_iron_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_iron_saturation_phaeocystis", config_iron_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_fraction_spilled_to_DON", config_fraction_spilled_to_DON) - call MPAS_pool_get_config(domain % configs, "config_degredation_of_DON", config_degredation_of_DON) - call MPAS_pool_get_config(domain % configs, "config_fraction_DON_ammonium", config_fraction_DON_ammonium) - call MPAS_pool_get_config(domain % configs, "config_fraction_loss_to_saccharids", config_fraction_loss_to_saccharids) - call MPAS_pool_get_config(domain % configs, "config_fraction_loss_to_lipids", config_fraction_loss_to_lipids) - call MPAS_pool_get_config(domain % configs, "config_fraction_exudation_to_saccharids", config_fraction_exudation_to_saccharids) - call MPAS_pool_get_config(domain % configs, "config_fraction_exudation_to_lipids", config_fraction_exudation_to_lipids) - call MPAS_pool_get_config(domain % configs, "config_remineralization_saccharids", config_remineralization_saccharids) - call MPAS_pool_get_config(domain % configs, "config_remineralization_lipids", config_remineralization_lipids) - call MPAS_pool_get_config(domain % configs, "config_maximum_brine_temperature", config_maximum_brine_temperature) - call MPAS_pool_get_config(domain % configs, "config_salinity_dependence_of_growth", config_salinity_dependence_of_growth) - call MPAS_pool_get_config(domain % configs, "config_minimum_optical_depth", config_minimum_optical_depth) - call MPAS_pool_get_config(domain % configs, "config_slopped_grazing_fraction", config_slopped_grazing_fraction) - call MPAS_pool_get_config(domain % configs, "config_excreted_fraction", config_excreted_fraction) - call MPAS_pool_get_config(domain % configs, "config_fraction_mortality_to_ammonium", config_fraction_mortality_to_ammonium) - call MPAS_pool_get_config(domain % configs, "config_fraction_iron_remineralized", config_fraction_iron_remineralized) - call MPAS_pool_get_config(domain % configs, "config_nitrification_rate", config_nitrification_rate) - call MPAS_pool_get_config(domain % configs, "config_desorption_loss_particulate_iron", config_desorption_loss_particulate_iron) - call MPAS_pool_get_config(domain % configs, "config_maximum_loss_fraction", config_maximum_loss_fraction) - call MPAS_pool_get_config(domain % configs, "config_maximum_ratio_iron_to_saccharids", config_maximum_ratio_iron_to_saccharids) - call MPAS_pool_get_config(domain % configs, "config_respiration_loss_to_DMSPd", config_respiration_loss_to_DMSPd) - call MPAS_pool_get_config(domain % configs, "config_DMSP_to_DMS_conversion_fraction", config_DMSP_to_DMS_conversion_fraction) - call MPAS_pool_get_config(domain % configs, "config_DMSP_to_DMS_conversion_time", config_DMSP_to_DMS_conversion_time) - call MPAS_pool_get_config(domain % configs, "config_DMS_oxidation_time", config_DMS_oxidation_time) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_diatoms", config_mobility_type_diatoms) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_small_plankton", config_mobility_type_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_phaeocystis", config_mobility_type_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_nitrate", config_mobility_type_nitrate) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_ammonium", config_mobility_type_ammonium) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_silicate", config_mobility_type_silicate) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_DMSPp", config_mobility_type_DMSPp) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_DMSPd", config_mobility_type_DMSPd) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_humics", config_mobility_type_humics) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_saccharids", config_mobility_type_saccharids) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_lipids", config_mobility_type_lipids) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_inorganic_carbon", config_mobility_type_inorganic_carbon) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_proteins", config_mobility_type_proteins) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dissolved_iron", config_mobility_type_dissolved_iron) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_particulate_iron", config_mobility_type_particulate_iron) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_black_carbon1", config_mobility_type_black_carbon1) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_black_carbon2", config_mobility_type_black_carbon2) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust1", config_mobility_type_dust1) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust2", config_mobility_type_dust2) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust3", config_mobility_type_dust3) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust4", config_mobility_type_dust4) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_diatoms", config_ratio_C_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_small_plankton", config_ratio_C_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_phaeocystis", config_ratio_C_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_chla_to_N_diatoms", config_ratio_chla_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_chla_to_N_small_plankton", config_ratio_chla_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_chla_to_N_phaeocystis", config_ratio_chla_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_scales_absorption_diatoms", config_scales_absorption_diatoms) - call MPAS_pool_get_config(domain % configs, "config_scales_absorption_small_plankton", config_scales_absorption_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_scales_absorption_phaeocystis", config_scales_absorption_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_proteins", config_ratio_C_to_N_proteins) - call MPAS_pool_get_config(domain % configs, "config_snow_redistribution_scheme", config_snow_redistribution_scheme) - call MPAS_pool_get_config(domain % configs, "config_fallen_snow_radius", config_fallen_snow_radius) - call MPAS_pool_get_config(domain % configs, "config_use_snow_liquid_ponds", config_use_snow_liquid_ponds) - call MPAS_pool_get_config(domain % configs, "config_new_snow_density", config_new_snow_density) - call MPAS_pool_get_config(domain % configs, "config_max_snow_density", config_max_snow_density) - call MPAS_pool_get_config(domain % configs, "config_minimum_wind_compaction", config_minimum_wind_compaction) - call MPAS_pool_get_config(domain % configs, "config_snow_redistribution_factor", config_snow_redistribution_factor) - call MPAS_pool_get_config(domain % configs, "config_wind_compaction_factor", config_wind_compaction_factor) - call MPAS_pool_get_config(domain % configs, "config_max_dry_snow_radius", config_max_dry_snow_radius) - - call colpkg_init_parameters(& - config_cice_int("config_thermodynamics_type", config_thermodynamics_type), & - config_heat_conductivity_type, & - config_ocean_heat_transfer_type, & - config_calc_surface_temperature, & - config_min_friction_velocity, & - config_ice_ocean_drag_coefficient, & - config_snow_thermal_conductivity, & - config_rapid_mode_channel_radius, & - config_rapid_model_critical_Ra, & - config_rapid_mode_aspect_ratio, & - config_slow_mode_drainage_strength, & - config_slow_mode_critical_porosity, & - config_congelation_ice_porosity, & - config_shortwave_type, & - config_use_snicar_ad, & - config_albedo_type, & - config_visible_ice_albedo, & - config_infrared_ice_albedo, & - config_visible_snow_albedo, & - config_infrared_snow_albedo, & - config_variable_albedo_thickness_limit, & - config_ice_shortwave_tuning_parameter, & - config_pond_shortwave_tuning_parameter, & - config_snow_shortwave_tuning_parameter, & - config_temp_change_snow_grain_radius_change, & - config_max_melting_snow_grain_radius, & - config_algae_absorption_coefficient, & - config_cice_int("config_ice_strength_formulation", config_ice_strength_formulation), & - config_cice_int("config_ridging_participation_function", config_ridging_participation_function), & - config_cice_int("config_ridging_redistribution_function", config_ridging_redistribution_function), & - config_ridging_efolding_scale, & - config_ratio_ridging_work_to_PE, & - config_atmos_boundary_method, & - config_calc_surface_stresses, & - config_use_form_drag, & - config_use_high_frequency_coupling, & - config_boundary_layer_iteration_number, & - config_use_ocean_mixed_layer, & - config_sea_freezing_temperature_type, & - config_cice_int("config_itd_conversion_type", config_itd_conversion_type), & - config_cice_int("config_category_bounds_type", config_category_bounds_type), & - config_snow_to_ice_transition_depth, & - config_pond_refreezing_type, & - config_pond_flushing_factor, & - config_min_meltwater_retained_fraction, & - config_max_meltwater_retained_fraction, & - config_pond_depth_to_fraction_ratio, & - config_snow_on_pond_ice_tapering_parameter, & - config_critical_pond_ice_thickness, & - config_skeletal_bgc_flux_type, & - config_use_vertical_tracers, & - config_scale_initial_vertical_bgc, & - config_use_vertical_biochemistry, & - config_use_shortwave_bioabsorption, & - config_use_modal_aerosols, & - config_use_skeletal_biochemistry, & - config_use_vertical_zsalinity, & - config_biogrid_bottom_molecular_sublayer, & - config_bio_gravity_drainage_length_scale, & - config_biogrid_top_molecular_sublayer, & - config_new_ice_fraction_biotracer, & - config_fraction_biotracer_in_frazil, & - config_zsalinity_molecular_sublayer, & - config_zsalinity_gravity_drainage_scale, & - config_snow_porosity_at_ice_surface, & - config_ratio_Si_to_N_diatoms, & - config_ratio_Si_to_N_small_plankton, & - config_ratio_Si_to_N_phaeocystis, & - config_ratio_S_to_N_diatoms, & - config_ratio_S_to_N_small_plankton, & - config_ratio_S_to_N_phaeocystis, & - config_ratio_Fe_to_C_diatoms, & - config_ratio_Fe_to_C_small_plankton, & - config_ratio_Fe_to_C_phaeocystis, & - config_ratio_Fe_to_N_diatoms, & - config_ratio_Fe_to_N_small_plankton, & - config_ratio_Fe_to_N_phaeocystis, & - config_ratio_Fe_to_DON, & - config_ratio_Fe_to_DOC_saccharids, & - config_ratio_Fe_to_DOC_lipids, & - config_respiration_fraction_of_growth, & - config_rapid_mobile_to_stationary_time, & - config_long_mobile_to_stationary_time, & - config_algal_maximum_velocity, & - config_ratio_Fe_to_dust, & - config_solubility_of_Fe_in_dust, & - config_chla_absorptivity_of_diatoms, & - config_chla_absorptivity_of_small_plankton, & - config_chla_absorptivity_of_phaeocystis, & - config_light_attenuation_diatoms, & - config_light_attenuation_small_plankton, & - config_light_attenuation_phaeocystis, & - config_light_inhibition_diatoms, & - config_light_inhibition_small_plankton, & - config_light_inhibition_phaeocystis, & - config_maximum_growth_rate_diatoms, & - config_maximum_growth_rate_small_plankton, & - config_maximum_growth_rate_phaeocystis, & - config_temperature_growth_diatoms, & - config_temperature_growth_small_plankton, & - config_temperature_growth_phaeocystis, & - config_grazed_fraction_diatoms, & - config_grazed_fraction_small_plankton, & - config_grazed_fraction_phaeocystis, & - config_mortality_diatoms, & - config_mortality_small_plankton, & - config_mortality_phaeocystis, & - config_temperature_mortality_diatoms, & - config_temperature_mortality_small_plankton, & - config_temperature_mortality_phaeocystis, & - config_exudation_diatoms, & - config_exudation_small_plankton, & - config_exudation_phaeocystis, & - config_nitrate_saturation_diatoms, & - config_nitrate_saturation_small_plankton, & - config_nitrate_saturation_phaeocystis, & - config_ammonium_saturation_diatoms, & - config_ammonium_saturation_small_plankton, & - config_ammonium_saturation_phaeocystis, & - config_silicate_saturation_diatoms, & - config_silicate_saturation_small_plankton, & - config_silicate_saturation_phaeocystis, & - config_iron_saturation_diatoms, & - config_iron_saturation_small_plankton, & - config_iron_saturation_phaeocystis, & - config_fraction_spilled_to_DON, & - config_degredation_of_DON, & - config_fraction_DON_ammonium, & - config_fraction_loss_to_saccharids, & - config_fraction_loss_to_lipids, & - config_fraction_exudation_to_saccharids, & - config_fraction_exudation_to_lipids, & - config_remineralization_saccharids, & - config_remineralization_lipids, & - config_maximum_brine_temperature, & - config_salinity_dependence_of_growth, & - config_minimum_optical_depth, & - config_slopped_grazing_fraction, & - config_excreted_fraction, & - config_fraction_mortality_to_ammonium, & - config_fraction_iron_remineralized, & - config_nitrification_rate, & - config_desorption_loss_particulate_iron, & - config_maximum_loss_fraction, & - config_maximum_ratio_iron_to_saccharids, & - config_respiration_loss_to_DMSPd, & - config_DMSP_to_DMS_conversion_fraction, & - config_DMSP_to_DMS_conversion_time, & - config_DMS_oxidation_time, & - config_mobility_type_diatoms, & - config_mobility_type_small_plankton, & - config_mobility_type_phaeocystis, & - config_mobility_type_nitrate, & - config_mobility_type_ammonium, & - config_mobility_type_silicate, & - config_mobility_type_DMSPp, & - config_mobility_type_DMSPd, & - config_mobility_type_humics, & - config_mobility_type_saccharids, & - config_mobility_type_lipids, & - config_mobility_type_inorganic_carbon, & - config_mobility_type_proteins, & - config_mobility_type_dissolved_iron, & - config_mobility_type_particulate_iron, & - config_mobility_type_black_carbon1, & - config_mobility_type_black_carbon2, & - config_mobility_type_dust1, & - config_mobility_type_dust2, & - config_mobility_type_dust3, & - config_mobility_type_dust4, & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_chla_to_N_diatoms, & - config_ratio_chla_to_N_small_plankton, & - config_ratio_chla_to_N_phaeocystis, & - config_scales_absorption_diatoms, & - config_scales_absorption_small_plankton, & - config_scales_absorption_phaeocystis, & - config_ratio_C_to_N_proteins, & - config_snow_redistribution_scheme, & - config_use_snow_liquid_ponds, & - config_fallen_snow_radius, & - config_max_dry_snow_radius, & - config_new_snow_density, & - config_max_snow_density, & - config_minimum_wind_compaction, & - config_snow_redistribution_factor, & - config_wind_compaction_factor) - - !----------------------------------------------------------------------- - ! Parameters for thermodynamics - !----------------------------------------------------------------------- - - ! ktherm: - ! type of thermodynamics - ! 0 = 0-layer approximation - ! 1 = Bitz and Lipscomb 1999 - ! 2 = mushy layer theory - !ktherm = config_cice_int("config_thermodynamics_type", config_thermodynamics_type) - - ! conduct: - ! 'MU71' or 'bubbly' - !conduct = config_heat_conductivity_type - - ! calc_Tsfc: - ! if true, calculate surface temperature - ! if false, Tsfc is computed elsewhere and - ! atmos-ice fluxes are provided to CICE - !calc_Tsfc = config_calc_surface_temperature - - ! ustar_min: - ! minimum friction velocity for ice-ocean heat flux - !ustar_min = config_min_friction_velocity - - ! mushy thermodynamics: - - ! a_rapid_mode: - ! channel radius for rapid drainage mode (m) - !a_rapid_mode = config_rapid_mode_channel_radius - - ! Rac_rapid_mode: - ! critical rayleigh number for rapid drainage mode - !Rac_rapid_mode = config_rapid_model_critical_Ra - - ! aspect_rapid_mode: - ! aspect ratio for rapid drainage mode (larger=wider) - !aspect_rapid_mode = config_rapid_mode_aspect_ratio - - ! dSdt_slow_mode: - ! slow mode drainage strength (m s-1 K-1) - !dSdt_slow_mode = config_slow_mode_drainage_strength - - ! phi_c_slow_mode: - ! liquid fraction porosity cutoff for slow mode - !phi_c_slow_mode = config_slow_mode_critical_porosity - - ! phi_i_mushy: - ! liquid fraction of congelation ice - !phi_i_mushy = config_congelation_ice_porosity - - !----------------------------------------------------------------------- - ! Parameters for radiation - !----------------------------------------------------------------------- - - ! shortwave: - ! shortwave method, 'default' ('ccsm3') or 'dEdd' - !shortwave = config_shortwave_type - - ! albedo_type: - ! albedo parameterization, 'default' ('ccsm3') or 'constant' - ! shortwave='dEdd' overrides this parameter - !albedo_type = config_albedo_type - - ! baseline albedos for ccsm3 shortwave, set in namelist - - ! albicev: - ! visible ice albedo for h > ahmax - !albicev = config_visible_ice_albedo - - ! albicei: - ! near-ir ice albedo for h > ahmax - !albicei = config_infrared_ice_albedo - - ! albsnowv: - ! cold snow albedo, visible - !albsnowv = config_visible_snow_albedo - - ! albsnowi: - ! cold snow albedo, near IR - !albsnowi = config_infrared_snow_albedo - - ! ahmax: - ! thickness above which ice albedo is constant (m) - !ahmax = config_variable_albedo_thickness_limit - - ! dEdd tuning parameters, set in namelist - - ! R_ice: - ! sea ice tuning parameter; +1 > 1sig increase in albedo - !R_ice = config_ice_shortwave_tuning_parameter - - ! R_pnd: - ! ponded ice tuning parameter; +1 > 1sig increase in albedo - !R_pnd = config_pond_shortwave_tuning_parameter - - ! R_snw: - ! snow tuning parameter; +1 > ~.01 change in broadband albedo - !R_snw = config_snow_shortwave_tuning_parameter - - ! dT_mlt: - ! change in temp for non-melt to melt snow grain radius change (C) - !dT_mlt = config_temp_change_snow_grain_radius_change - - ! rsnw_mlt: - ! maximum melting snow grain radius (10^-6 m) - !rsnw_mlt = config_max_melting_snow_grain_radius - - ! kalg: - ! algae absorption coefficient for 0.5 m thick layer - !kalg = config_algae_absorption_coefficient - - !----------------------------------------------------------------------- - ! Parameters for ridging and strength - !----------------------------------------------------------------------- - - ! kstrength: - ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - !kstrength = config_cice_int("config_ice_strength_formulation", config_ice_strength_formulation) - - ! krdg_partic: - ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - !krdg_partic = config_cice_int("config_ridging_participation_function", config_ridging_participation_function) - - ! krdg_redist: - ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - !krdg_redist = config_cice_int("config_ridging_redistribution_function", config_ridging_redistribution_function) - - ! mu_rdg: - ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) - !mu_rdg = config_ridging_efolding_scale - - ! Cf - ! ratio of ridging work to PE change in ridging (kstrength = 1) - !Cf = config_ratio_ridging_work_to_PE - - !----------------------------------------------------------------------- - ! Parameters for atmosphere - !----------------------------------------------------------------------- - - ! atmbndy: - ! atmo boundary method, 'default' ('ccsm3') or 'constant' - !atmbndy = config_atmos_boundary_method - - ! calc_strair: - ! if true, calculate wind stress components - !calc_strair = config_calc_surface_stresses - - ! formdrag: - ! if true, calculate form drag - !formdrag = config_use_form_drag - - ! highfreq: - ! if true, use high frequency coupling - !highfreq = config_use_high_frequency_coupling - - ! natmiter: - ! number of iterations for boundary layer calculations - !natmiter = config_boundary_layer_iteration_number - - !----------------------------------------------------------------------- - ! Parameters for ocean - !----------------------------------------------------------------------- - - ! oceanmixed_ice: - ! if true, use ocean mixed layer - !oceanmixed_ice = config_use_ocean_mixed_layer - - ! fbot_xfer_type: - ! transfer coefficient type for ice-ocean heat flux - !fbot_xfer_type = config_ocean_heat_transfer_type - - ! tfrz_option: - ! form of ocean freezing temperature - ! 'minus1p8' = -1.8 C - ! 'linear_salt' = -depressT * sss - ! 'mushy' conforms with ktherm=2 - !tfrz_option = config_sea_freezing_temperature_type - - ! dragio: - ! neutral ice-ocean drag coefficient - ! dragio = config_ice_ocean_drag_coefficient - - !----------------------------------------------------------------------- - ! Parameters for the ice thickness distribution - !----------------------------------------------------------------------- - - ! kitd: - ! type of itd conversions - ! 0 = delta function - ! 1 = linear remap - !kitd = config_cice_int("config_itd_conversion_type", config_itd_conversion_type) - - ! kcatbound: - ! 0 = old category boundary formula - ! 1 = new formula giving round numbers - ! 2 = WMO standard - ! 3 = asymptotic formula - !kcatbound = config_cice_int("config_category_bounds_type", config_category_bounds_type) - - !----------------------------------------------------------------------- - ! Parameters for melt ponds - !----------------------------------------------------------------------- - - ! hs0: - ! snow depth for transition to bare sea ice (m) - !hs0 = config_snow_to_ice_transition_depth - - ! level-ice ponds - - ! frzpnd: - ! pond refreezing parameterization - !frzpnd = config_pond_refreezing_type - - ! dpscale: - ! alters e-folding time scale for flushing with BL99 thermodynamics - !dpscale = config_pond_flushing_factor - - ! rfracmin: - ! minimum retained fraction of meltwater - !rfracmin = config_min_meltwater_retained_fraction - - ! rfracmax: - ! maximum retained fraction of meltwater - !rfracmax = config_max_meltwater_retained_fraction - - ! pndaspect: - ! ratio of pond depth to pond fraction - !pndaspect = config_pond_depth_to_fraction_ratio - - ! hs1: - ! tapering parameter for snow on pond ice - !hs1 = config_snow_on_pond_ice_tapering_parameter - - ! topo ponds - - ! hp1 - ! critical parameter for pond ice thickness - !hp1 = config_critical_pond_ice_thickness - - !----------------------------------------------------------------------- - ! Parameters for biogeochemistry - !----------------------------------------------------------------------- - - ! bgc_flux_type: - ! bgc_flux_type = config_skeletal_bgc_flux_type - - ! z_tracers: - ! if .true., bgc or aerosol tracers are vertically resolved - !z_tracers = config_use_vertical_tracers - - ! scale_bgc: - ! if .true., initialize bgc tracers proportionally with salinity - !scale_bgc = config_scale_initial_vertical_bgc - - ! solve_zbgc: - ! if .true., solve vertical biochemistry portion of code - !solve_zbgc = config_use_vertical_biochemistry - - ! dEdd_algae: - ! if .true., algal absorption of Shortwave is computed in the - !dEdd_algae = config_use_shortwave_bioabsorption - - ! skl_bgc: - ! if true, solve skeletal biochemistry - !skl_bgc = config_use_skeletal_biochemistry - - ! solve_zsal: - ! if true, update salinity profile from solve_S_dt - !solve_zsal = config_use_vertical_zsalinity - - ! modal_aero: - ! if true, use modal aerosal optical properties - ! only for use with tr_aero or tr_zaero - !modal_aero = config_use_shortwave_bioabsorption - - ! grid_o: - ! for bottom flux - !grid_o = config_biogrid_bottom_molecular_sublayer - - ! l_sk: - ! characteristic diffusive scale (zsalinity) (m) - !l_sk =config_bio_gravity_drainage_length_scale - - ! grid_o_t: - ! top grid point length scale - !grid_o_t = config_biogrid_top_molecular_sublayer - - ! phi_snow: - ! porosity of snow - !phi_snow = config_snow_porosity_at_ice_surface - - ! initbio_frac: - ! fraction of ocean tracer concentration used to initialize tracer - !initbio_frac = config_new_ice_fraction_biotracer - - ! frazil_scav: - ! multiple of ocean tracer concentration due to frazil scavenging - !frazil_scav = config_fraction_biotracer_in_frazil - - ! ratio_Si2N_diatoms: - ! ratio of algal Silicate to Nitrate (mol/mol) - ! ratio_Si2N_diatoms = config_ratio_Si_to_N_diatoms - - ! ratio_Si2N_sp: - ! ratio of algal Silicate to Nitrogen (mol/mol) - ! ratio_Si2N_sp = config_ratio_Si_to_N_small_plankton - - ! ratio_Si2N_phaeo: - ! ratio of algal Silicate to Nitrogen (mol/mol) - ! ratio_Si2N_phaeo = config_ratio_Si_to_N_phaeocystis - - ! ratio_S2N_diatoms: - ! ratio of algal Sulphur to Nitrogen (mol/mol) - ! ratio_S2N_diatoms = config_ratio_S_to_N_diatoms - - ! ratio_S2N_sp: - ! ratio of algal Sulphur to Nitrogen (mol/mol) - ! ratio_S2N_sp = config_ratio_S_to_N_small_plankton - - ! ratio_S2N_phaeo: - ! ratio of algal Sulphur to Nitrogen (mol/mol) - ! ratio_S2N_phaeo = config_ratio_S_to_N_phaeocystis - - ! ratio_Fe2C_diatoms: - ! ratio of algal iron to carbon (umol/mol) - ! ratio_Fe2C_diatoms = config_ratio_Fe_to_C_diatoms - - ! ratio_Fe2C_sp: - ! ratio of algal iron to carbon (umol/mol) - ! ratio_Fe2C_sp = config_ratio_Fe_to_C_small_plankton - - ! ratio_Fe2C_phaeo: - ! ratio of algal iron to carbon (umol/mol) - ! ratio_Fe2C_phaeo = config_ratio_Fe_to_C_phaeocystis - - ! ratio_Fe2N_diatoms: - ! ratio of algal iron to nitrogen (umol/mol) - ! ratio_Fe2N_diatoms = config_ratio_Fe_to_N_diatoms - - ! ratio_Fe2N_sp: - ! ratio of algal iron to nitrogen (umol/mol) - ! ratio_Fe2N_sp = config_ratio_Fe_to_N_small_plankton - - ! ratio_Fe2N_phaeo: - ! ratio of algal iron to nitrogen (umol/mol) - ! ratio_Fe2N_phaeo = config_ratio_Fe_to_N_phaeocystis - - ! ratio_Fe2DON: - ! ratio of iron to nitrogen of DON (nmol/umol) - ! ratio_Fe2DON = config_ratio_Fe_to_DON - - ! ratio_Fe2DOC_s: - ! ratio of iron to carbon of DOC (nmol/umol) saccharids - ! ratio_Fe2DOC_s = config_ratio_Fe_to_DOC_saccharids - - ! ratio_Fe2DOC_l: - ! ratio of iron to carbon of DOC (nmol/umol) lipids - ! ratio_Fe2DOC_l = config_ratio_Fe_to_DOC_lipids - - ! fr_resp: - ! fraction of algal growth lost due to respiration - ! fr_resp = config_respiration_fraction_of_growth - - ! tau_min: - ! rapid mobile to stationary exchanges (s) = 1.5 hours - ! tau_min = config_rapid_mobile_to_stationary_time - - ! tau_max: - ! long time mobile to stationary exchanges (s) = 2 days - ! tau_max = config_long_mobile_to_stationary_time - - ! algal_vel: - ! 0.5 cm/d(m/s) Lavoie 2005 1.5 cm/day - ! algal_vel = config_algal_maximum_velocity - - ! R_dFe2dust: - ! g/g (3.5% content) Tagliabue 2009 - ! R_dFe2dust = config_ratio_Fe_to_dust - - ! dustFe_sol; - ! solubility fraction - ! dustFe_sol = config_solubility_of_Fe_in_dust - - ! chlabs_diatoms: - ! chl absorption (1/m/(mg/m^3)) - ! chlabs_diatoms = config_chla_absorptivity_of_diatoms - - ! chlabs_sp: - ! chl absorption (1/m/(mg/m^3)) - ! chlabs_sp = config_chla_absorptivity_of_small_plankton - - ! chlabs_phaeo: - ! chl absorption (1/m/(mg/m^3)) - ! chlabs_phaeo = config_chla_absorptivity_of_phaeocystis - - ! alpha2max_low_diatoms: - ! light limitation diatoms (1/(W/m^2)) - ! alpha2max_low_diatoms = config_light_attenuation_diatoms - - ! alpha2max_low_sp: - ! light limitation small plankton (1/(W/m^2)) - ! alpha2max_low_sp = config_light_attenuation_small_plankton - - ! alpha2max_low_phaeo: - ! light limitation phaeocystis (1/(W/m^2)) - ! alpha2max_low_phaeo = config_light_attenuation_phaeocystis - - ! beta2max_diatoms: - ! light inhibition diatoms(1/(W/m^2)) - ! beta2max_diatoms = config_light_inhibition_diatoms - - ! beta2max_sp: - ! light inhibition small plankton(1/(W/m^2)) - ! beta2max_sp = config_light_inhibition_small_plankton - - ! beta2max_phaeo: - ! light inhibition phaeocystis (1/(W/m^2)) - ! beta2max_phaeo = config_light_inhibition_phaeocystis - - ! mu_max_diatoms: - ! maximum growth rate diatoms (1/day) - ! mu_max_diatoms = config_maximum_growth_rate_diatoms - - ! mu_max_sp: - ! maximum growth rate small plankton (1/day) - ! mu_max_sp = config_maximum_growth_rate_small plankton - - ! mu_max_phaeo: - ! maximum growth rate phaeocystis (1/day) - ! mu_max_phaeo = config_maximum_growth_rate_phaeocystis - - ! grow_Tdep_sp: - ! Temperature dependence of growth small plankton (1/C) - ! grow_Tdep_sp = config_temperature_growth_small_plankton - - ! grow_Tdep_phaeo: - ! Temperature dependence of growth phaeocystis (1/C) - ! grow_Tdep_phaeo = config_temperature_growth_phaeocystis - - ! fr_graze_diatoms: - ! Fraction grazed diatoms - ! fr_graze_diatoms = config_grazed_fraction_diatoms - - ! fr_graze_sp: - ! Fraction grazed small_plankton - ! fr_graze_sp = config_grazed_fraction_small_plankton - - ! fr_graze_phaeo: - ! Fraction grazed phaeocystis - ! fr_graze_phaeo = config_grazed_fraction_phaeocystis - - ! mort_pre_diatoms: - ! Mortality diatoms (1/day) - ! mort_pre_diatoms = config_mortality_diatoms - - ! mort_pre_sp: - ! Mortality small_plankton (1/day) - ! mort_pre_sp = config_mortality_small_plankton - - ! mort_pre_phaeo: - ! Mortality phaeocystis (1/day) - ! mort_pre_phaeo = config_mortality_phaeocystis - - ! mort_Tdep_diatoms: - ! T dependence of mortality diatoms (1/C) - ! mort_Tdep_diatoms = config_temperature_mortality_diatoms - - ! mort_Tdep_sp: - ! T dependence of mortality small plankton (1/C) - ! mort_Tdep_sp = config_temperature_mortality_small_plankton - - ! mort_Tdep_phaeo: - ! T dependence of mortality phaeocystis (1/C) - ! mort_Tdep_phaeo = config_temperature_mortality_phaeocystis - - ! k_exude_diatoms: - ! algal exudation diatoms (1/d) - ! k_exude_diatoms = config_exudation_diatoms - - ! k_exude_sp: - ! algal exudation small_plankton (1/d) - ! k_exude_sp = config_exudation_small_plankton - - ! k_exude_phaeo: - ! algal exudation phaeocystis (1/d) - ! k_exude_phaeo = config_exudation_phaeocystis - - ! K_Nit_diatoms: - ! nitrate half saturation diatoms (mmol/m^3) - ! K_Nit_diatoms = config_nitrate_saturation_diatoms - - ! K_Nit_sp: - ! nitrate half saturation small_plankton (mmol/m^3) - ! K_Nit_sp = config_nitrate_saturation_small_plankton - - ! K_Nit_phaeo: - ! nitrate half saturation phaeocystis (mmol/m^3) - ! K_Nit_phaeocystis = config_nitrate_saturation_phaeocystis - - ! K_Am_diatoms: - ! ammonium half saturation diatoms (mmol/m^3) - ! K_Am_diatoms = config_ammonium_saturation_diatoms - - ! K_Am_sp: - ! ammonium half saturation small_plankton (mmol/m^3) - ! K_Am_sp = config_ammonium_saturation_small_plankton - - ! K_Am_phaeo: - ! ammonium half saturation phaeocystis (mmol/m^3) - ! K_Am_phaeocystis = config_ammonium_saturation_phaeocystis - - ! K_Sil_diatoms: - ! silicate half saturation diatoms (mmol/m^3) - ! K_Sil_diatoms = config_silicate_saturation_diatoms - - ! K_Sil_sp: - ! silicate half saturation small_plankton (mmol/m^3) - ! K_Sil_sp = config_silicate_saturation_small_plankton - - ! K_Sil_phaeo: - ! silicate half saturation phaeocystis (mmol/m^3) - ! K_Sil_phaeocystis = config_silicate_saturation_phaeocystis - - ! K_Fe_diatoms: - ! iron half saturation diatoms (nM) - ! K_Fe_diatoms = config_iron_saturation_diatoms - - ! K_Fe_sp: - ! iron half saturation small_plankton (nM) - ! K_Fe_sp = config_iron_saturation_small_plankton - - ! K_Fe_phaeo: - ! iron half saturation phaeocystis (nM) - ! K_Fe_phaeocystis = config_iron_saturation_phaeocystis - - ! f_don_protein: - ! fraction of spilled grazing to proteins ! - ! f_don_protein = config_fraction_spilled_to_DON - - ! kn_bac_protein: - ! Bacterial degredation of DON (1/d) ! ! - ! kn_bac_protein = config_degredation_of_DON - - ! f_don_Am_protein: - ! fraction of remineralized DON to ammonium ! - ! f_don_Am_protein = config_fraction_DON_ammonium - - ! f_doc_s: - ! fraction of mortality to DOC saccharids - ! f_doc_s = config_fraction_loss_to_saccharids - - ! f_doc_l: - ! fraction of mortality to DOC lipids - ! f_doc_l = config_fraction_loss_to_lipids - - ! f_exude_s: - ! fraction of exudation to DOC saccharids - ! f_exude_s = config_fraction_exudation_to_saccharids - - ! f_exude_l: - ! fraction of exudation to DOC lipids - ! f_exude_l = config_fraction_exudation_to_lipids - - ! k_bac_s: - ! Bacterial degredation of DOC (1/d) saccharids - ! k_bac_s = config_remineralization_saccharids - - ! k_bac_l: - ! Bacterial degredation of DOC (1/d) lipids - ! k_bac_l = config_remineralization_lipids - - ! T_max: - ! maximum temperature (C) - ! T_max = config_maximum_brine_temperature - - ! fsal: - ! Salinity limitation (ppt) - ! fsal = config_salinity_dependence_of_growth - - ! op_dep_min: - ! Light attenuates for optical depths exceeding min - ! op_dep_min = config_minimum_optical_depth - - ! fr_graze_s: - ! fraction of grazing spilled or slopped - ! fr_graze_s = config_slopped_grazing_fraction - - ! fr_graze_e: - ! fraction of assimilation excreted - ! fr_graze_e = config_excreted_fraction - - ! fr_mort2min: - ! fractionation of mortality to Am - ! fr_mort2min = config_fraction_mortality_to_ammonium - - ! fr_dFe: - ! remineralized nitrogen (in units of algal iron) - ! fr_dFe = config_fraction_iron_remineralized - - ! k_nitrif: - ! nitrification rate (1/day) - ! k_nitrif = config_nitrification_rate - - ! t_iron_conv: - ! desorption loss pFe to dFe (day) - ! t_iron_conv = config_desorption_loss_particulate_iron - - ! max_loss: - ! restrict uptake to % of remaining value - ! max_loss = config_maximum_loss_fraction - - ! max_dfe_doc1: - ! max ratio of dFe to saccharides in the ice (nM Fe/muM C) - ! max_dfe_doc1 = config_maximum_ratio_iron_to_saccharids - - ! fr_resp_s: - ! DMSPd fraction of respiration loss as DMSPd - ! fr_resp_s = config_respiration_loss_to_DMSPd - - ! y_sk_DMS: - ! fraction conversion given high yield - ! y_sk_DMS = config_DMSP_to_DMS_conversion_fraction - - ! t_sk_conv: - ! Stefels conversion time (d) - ! t_sk_conv = config_DMSP_to_DMS_conversion_time - - ! t_sk_ox: - ! DMS oxidation time (d) - ! t_sk_ox = config_DMS_oxidation_time - - ! algaltype_diatoms: - ! mobility type diatoms - ! algaltype_diatoms = config_mobility_type_diatoms - - ! algaltype_sp: - ! mobility type small_plankton - ! algaltype_sp = config_mobility_type_small_plankton - - ! algaltype_phaeo: - ! mobility type phaeocystis - ! algaltype_phaeo = config_mobility_type_phaeocystis - - ! nitratetype: - ! mobility type nitrate - ! nitratetype = config_mobility_type_nitrate - - ! ammoniumtype: - ! mobility type ammonium - ! ammoniumtype = config_mobility_type_ammonium - - ! silicatetype: - ! mobility type silicate - ! silicatetype = config_mobility_type_silicate - - ! dmspptype: - ! mobility type DMSPp - ! dmspptype = config_mobility_type_DMSPp - - ! dmspdtype: - ! mobility type DMSPd - ! dmspdtype = config_mobility_type_DMSPd - - ! humicstype: - ! mobility type humics - ! humicstype = config_mobility_type_humics - - ! doctype_s: - ! mobility type sachharids - ! doctype_s = config_mobility_type_saccharids - - ! doctype_l: - ! mobility type lipids - ! doctype_l = config_mobility_type_lipids - - ! dictype_1: - ! mobility type dissolved inorganic carbon - ! dictype_1 = config_mobility_type_inorganic_carbon - - ! dontype_protein: - ! mobility type proteins - ! dontype_protein = config_mobility_type_proteins - - ! fedtype_1: - ! mobility type dissolved iron - ! fedtype_1 = config_mobility_type_dissolved_iron - - ! feptype_1: - ! mobility type particulate iron - ! feptype_1 = config_mobility_type_particulate_iron - - ! zaerotype_bc1: - ! mobility type for black carbon 1 - ! zaerotype_bc1 = config_mobility_type_black_carbon1 - - ! zaerotype_bc2: - ! mobility type for black carbon 2 - ! zaerotype_bc2 = config_mobility_type_black_carbon2 - - ! zaerotype_dust1: - ! mobility type for dust 1 - ! zaerotype_dust1 = config_mobility_type_dust1 - - ! zaerotype_dust2: - ! mobility type for dust 2 - ! zaerotype_dust2 = config_mobility_type_dust2 - - ! zaerotype_dust3: - ! mobility type for dust 3 - ! zaerotype_dust3 = config_mobility_type_dust3 - - ! zaerotype_dust4: - ! mobility type for dust 4 - ! zaerotype_dust4 = config_mobility_type_dust4 - - ! ratio_C2N_diatoms: - ! algal C to N ratio (mol/mol) diatoms - ! ratio_C2N_diatoms = config_ratio_C_to_N_diatoms - - ! ratio_C2N_sp: - ! algal C to N ratio (mol/mol) small_plankton - ! ratio_C2N_sp = config_ratio_C_to_N_small_plankton - - ! ratio_C2N_phaeo: - ! algal C to N ratio (mol/mol) phaeocystis - ! ratio_C2N_phaeo = config_ratio_C_to_N_phaeocystis - - ! ratio_chl2N_diatoms: - ! algal chla to N ratio (mol/mol) diatoms - ! ratio_chl2N_diatoms = config_ratio_chla_to_N_diatoms - - ! ratio_chl2N_sp: - ! algal chla to N ratio (mol/mol) small_plankton - ! ratio_chl2N_sp = config_ratio_chla_to_N_small_plankton - - ! ratio_chl2N_phaeo: - ! algal chla to N ratio (mol/mol) phaeocystis - ! ratio_chl2N_phaeo = config_ratio_chla_to_N_phaeocystis - - ! F_abs_chl_diatoms: - ! scales absorbed radiation for dEdd diatoms - ! F_abs_chl_diatoms = config_scales_absorption_diatoms - - ! F_abs_chl_sp: - ! scales absorbed radiation for dEdd small_plankton - ! F_abs_chl_sp = config_scales_absorption_small_plankton - - ! F_abs_chl_phaeo: - ! scales absorbed radiation for dEdd phaeocystis - ! F_abs_chl_phaeo = config_scales_absorption_phaeocystis - - ! ratio_C2N_proteins: - ! ratio of C to N in proteins (mol/mol) - ! ratio_C2N_proteins = config_ratio_C_to_N_proteins - - ! grid_oS: - ! for bottom flux (zsalinity) - !grid_oS = config_zsalinity_molecular_sublayer - - ! l_skS: - ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) - !l_skS = config_zsalinity_gravity_drainage_scale - - !----------------------------------------------------------------------- - ! Parameters for snow - !----------------------------------------------------------------------- - - ! snwredist: - ! snow redistribution type - ! snwredist = config_snow_redistribution_scheme - - ! use_smliq_pnd: - ! convert excess snow liquid to ponds - ! use_smliq_pnd = config_use_snow_liquid_ponds - - ! rsnw_fall: - ! fallen snow grain radius (um) - ! rsnw_fall = config_fallen_snow_radius - - ! rsnw_tmax: - ! maximum dry metamorphism snow grain radius (um) - ! rsnw_tmax = config_max_dry_snow_radius - - ! rhosnew: - ! new snow density (kg/m^3) - ! rhosnew = config_new_snow_density - - ! rhosmax: - ! maximum snow density (kg/m^3) - ! rhosmax = config_max_snow_density - - ! windmin: - ! minimum wind speed to compact snow (m/s) - ! windmin = config_minimum_wind_compaction - - ! snwlvlfac: - ! snow loss factor for wind redistribution - ! snwlvlfac = config_snow_redistribution_factor - - ! drhosdwind: - ! wind compaction factor (kg s/m^4) - ! drhosdwind = config_wind_compaction_factor - - ! ksno: - ! snow thermal conductivity - ! ksno = config_snow_thermal_conductivity - - end subroutine init_column_package_configs - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! config_error -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th Feburary 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine config_error(config_name, config_value, valid_options) - - character(len=*), intent(in) :: & - config_name, & - config_value, & - valid_options - - call mpas_log_write("config_error: "//trim(config_name)//' has invalid value', messageType=MPAS_LOG_ERR) - call mpas_log_write(trim(config_name)//': '//trim(config_value), messageType=MPAS_LOG_ERR) - call mpas_log_write('valid options: '//trim(valid_options), messageType=MPAS_LOG_CRIT) - - end subroutine config_error - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! config_cice_int -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 20th January 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - function config_cice_int(configName, configValue) result(configValueCice) - - character(len=*), intent(in) :: & - configName, & - configValue - - integer :: configValueCice - - select case (trim(configName)) - - ! ktherm - case ("config_thermodynamics_type") - - select case (trim(configValue)) - case ("zero layer") - configValueCice = 0 - case ("BL99") - configValueCice = 1 - case ("mushy") - configValueCice = 2 - end select - - ! kitd - case ("config_itd_conversion_type") - - select case (trim(configValue)) - case ("delta function") - configValueCice = 0 - case ("linear remap") - configValueCice = 1 - end select - - ! kcatbound - case ("config_category_bounds_type") - - select case (trim(configValue)) - case ("single category") - configValueCice = -1 - case ("original") - configValueCice = 0 - case ("new") - configValueCice = 1 - case ("WMO") - configValueCice = 2 - case ("asymptotic") - configValueCice = 3 - end select - - ! kstrength - case ("config_ice_strength_formulation") - - select case (trim(configValue)) - case ("Hibler79") - configValueCice = 0 - case ("Rothrock75") - configValueCice = 1 - end select - - ! krdg_partic - case ("config_ridging_participation_function") - - select case (trim(configValue)) - case ("Thorndike75") - configValueCice = 0 - case ("exponential") - configValueCice = 1 - end select - - ! krdg_redist - case ("config_ridging_redistribution_function") - - select case (trim(configValue)) - case ("Hibler80") - configValueCice = 0 - case ("exponential") - configValueCice = 1 - end select - - end select - - end function config_cice_int - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_non_activated_pointers -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th March 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_non_activated_pointers(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - mesh, & - drag, & - tracers - - ! packages - logical, pointer :: & - pkgColumnTracerIceAgeActive, & - pkgColumnTracerFirstYearIceActive, & - pkgColumnTracerLevelIceActive, & - pkgColumnTracerPondsActive, & - pkgColumnTracerLidThicknessActive, & - pkgColumnTracerAerosolsActive, & - pkgColumnFormDragActive, & - pkgColumnBiogeochemistryActive, & - pkgTracerBrineActive, & - pkgTracerMobileFractionActive, & - pkgTracerSkeletalAlgaeActive, & - pkgTracerSkeletalNitrateActive, & - pkgTracerSkeletalCarbonActive, & - pkgTracerSkeletalAmmoniumActive, & - pkgTracerSkeletalSilicateActive, & - pkgTracerSkeletalDMSActive, & - pkgTracerSkeletalNonreactiveActive, & - pkgTracerSkeletalHumicsActive, & - pkgTracerSkeletalDONActive, & - pkgTracerSkeletalIronActive, & - pkgTracerVerticalAlgaeActive, & - pkgTracerVerticalNitrateActive, & - pkgTracerVerticalCarbonActive, & - pkgTracerVerticalAmmoniumActive, & - pkgTracerVerticalSilicateActive, & - pkgTracerVerticalDMSActive, & - pkgTracerVerticalNonreactiveActive, & - pkgTracerVerticalHumicsActive, & - pkgTracerVerticalDONActive, & - pkgTracerVerticalIronActive, & - pkgTracerZAerosolsActive, & - pkgTracerZSalinityActive, & - pkgColumnTracerEffectiveSnowDensityActive, & - pkgColumnTracerSnowGrainRadiusActive - - - ! mesh stand-ins - type(field1DReal), pointer :: & - latCell, lonCell ! nCells array - - type(field3DReal), pointer :: & - iceAreaCategory - - ! drag variables - type(field1DReal), pointer :: & - oceanDragCoefficientSkin, & - oceanDragCoefficientFloe, & - oceanDragCoefficientKeel, & - airDragCoefficientSkin, & - airDragCoefficientFloe, & - airDragCoefficientPond, & - airDragCoefficientRidge, & - dragFreeboard, & - dragIceSnowDraft, & - dragRidgeHeight, & - dragRidgeSeparation, & - dragKeelDepth, & - dragKeelSeparation, & - dragFloeLength, & - dragFloeSeparation - - block => domain % blocklist - do while (associated(block)) - - !----------------------------------------------------------------------- - ! tracers - !----------------------------------------------------------------------- - - call MPAS_pool_get_package(block % packages, "pkgColumnTracerIceAgeActive", pkgColumnTracerIceAgeActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerFirstYearIceActive", pkgColumnTracerFirstYearIceActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerLevelIceActive", pkgColumnTracerLevelIceActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerPondsActive", pkgColumnTracerPondsActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerLidThicknessActive", pkgColumnTracerLidThicknessActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerAerosolsActive", pkgColumnTracerAerosolsActive) - call MPAS_pool_get_package(block % packages, "pkgColumnBiogeochemistryActive", pkgColumnBiogeochemistryActive) - call MPAS_pool_get_package(block % packages, "pkgTracerBrineActive", pkgTracerBrineActive) - call MPAS_pool_get_package(block % packages, "pkgTracerMobileFractionActive", pkgTracerMobileFractionActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalAlgaeActive", pkgTracerSkeletalAlgaeActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalNitrateActive", pkgTracerSkeletalNitrateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalCarbonActive", pkgTracerSkeletalCarbonActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalAmmoniumActive", pkgTracerSkeletalAmmoniumActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalSilicateActive", pkgTracerSkeletalSilicateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalDMSActive", pkgTracerSkeletalDMSActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalNonreactiveActive", pkgTracerSkeletalNonreactiveActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalHumicsActive", pkgTracerSkeletalHumicsActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalDONActive", pkgTracerSkeletalDONActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalIronActive", pkgTracerSkeletalIronActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalAlgaeActive", pkgTracerVerticalAlgaeActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalNitrateActive", pkgTracerVerticalNitrateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalCarbonActive", pkgTracerVerticalCarbonActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalAmmoniumActive", pkgTracerVerticalAmmoniumActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalSilicateActive", pkgTracerVerticalSilicateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalDMSActive", pkgTracerVerticalDMSActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalNonreactiveActive", pkgTracerVerticalNonreactiveActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalHumicsActive", pkgTracerVerticalHumicsActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalDONActive", pkgTracerVerticalDONActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalIronActive", pkgTracerVerticalIronActive) - call MPAS_pool_get_package(block % packages, "pkgTracerZAerosolsActive", pkgTracerZAerosolsActive) - call MPAS_pool_get_package(block % packages, "pkgTracerZSalinityActive", pkgTracerZSalinityActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerEffectiveSnowDensityActive", pkgColumnTracerEffectiveSnowDensityActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerSnowGrainRadiusActive", pkgColumnTracerSnowGrainRadiusActive) - - - ! ice age - if (.not. pkgColumnTracerIceAgeActive) then - call set_stand_in_tracer_array(block, "iceAge") - endif - - ! first year ice - if (.not. pkgColumnTracerFirstYearIceActive) then - call set_stand_in_tracer_array(block, "firstYearIceArea") - endif - - ! level ice - if (.not. pkgColumnTracerLevelIceActive) then - call set_stand_in_tracer_array(block, "levelIceArea") - call set_stand_in_tracer_array(block, "levelIceVolume") - endif - - ! ponds - if (.not. pkgColumnTracerPondsActive) then - call set_stand_in_tracer_array(block, "pondArea") - call set_stand_in_tracer_array(block, "pondDepth") - endif - - ! pond lids - if (.not. pkgColumnTracerLidThicknessActive) then - call set_stand_in_tracer_array(block, "pondLidThickness") - endif - - ! aerosols - if (.not. pkgColumnTracerAerosolsActive) then - call set_stand_in_tracer_array(block, "snowScatteringAerosol") - call set_stand_in_tracer_array(block, "snowBodyAerosol") - call set_stand_in_tracer_array(block, "iceScatteringAerosol") - call set_stand_in_tracer_array(block, "iceBodyAerosol") - endif - - ! biogeochemistry - if (.not. pkgTracerBrineActive) then - call set_stand_in_tracer_array(block, "brineFraction") - endif - if (.not. pkgTracerMobileFractionActive) then - call set_stand_in_tracer_array(block, "mobileFraction") - endif - if (.not. pkgTracerSkeletalAlgaeActive) then - call set_stand_in_tracer_array(block, "skeletalAlgaeConc") - endif - if (.not. pkgTracerSkeletalNitrateActive) then - call set_stand_in_tracer_array(block, "skeletalNitrateConc") - endif - if (.not. pkgTracerSkeletalSilicateActive) then - call set_stand_in_tracer_array(block, "skeletalSilicateConc") - endif - if (.not. pkgTracerSkeletalAmmoniumActive) then - call set_stand_in_tracer_array(block, "skeletalAmmoniumConc") - endif - if (.not. pkgTracerSkeletalDMSActive) then - call set_stand_in_tracer_array(block, "skeletalDMSPpConc") - call set_stand_in_tracer_array(block, "skeletalDMSPpConc") - call set_stand_in_tracer_array(block, "skeletalDMSConc") - endif - if (.not. pkgTracerSkeletalCarbonActive) then - call set_stand_in_tracer_array(block, "skeletalDOCConc") - call set_stand_in_tracer_array(block, "skeletalDICConc") - endif - if (.not. pkgTracerSkeletalDONActive) then - call set_stand_in_tracer_array(block, "skeletalDONConc") - endif - if (.not. pkgTracerSkeletalNonreactiveActive) then - call set_stand_in_tracer_array(block, "skeletalNonreactiveConc") - endif - if (.not. pkgTracerSkeletalHumicsActive) then - call set_stand_in_tracer_array(block, "skeletalHumicsConc") - endif - if (.not. pkgTracerSkeletalIronActive) then - call set_stand_in_tracer_array(block, "skeletalParticulateIronConc") - call set_stand_in_tracer_array(block, "skeletalDissolvedIronConc") - endif - if (.not. pkgTracerVerticalAlgaeActive) then - call set_stand_in_tracer_array(block, "verticalAlgaeConc") - call set_stand_in_tracer_array(block, "verticalAlgaeSnow") - call set_stand_in_tracer_array(block, "verticalAlgaeIce") - endif - if (.not. pkgTracerVerticalNitrateActive) then - call set_stand_in_tracer_array(block, "verticalNitrateConc") - call set_stand_in_tracer_array(block, "verticalNitrateSnow") - call set_stand_in_tracer_array(block, "verticalNitrateIce") - endif - if (.not. pkgTracerVerticalSilicateActive) then - call set_stand_in_tracer_array(block, "verticalSilicateConc") - call set_stand_in_tracer_array(block, "verticalSilicateSnow") - call set_stand_in_tracer_array(block, "verticalSilicateIce") - endif - if (.not. pkgTracerVerticalAmmoniumActive) then - call set_stand_in_tracer_array(block, "verticalAmmoniumConc") - call set_stand_in_tracer_array(block, "verticalAmmoniumSnow") - call set_stand_in_tracer_array(block, "verticalAmmoniumIce") - endif - if (.not. pkgTracerVerticalDMSActive) then - call set_stand_in_tracer_array(block, "verticalDMSPpConc") - call set_stand_in_tracer_array(block, "verticalDMSPdConc") - call set_stand_in_tracer_array(block, "verticalDMSConc") - call set_stand_in_tracer_array(block, "verticalDMSPpSnow") - call set_stand_in_tracer_array(block, "verticalDMSPdSnow") - call set_stand_in_tracer_array(block, "verticalDMSSnow") - call set_stand_in_tracer_array(block, "verticalDMSPpIce") - call set_stand_in_tracer_array(block, "verticalDMSPdIce") - call set_stand_in_tracer_array(block, "verticalDMSIce") - endif - if (.not. pkgTracerVerticalCarbonActive) then - call set_stand_in_tracer_array(block, "verticalDOCConc") - call set_stand_in_tracer_array(block, "verticalDICConc") - call set_stand_in_tracer_array(block, "verticalDOCSnow") - call set_stand_in_tracer_array(block, "verticalDICSnow") - call set_stand_in_tracer_array(block, "verticalDOCIce") - call set_stand_in_tracer_array(block, "verticalDICIce") - endif - if (.not. pkgTracerVerticalDONActive) then - call set_stand_in_tracer_array(block, "verticalDONConc") - call set_stand_in_tracer_array(block, "verticalDONSnow") - call set_stand_in_tracer_array(block, "verticalDONIce") - endif - if (.not. pkgTracerVerticalNonreactiveActive) then - call set_stand_in_tracer_array(block, "verticalNonreactiveConc") - call set_stand_in_tracer_array(block, "verticalNonreactiveSnow") - call set_stand_in_tracer_array(block, "verticalNonreactiveIce") - endif - if (.not. pkgTracerVerticalHumicsActive) then - call set_stand_in_tracer_array(block, "verticalHumicsConc") - call set_stand_in_tracer_array(block, "verticalHumicsSnow") - call set_stand_in_tracer_array(block, "verticalHumicsIce") - endif - if (.not. pkgTracerVerticalIronActive) then - call set_stand_in_tracer_array(block, "verticalParticulateIronConc") - call set_stand_in_tracer_array(block, "verticalDissolvedIronConc") - call set_stand_in_tracer_array(block, "verticalParticulateIronSnow") - call set_stand_in_tracer_array(block, "verticalDissolvedIronSnow") - call set_stand_in_tracer_array(block, "verticalParticulateIronIce") - call set_stand_in_tracer_array(block, "verticalDissolvedIronIce") - endif - if (.not. pkgTracerZAerosolsActive) then - call set_stand_in_tracer_array(block, "verticalAerosolsConc") - call set_stand_in_tracer_array(block, "verticalAerosolsSnow") - call set_stand_in_tracer_array(block, "verticalAerosolsIce") - endif - if (.not. pkgTracerZSalinityActive) then - call set_stand_in_tracer_array(block, "verticalSalinity") - endif - - ! snow density tracers - if (.not. pkgColumnTracerEffectiveSnowDensityActive) then - call set_stand_in_tracer_array(block, "snowDensity") - endif - - ! snow grain radius - if (.not. pkgColumnTracerSnowGrainRadiusActive) then - call set_stand_in_tracer_array(block, "snowGrainRadius") - call set_stand_in_tracer_array(block, "snowLiquidMass") - call set_stand_in_tracer_array(block, "snowIceMass") - endif - !----------------------------------------------------------------------- - ! other column packages - !----------------------------------------------------------------------- - - ! form drag - call MPAS_pool_get_package(block % packages, "pkgColumnFormDragActive", pkgColumnFormDragActive) - - if (.not. pkgColumnFormDragActive) then - - ! get mesh stand-ins if have ones of right dimensions - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_field(mesh, "latCell", latCell) ! nCells real array - - call MPAS_pool_get_subpool(block % structs, "drag", drag) - - call MPAS_pool_get_field(drag, "oceanDragCoefficientSkin", oceanDragCoefficientSkin) - call MPAS_pool_get_field(drag, "oceanDragCoefficientFloe", oceanDragCoefficientFloe) - call MPAS_pool_get_field(drag, "oceanDragCoefficientKeel", oceanDragCoefficientKeel) - call MPAS_pool_get_field(drag, "airDragCoefficientSkin", airDragCoefficientSkin) - call MPAS_pool_get_field(drag, "airDragCoefficientFloe", airDragCoefficientFloe) - call MPAS_pool_get_field(drag, "airDragCoefficientPond", airDragCoefficientPond) - call MPAS_pool_get_field(drag, "airDragCoefficientRidge", airDragCoefficientRidge) - call MPAS_pool_get_field(drag, "dragFreeboard", dragFreeboard) - call MPAS_pool_get_field(drag, "dragIceSnowDraft", dragIceSnowDraft) - call MPAS_pool_get_field(drag, "dragRidgeHeight", dragRidgeHeight) - call MPAS_pool_get_field(drag, "dragRidgeSeparation", dragRidgeSeparation) - call MPAS_pool_get_field(drag, "dragKeelDepth", dragKeelDepth) - call MPAS_pool_get_field(drag, "dragKeelSeparation", dragKeelSeparation) - call MPAS_pool_get_field(drag, "dragFloeLength", dragFloeLength) - call MPAS_pool_get_field(drag, "dragFloeSeparation", dragFloeSeparation) - - oceanDragCoefficientSkin % array => latCell % array - oceanDragCoefficientFloe % array => latCell % array - oceanDragCoefficientKeel % array => latCell % array - airDragCoefficientSkin % array => latCell % array - airDragCoefficientFloe % array => latCell % array - airDragCoefficientPond % array => latCell % array - airDragCoefficientRidge % array => latCell % array - dragFreeboard % array => latCell % array - dragIceSnowDraft % array => latCell % array - dragRidgeHeight % array => latCell % array - dragRidgeSeparation % array => latCell % array - dragKeelDepth % array => latCell % array - dragKeelSeparation % array => latCell % array - dragFloeLength % array => latCell % array - dragFloeSeparation % array => latCell % array - - endif - - block => block % next - end do - - end subroutine init_column_non_activated_pointers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! finalize_column_non_activated_pointers -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 29th October 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine finalize_column_non_activated_pointers(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - drag, & - tracers - - ! packages - logical, pointer :: & - pkgColumnTracerIceAgeActive, & - pkgColumnTracerFirstYearIceActive, & - pkgColumnTracerLevelIceActive, & - pkgColumnTracerPondsActive, & - pkgColumnTracerLidThicknessActive, & - pkgColumnTracerAerosolsActive, & - pkgColumnFormDragActive, & - pkgColumnBiogeochemistryActive, & - pkgTracerBrineActive, & - pkgTracerMobileFractionActive, & - pkgTracerSkeletalAlgaeActive, & - pkgTracerSkeletalNitrateActive, & - pkgTracerSkeletalCarbonActive, & - pkgTracerSkeletalAmmoniumActive, & - pkgTracerSkeletalSilicateActive, & - pkgTracerSkeletalDMSActive, & - pkgTracerSkeletalNonreactiveActive, & - pkgTracerSkeletalHumicsActive, & - pkgTracerSkeletalDONActive, & - pkgTracerSkeletalIronActive, & - pkgTracerVerticalAlgaeActive, & - pkgTracerVerticalNitrateActive, & - pkgTracerVerticalCarbonActive, & - pkgTracerVerticalAmmoniumActive, & - pkgTracerVerticalSilicateActive, & - pkgTracerVerticalDMSActive, & - pkgTracerVerticalNonreactiveActive, & - pkgTracerVerticalHumicsActive, & - pkgTracerVerticalDONActive, & - pkgTracerVerticalIronActive, & - pkgTracerZAerosolsActive, & - pkgTracerZSalinityActive, & - pkgColumnTracerEffectiveSnowDensityActive, & - pkgColumnTracerSnowGrainRadiusActive - - ! drag variables - type(field1DReal), pointer :: & - oceanDragCoefficientSkin, & - oceanDragCoefficientFloe, & - oceanDragCoefficientKeel, & - airDragCoefficientSkin, & - airDragCoefficientFloe, & - airDragCoefficientPond, & - airDragCoefficientRidge, & - dragFreeboard, & - dragIceSnowDraft, & - dragRidgeHeight, & - dragRidgeSeparation, & - dragKeelDepth, & - dragKeelSeparation, & - dragFloeLength, & - dragFloeSeparation - - block => domain % blocklist - do while (associated(block)) - - !----------------------------------------------------------------------- - ! tracers - !----------------------------------------------------------------------- - - call MPAS_pool_get_package(block % packages, "pkgColumnTracerIceAgeActive", pkgColumnTracerIceAgeActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerFirstYearIceActive", pkgColumnTracerFirstYearIceActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerLevelIceActive", pkgColumnTracerLevelIceActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerPondsActive", pkgColumnTracerPondsActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerLidThicknessActive", pkgColumnTracerLidThicknessActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerAerosolsActive", pkgColumnTracerAerosolsActive) - call MPAS_pool_get_package(block % packages, "pkgColumnBiogeochemistryActive", pkgColumnBiogeochemistryActive) - call MPAS_pool_get_package(block % packages, "pkgTracerBrineActive", pkgTracerBrineActive) - call MPAS_pool_get_package(block % packages, "pkgTracerMobileFractionActive", pkgTracerMobileFractionActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalAlgaeActive", pkgTracerSkeletalAlgaeActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalNitrateActive", pkgTracerSkeletalNitrateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalCarbonActive", pkgTracerSkeletalCarbonActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalAmmoniumActive", pkgTracerSkeletalAmmoniumActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalSilicateActive", pkgTracerSkeletalSilicateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalDMSActive", pkgTracerSkeletalDMSActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalNonreactiveActive", pkgTracerSkeletalNonreactiveActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalHumicsActive", pkgTracerSkeletalHumicsActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalDONActive", pkgTracerSkeletalDONActive) - call MPAS_pool_get_package(block % packages, "pkgTracerSkeletalIronActive", pkgTracerSkeletalIronActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalAlgaeActive", pkgTracerVerticalAlgaeActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalNitrateActive", pkgTracerVerticalNitrateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalCarbonActive", pkgTracerVerticalCarbonActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalAmmoniumActive", pkgTracerVerticalAmmoniumActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalSilicateActive", pkgTracerVerticalSilicateActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalDMSActive", pkgTracerVerticalDMSActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalNonreactiveActive", pkgTracerVerticalNonreactiveActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalHumicsActive", pkgTracerVerticalHumicsActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalDONActive", pkgTracerVerticalDONActive) - call MPAS_pool_get_package(block % packages, "pkgTracerVerticalIronActive", pkgTracerVerticalIronActive) - call MPAS_pool_get_package(block % packages, "pkgTracerZAerosolsActive", pkgTracerZAerosolsActive) - call MPAS_pool_get_package(block % packages, "pkgTracerZSalinityActive", pkgTracerZSalinityActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerEffectiveSnowDensityActive", pkgColumnTracerEffectiveSnowDensityActive) - call MPAS_pool_get_package(block % packages, "pkgColumnTracerSnowGrainRadiusActive", pkgColumnTracerSnowGrainRadiusActive) - - ! ice age - if (.not. pkgColumnTracerIceAgeActive) then - call finalize_stand_in_tracer_array(block, "iceAge") - endif - - ! first year ice - if (.not. pkgColumnTracerFirstYearIceActive) then - call finalize_stand_in_tracer_array(block, "firstYearIceArea") - endif - - ! level ice - if (.not. pkgColumnTracerLevelIceActive) then - call finalize_stand_in_tracer_array(block, "levelIceArea") - call finalize_stand_in_tracer_array(block, "levelIceVolume") - endif - - ! ponds - if (.not. pkgColumnTracerPondsActive) then - call finalize_stand_in_tracer_array(block, "pondArea") - call finalize_stand_in_tracer_array(block, "pondDepth") - endif - - ! pond lids - if (.not. pkgColumnTracerLidThicknessActive) then - call finalize_stand_in_tracer_array(block, "pondLidThickness") - endif - - ! aerosols - if (.not. pkgColumnTracerAerosolsActive) then - call finalize_stand_in_tracer_array(block, "snowScatteringAerosol") - call finalize_stand_in_tracer_array(block, "snowBodyAerosol") - call finalize_stand_in_tracer_array(block, "iceScatteringAerosol") - call finalize_stand_in_tracer_array(block, "iceBodyAerosol") - endif - - ! biogeochemistry - if (.not. pkgTracerBrineActive) then - call finalize_stand_in_tracer_array(block, "brineFraction") - endif - if (.not. pkgTracerMobileFractionActive) then - call finalize_stand_in_tracer_array(block, "mobileFraction") - endif - if (.not. pkgTracerSkeletalAlgaeActive) then - call finalize_stand_in_tracer_array(block, "skeletalAlgaeConc") - endif - if (.not. pkgTracerSkeletalNitrateActive) then - call finalize_stand_in_tracer_array(block, "skeletalNitrateConc") - endif - if (.not. pkgTracerSkeletalSilicateActive) then - call finalize_stand_in_tracer_array(block, "skeletalSilicateConc") - endif - if (.not. pkgTracerSkeletalAmmoniumActive) then - call finalize_stand_in_tracer_array(block, "skeletalAmmoniumConc") - endif - if (.not. pkgTracerSkeletalDMSActive) then - call finalize_stand_in_tracer_array(block, "skeletalDMSPpConc") - call finalize_stand_in_tracer_array(block, "skeletalDMSPpConc") - call finalize_stand_in_tracer_array(block, "skeletalDMSConc") - endif - if (.not. pkgTracerSkeletalCarbonActive) then - call finalize_stand_in_tracer_array(block, "skeletalDOCConc") - call finalize_stand_in_tracer_array(block, "skeletalDICConc") - endif - if (.not. pkgTracerSkeletalDONActive) then - call finalize_stand_in_tracer_array(block, "skeletalDONConc") - endif - if (.not. pkgTracerSkeletalNonreactiveActive) then - call finalize_stand_in_tracer_array(block, "skeletalNonreactiveConc") - endif - if (.not. pkgTracerSkeletalHumicsActive) then - call finalize_stand_in_tracer_array(block, "skeletalHumicsConc") - endif - if (.not. pkgTracerSkeletalIronActive) then - call finalize_stand_in_tracer_array(block, "skeletalParticulateIronConc") - call finalize_stand_in_tracer_array(block, "skeletalDissolvedIronConc") - endif - if (.not. pkgTracerVerticalAlgaeActive) then - call finalize_stand_in_tracer_array(block, "verticalAlgaeConc") - call finalize_stand_in_tracer_array(block, "verticalAlgaeSnow") - call finalize_stand_in_tracer_array(block, "verticalAlgaeIce") - endif - if (.not. pkgTracerVerticalNitrateActive) then - call finalize_stand_in_tracer_array(block, "verticalNitrateConc") - call finalize_stand_in_tracer_array(block, "verticalNitrateSnow") - call finalize_stand_in_tracer_array(block, "verticalNitrateIce") - endif - if (.not. pkgTracerVerticalSilicateActive) then - call finalize_stand_in_tracer_array(block, "verticalSilicateConc") - call finalize_stand_in_tracer_array(block, "verticalSilicateSnow") - call finalize_stand_in_tracer_array(block, "verticalSilicateIce") - endif - if (.not. pkgTracerVerticalAmmoniumActive) then - call finalize_stand_in_tracer_array(block, "verticalAmmoniumConc") - call finalize_stand_in_tracer_array(block, "verticalAmmoniumSnow") - call finalize_stand_in_tracer_array(block, "verticalAmmoniumIce") - endif - if (.not. pkgTracerVerticalDMSActive) then - call finalize_stand_in_tracer_array(block, "verticalDMSPpConc") - call finalize_stand_in_tracer_array(block, "verticalDMSPdConc") - call finalize_stand_in_tracer_array(block, "verticalDMSConc") - call finalize_stand_in_tracer_array(block, "verticalDMSPpSnow") - call finalize_stand_in_tracer_array(block, "verticalDMSPdSnow") - call finalize_stand_in_tracer_array(block, "verticalDMSSnow") - call finalize_stand_in_tracer_array(block, "verticalDMSPpIce") - call finalize_stand_in_tracer_array(block, "verticalDMSPdIce") - call finalize_stand_in_tracer_array(block, "verticalDMSIce") - endif - if (.not. pkgTracerVerticalCarbonActive) then - call finalize_stand_in_tracer_array(block, "verticalDOCConc") - call finalize_stand_in_tracer_array(block, "verticalDICConc") - call finalize_stand_in_tracer_array(block, "verticalDOCSnow") - call finalize_stand_in_tracer_array(block, "verticalDICSnow") - call finalize_stand_in_tracer_array(block, "verticalDOCIce") - call finalize_stand_in_tracer_array(block, "verticalDICIce") - endif - if (.not. pkgTracerVerticalDONActive) then - call finalize_stand_in_tracer_array(block, "verticalDONConc") - call finalize_stand_in_tracer_array(block, "verticalDONSnow") - call finalize_stand_in_tracer_array(block, "verticalDONIce") - endif - if (.not. pkgTracerVerticalNonreactiveActive) then - call finalize_stand_in_tracer_array(block, "verticalNonreactiveConc") - call finalize_stand_in_tracer_array(block, "verticalNonreactiveSnow") - call finalize_stand_in_tracer_array(block, "verticalNonreactiveIce") - endif - if (.not. pkgTracerVerticalHumicsActive) then - call finalize_stand_in_tracer_array(block, "verticalHumicsConc") - call finalize_stand_in_tracer_array(block, "verticalHumicsSnow") - call finalize_stand_in_tracer_array(block, "verticalHumicsIce") - endif - if (.not. pkgTracerVerticalIronActive) then - call finalize_stand_in_tracer_array(block, "verticalParticulateIronConc") - call finalize_stand_in_tracer_array(block, "verticalDissolvedIronConc") - call finalize_stand_in_tracer_array(block, "verticalParticulateIronSnow") - call finalize_stand_in_tracer_array(block, "verticalDissolvedIronSnow") - call finalize_stand_in_tracer_array(block, "verticalParticulateIronIce") - call finalize_stand_in_tracer_array(block, "verticalDissolvedIronIce") - endif - if (.not. pkgTracerZAerosolsActive) then - call finalize_stand_in_tracer_array(block, "verticalAerosolsConc") - call finalize_stand_in_tracer_array(block, "verticalAerosolsSnow") - call finalize_stand_in_tracer_array(block, "verticalAerosolsIce") - endif - if (.not. pkgTracerZSalinityActive) then - call finalize_stand_in_tracer_array(block, "verticalSalinity") - endif - - ! snow density tracers - if (.not. pkgColumnTracerEffectiveSnowDensityActive) then - call finalize_stand_in_tracer_array(block, "snowDensity") - endif - - ! snow grain radius - if (.not. pkgColumnTracerSnowGrainRadiusActive) then - call finalize_stand_in_tracer_array(block, "snowGrainRadius") - call finalize_stand_in_tracer_array(block, "snowLiquidMass") - call finalize_stand_in_tracer_array(block, "snowIceMass") - endif - !----------------------------------------------------------------------- - ! other column packages - !----------------------------------------------------------------------- - - ! form drag - call MPAS_pool_get_package(block % packages, "pkgColumnFormDragActive", pkgColumnFormDragActive) - - if (.not. pkgColumnFormDragActive) then - - call MPAS_pool_get_subpool(block % structs, "drag", drag) - - call MPAS_pool_get_field(drag, "oceanDragCoefficientSkin", oceanDragCoefficientSkin) - call MPAS_pool_get_field(drag, "oceanDragCoefficientFloe", oceanDragCoefficientFloe) - call MPAS_pool_get_field(drag, "oceanDragCoefficientKeel", oceanDragCoefficientKeel) - call MPAS_pool_get_field(drag, "airDragCoefficientSkin", airDragCoefficientSkin) - call MPAS_pool_get_field(drag, "airDragCoefficientFloe", airDragCoefficientFloe) - call MPAS_pool_get_field(drag, "airDragCoefficientPond", airDragCoefficientPond) - call MPAS_pool_get_field(drag, "airDragCoefficientRidge", airDragCoefficientRidge) - call MPAS_pool_get_field(drag, "dragFreeboard", dragFreeboard) - call MPAS_pool_get_field(drag, "dragIceSnowDraft", dragIceSnowDraft) - call MPAS_pool_get_field(drag, "dragRidgeHeight", dragRidgeHeight) - call MPAS_pool_get_field(drag, "dragRidgeSeparation", dragRidgeSeparation) - call MPAS_pool_get_field(drag, "dragKeelDepth", dragKeelDepth) - call MPAS_pool_get_field(drag, "dragKeelSeparation", dragKeelSeparation) - call MPAS_pool_get_field(drag, "dragFloeLength", dragFloeLength) - call MPAS_pool_get_field(drag, "dragFloeSeparation", dragFloeSeparation) - - oceanDragCoefficientSkin % array => null() - oceanDragCoefficientFloe % array => null() - oceanDragCoefficientKeel % array => null() - airDragCoefficientSkin % array => null() - airDragCoefficientFloe % array => null() - airDragCoefficientPond % array => null() - airDragCoefficientRidge % array => null() - dragFreeboard % array => null() - dragIceSnowDraft % array => null() - dragRidgeHeight % array => null() - dragRidgeSeparation % array => null() - dragKeelDepth % array => null() - dragKeelSeparation % array => null() - dragFloeLength % array => null() - dragFloeSeparation % array => null() - - endif - - block => block % next - end do - - end subroutine finalize_column_non_activated_pointers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! set_stand_in_tracer_array -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 5th March 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine set_stand_in_tracer_array(block, tracerName) - - type(block_type) :: block - - character(len=*), intent(in) :: & - tracerName - - type(MPAS_pool_type), pointer :: & - tracers - - type(field3DReal), pointer :: & - tracerArray, & - iceAreaCategory - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_field(tracers, trim(tracerName), tracerArray, 1) - call MPAS_pool_get_field(tracers, "iceAreaCategory", iceAreaCategory, 1) - - tracerArray % array => iceAreaCategory % array - - end subroutine set_stand_in_tracer_array - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! finalize_stand_in_tracer_array -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 29th October 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine finalize_stand_in_tracer_array(block, tracerName) - - type(block_type) :: block - - character(len=*), intent(in) :: & - tracerName - - type(MPAS_pool_type), pointer :: & - tracers - - type(field3DReal), pointer :: & - tracerArray, & - iceAreaCategory - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_field(tracers, trim(tracerName), tracerArray, 1) - - tracerArray % array => null() - - end subroutine finalize_stand_in_tracer_array - -!----------------------------------------------------------------------- -! other initialization -!----------------------------------------------------------------------- -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_history_variables -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 3rd April 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_history_variables(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - ridging - - real(kind=RKIND), dimension(:,:), pointer :: & - ratioRidgeThicknessToIce - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "ridging", ridging) - call MPAS_pool_get_array(ridging, "ratioRidgeThicknessToIce", ratioRidgeThicknessToIce) - - ratioRidgeThicknessToIce = 1.0_RKIND - - block => block % next - end do - - end subroutine init_column_history_variables - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_initial_air_drag_coefficient -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date -!> \details -!> -! -!----------------------------------------------------------------------- - - function seaice_column_initial_air_drag_coefficient() result(airDragCoefficient) - - use seaice_constants, only: & - seaiceVonKarmanConstant, & - seaiceIceSurfaceRoughness, & - seaiceStabilityReferenceHeight - - real(kind=RKIND) :: airDragCoefficient - - ! atmo drag for RASM - airDragCoefficient = (seaiceVonKarmanConstant/log(seaiceStabilityReferenceHeight/seaiceIceSurfaceRoughness)) & - * (seaiceVonKarmanConstant/log(seaiceStabilityReferenceHeight/seaiceIceSurfaceRoughness)) - - end function seaice_column_initial_air_drag_coefficient - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_reinitialize_fluxes -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 31st August 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_reinitialize_fluxes(domain) - - type(domain_type) :: domain - - ! atmospheric fluxes - call seaice_column_reinitialize_atmospheric_fluxes(domain) - - ! oceanic fluxes - call seaice_column_reinitialize_oceanic_fluxes(domain) - - end subroutine seaice_column_reinitialize_fluxes - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_reinitialize_atmospheric_fluxes -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 31st August 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_reinitialize_atmospheric_fluxes(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - velocitySolverPool, & - atmosFluxesPool, & - shortwavePool, & - atmosCouplingPool - - real(kind=RKIND), dimension(:), pointer :: & - airStressCellU, & - airStressCellV, & - sensibleHeatFlux, & - latentHeatFlux, & - evaporativeWaterFlux, & - longwaveUp, & - absorbedShortwaveFlux, & - atmosReferenceTemperature2m, & - atmosReferenceHumidity2m, & - atmosReferenceSpeed10m - - logical, pointer :: & - config_use_column_physics - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "velocity_solver", velocitySolverPool) - call MPAS_pool_get_subpool(block % structs, "atmos_coupling", atmosCouplingPool) - - call MPAS_pool_get_array(velocitySolverPool, "airStressCellU", airStressCellU) - call MPAS_pool_get_array(velocitySolverPool, "airStressCellV", airStressCellV) - - call MPAS_pool_get_array(atmosCouplingPool, "atmosReferenceTemperature2m", atmosReferenceTemperature2m) - call MPAS_pool_get_array(atmosCouplingPool, "atmosReferenceHumidity2m", atmosReferenceHumidity2m) - call MPAS_pool_get_array(atmosCouplingPool, "atmosReferenceSpeed10m", atmosReferenceSpeed10m) - - airStressCellU(:) = 0.0_RKIND - airStressCellV(:) = 0.0_RKIND - - atmosReferenceTemperature2m(:) = 0.0_RKIND - atmosReferenceHumidity2m(:) = 0.0_RKIND - atmosReferenceSpeed10m(:) = 0.0_RKIND - - call MPAS_pool_get_config(block % configs, "config_use_column_physics", config_use_column_physics) - - if (config_use_column_physics) then - - call MPAS_pool_get_subpool(block % structs, "atmos_fluxes", atmosFluxesPool) - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwavePool) - - call MPAS_pool_get_array(atmosFluxesPool, "sensibleHeatFlux", sensibleHeatFlux) - call MPAS_pool_get_array(atmosFluxesPool, "latentHeatFlux", latentHeatFlux) - call MPAS_pool_get_array(atmosFluxesPool, "evaporativeWaterFlux", evaporativeWaterFlux) - call MPAS_pool_get_array(atmosFluxesPool, "longwaveUp", longwaveUp) - - call MPAS_pool_get_array(shortwavePool, "absorbedShortwaveFlux", absorbedShortwaveFlux) - - absorbedShortwaveFlux(:) = 0.0_RKIND - - sensibleHeatFlux(:) = 0.0_RKIND - latentHeatFlux(:) = 0.0_RKIND - evaporativeWaterFlux(:) = 0.0_RKIND - longwaveUp(:) = 0.0_RKIND - - endif ! config_use_column_physics - - block => block % next - end do - - end subroutine seaice_column_reinitialize_atmospheric_fluxes - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_reinitialize_oceanic_fluxes -! -!> \brief -!> \author Adrian K. Turner, LANL -!> \date 31st August 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine seaice_column_reinitialize_oceanic_fluxes(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - oceanFluxesPool, & - snowPool - - real(kind=RKIND), dimension(:), pointer :: & - oceanFreshWaterFlux, & - oceanSaltFlux, & - oceanHeatFlux, & - oceanShortwaveFlux, & - snowLossToLeads, & - snowMeltMassCell - - logical, pointer :: & - config_use_column_physics, & - config_use_column_snow_tracers - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_config(block % configs, "config_use_column_physics", config_use_column_physics) - call MPAS_pool_get_config(block % configs, "config_use_column_snow_tracers", config_use_column_snow_tracers) - - if (config_use_column_physics) then - - call MPAS_pool_get_subpool(block % structs, "ocean_fluxes", oceanFluxesPool) - - call MPAS_pool_get_array(oceanFluxesPool, "oceanFreshWaterFlux", oceanFreshWaterFlux) - call MPAS_pool_get_array(oceanFluxesPool, "oceanSaltFlux", oceanSaltFlux) - call MPAS_pool_get_array(oceanFluxesPool, "oceanHeatFlux", oceanHeatFlux) - call MPAS_pool_get_array(oceanFluxesPool, "oceanShortwaveFlux", oceanShortwaveFlux) - - oceanFreshWaterFlux(:) = 0.0_RKIND - oceanSaltFlux(:) = 0.0_RKIND - oceanHeatFlux(:) = 0.0_RKIND - oceanShortwaveFlux(:) = 0.0_RKIND - - if (config_use_column_snow_tracers) then - call MPAS_pool_get_subpool(block % structs, "snow", snowPool) - - call MPAS_pool_get_array(snowPool, "snowLossToLeads", snowLossToLeads) - call MPAS_pool_get_array(snowPool, "snowMeltMassCell", snowMeltMassCell) - - snowLossToLeads(:) = 0.0_RKIND - snowMeltMassCell(:) = 0.0_RKIND - - endif ! config_use_column_snow_tracers - - endif ! config_use_column_physics - - block => block % next - end do - - end subroutine seaice_column_reinitialize_oceanic_fluxes - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_tracer_object_bio_tracer_number -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 14 September 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_tracer_object_for_biogeochemistry(domain, tracerObject) - - use ice_colpkg, only: colpkg_init_zbgc - - type(domain_type), intent(in) :: & - domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - logical, pointer :: & - config_use_brine, & - config_use_vertical_zsalinity, & - config_use_vertical_biochemistry, & - config_use_vertical_tracers, & - config_use_skeletal_biochemistry, & - config_use_shortwave_bioabsorption, & - config_use_nitrate, & - config_use_carbon, & - config_use_chlorophyll, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - real(kind=RKIND), pointer :: & - config_new_ice_fraction_biotracer, & - config_fraction_biotracer_in_frazil, & - config_ratio_Si_to_N_diatoms, & - config_ratio_Si_to_N_small_plankton, & - config_ratio_Si_to_N_phaeocystis, & - config_ratio_S_to_N_diatoms, & - config_ratio_S_to_N_small_plankton, & - config_ratio_S_to_N_phaeocystis, & - config_ratio_Fe_to_C_diatoms, & - config_ratio_Fe_to_C_small_plankton, & - config_ratio_Fe_to_C_phaeocystis, & - config_ratio_Fe_to_N_diatoms, & - config_ratio_Fe_to_N_small_plankton, & - config_ratio_Fe_to_N_phaeocystis, & - config_ratio_Fe_to_DON, & - config_ratio_Fe_to_DOC_saccharids, & - config_ratio_Fe_to_DOC_lipids, & - config_chla_absorptivity_of_diatoms, & - config_chla_absorptivity_of_small_plankton, & - config_chla_absorptivity_of_phaeocystis, & - config_light_attenuation_diatoms, & - config_light_attenuation_small_plankton, & - config_light_attenuation_phaeocystis, & - config_light_inhibition_diatoms, & - config_light_inhibition_small_plankton, & - config_light_inhibition_phaeocystis, & - config_maximum_growth_rate_diatoms, & - config_maximum_growth_rate_small_plankton, & - config_maximum_growth_rate_phaeocystis, & - config_temperature_growth_diatoms, & - config_temperature_growth_small_plankton, & - config_temperature_growth_phaeocystis, & - config_grazed_fraction_diatoms, & - config_grazed_fraction_small_plankton, & - config_grazed_fraction_phaeocystis, & - config_mortality_diatoms, & - config_mortality_small_plankton, & - config_mortality_phaeocystis, & - config_temperature_mortality_diatoms, & - config_temperature_mortality_small_plankton, & - config_temperature_mortality_phaeocystis, & - config_exudation_diatoms, & - config_exudation_small_plankton, & - config_exudation_phaeocystis, & - config_nitrate_saturation_diatoms, & - config_nitrate_saturation_small_plankton, & - config_nitrate_saturation_phaeocystis, & - config_ammonium_saturation_diatoms, & - config_ammonium_saturation_small_plankton, & - config_ammonium_saturation_phaeocystis, & - config_silicate_saturation_diatoms, & - config_silicate_saturation_small_plankton, & - config_silicate_saturation_phaeocystis, & - config_iron_saturation_diatoms, & - config_iron_saturation_small_plankton, & - config_iron_saturation_phaeocystis, & - config_fraction_spilled_to_DON, & - config_degredation_of_DON, & - config_fraction_DON_ammonium, & - config_fraction_loss_to_saccharids, & - config_fraction_loss_to_lipids, & - config_fraction_exudation_to_saccharids, & - config_fraction_exudation_to_lipids, & - config_remineralization_saccharids, & - config_remineralization_lipids, & - config_mobility_type_diatoms, & - config_mobility_type_small_plankton, & - config_mobility_type_phaeocystis, & - config_mobility_type_saccharids, & - config_mobility_type_lipids, & - config_mobility_type_inorganic_carbon, & - config_mobility_type_proteins, & - config_mobility_type_dissolved_iron, & - config_mobility_type_particulate_iron, & - config_mobility_type_black_carbon1, & - config_mobility_type_black_carbon2, & - config_mobility_type_dust1, & - config_mobility_type_dust2, & - config_mobility_type_dust3, & - config_mobility_type_dust4, & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_chla_to_N_diatoms, & - config_ratio_chla_to_N_small_plankton, & - config_ratio_chla_to_N_phaeocystis, & - config_scales_absorption_diatoms, & - config_scales_absorption_small_plankton, & - config_scales_absorption_phaeocystis, & - config_ratio_C_to_N_proteins, & - config_mobility_type_nitrate, & - config_mobility_type_ammonium, & - config_mobility_type_DMSPp, & - config_mobility_type_DMSPd, & - config_mobility_type_silicate, & - config_mobility_type_humics, & - config_rapid_mobile_to_stationary_time, & - config_long_mobile_to_stationary_time - - integer, pointer :: & - ONE, & - nIceLayers, & - nSnowLayers, & - nBioLayers, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron, & - nzAerosols, & - maxAerosolType, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType - - logical :: & - use_nitrogen - - integer :: & - nTracers_temp, & - iAerosols - - ! save tracer array size - nTracers_temp = tracerObject % nTracers - tracerObject % nTracers = tracerObject % nTracersNotBio - - call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(domain % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(domain % configs, "config_use_chlorophyll", config_use_chlorophyll) - call MPAS_pool_get_config(domain % configs, "config_use_ammonium", config_use_ammonium) - call MPAS_pool_get_config(domain % configs, "config_use_silicate", config_use_silicate) - call MPAS_pool_get_config(domain % configs, "config_use_DMS", config_use_DMS) - call MPAS_pool_get_config(domain % configs, "config_use_nonreactive", config_use_nonreactive) - call MPAS_pool_get_config(domain % configs, "config_use_humics", config_use_humics) - call MPAS_pool_get_config(domain % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(domain % configs, "config_use_iron", config_use_iron) - call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(domain % configs, "config_new_ice_fraction_biotracer", config_new_ice_fraction_biotracer) - call MPAS_pool_get_config(domain % configs, "config_fraction_biotracer_in_frazil", config_fraction_biotracer_in_frazil) - call MPAS_pool_get_config(domain % configs, "config_ratio_Si_to_N_diatoms", config_ratio_Si_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_Si_to_N_small_plankton", config_ratio_Si_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_Si_to_N_phaeocystis", config_ratio_Si_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_S_to_N_diatoms", config_ratio_S_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_S_to_N_small_plankton", config_ratio_S_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_S_to_N_phaeocystis", config_ratio_S_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_C_diatoms", config_ratio_Fe_to_C_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_C_small_plankton", config_ratio_Fe_to_C_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_C_phaeocystis", config_ratio_Fe_to_C_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_N_diatoms", config_ratio_Fe_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_N_small_plankton", config_ratio_Fe_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_N_phaeocystis", config_ratio_Fe_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_DON", config_ratio_Fe_to_DON) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_DOC_saccharids", config_ratio_Fe_to_DOC_saccharids) - call MPAS_pool_get_config(domain % configs, "config_ratio_Fe_to_DOC_lipids", config_ratio_Fe_to_DOC_lipids) - call MPAS_pool_get_config(domain % configs, "config_rapid_mobile_to_stationary_time", config_rapid_mobile_to_stationary_time) - call MPAS_pool_get_config(domain % configs, "config_long_mobile_to_stationary_time", config_long_mobile_to_stationary_time) - call MPAS_pool_get_config(domain % configs, "config_chla_absorptivity_of_diatoms", config_chla_absorptivity_of_diatoms) - call MPAS_pool_get_config(domain % configs, "config_chla_absorptivity_of_small_plankton", & - config_chla_absorptivity_of_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_chla_absorptivity_of_phaeocystis", config_chla_absorptivity_of_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_light_attenuation_diatoms", config_light_attenuation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_light_attenuation_small_plankton", config_light_attenuation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_light_attenuation_phaeocystis", config_light_attenuation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_light_inhibition_diatoms", config_light_inhibition_diatoms) - call MPAS_pool_get_config(domain % configs, "config_light_inhibition_small_plankton", config_light_inhibition_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_light_inhibition_phaeocystis", config_light_inhibition_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_maximum_growth_rate_diatoms", config_maximum_growth_rate_diatoms) - call MPAS_pool_get_config(domain % configs, "config_maximum_growth_rate_small_plankton", & - config_maximum_growth_rate_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_maximum_growth_rate_phaeocystis", config_maximum_growth_rate_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_temperature_growth_diatoms", config_temperature_growth_diatoms) - call MPAS_pool_get_config(domain % configs, "config_temperature_growth_small_plankton", & - config_temperature_growth_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_temperature_growth_phaeocystis", config_temperature_growth_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_grazed_fraction_diatoms", config_grazed_fraction_diatoms) - call MPAS_pool_get_config(domain % configs, "config_grazed_fraction_small_plankton", config_grazed_fraction_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_grazed_fraction_phaeocystis", config_grazed_fraction_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_mortality_diatoms", config_mortality_diatoms) - call MPAS_pool_get_config(domain % configs, "config_mortality_small_plankton", config_mortality_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_mortality_phaeocystis", config_mortality_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_temperature_mortality_diatoms", config_temperature_mortality_diatoms) - call MPAS_pool_get_config(domain % configs, "config_temperature_mortality_small_plankton", & - config_temperature_mortality_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_temperature_mortality_phaeocystis", & - config_temperature_mortality_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_exudation_diatoms", config_exudation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_exudation_small_plankton", config_exudation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_exudation_phaeocystis", config_exudation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_nitrate_saturation_diatoms", config_nitrate_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_nitrate_saturation_small_plankton", & - config_nitrate_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_nitrate_saturation_phaeocystis", config_nitrate_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ammonium_saturation_diatoms", config_ammonium_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ammonium_saturation_small_plankton", & - config_ammonium_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ammonium_saturation_phaeocystis", config_ammonium_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_silicate_saturation_diatoms", config_silicate_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_silicate_saturation_small_plankton", & - config_silicate_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_silicate_saturation_phaeocystis", config_silicate_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_iron_saturation_diatoms", config_iron_saturation_diatoms) - call MPAS_pool_get_config(domain % configs, "config_iron_saturation_small_plankton", config_iron_saturation_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_iron_saturation_phaeocystis", config_iron_saturation_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_fraction_spilled_to_DON", config_fraction_spilled_to_DON) - call MPAS_pool_get_config(domain % configs, "config_degredation_of_DON", config_degredation_of_DON) - call MPAS_pool_get_config(domain % configs, "config_fraction_DON_ammonium", config_fraction_DON_ammonium) - call MPAS_pool_get_config(domain % configs, "config_fraction_loss_to_saccharids", config_fraction_loss_to_saccharids) - call MPAS_pool_get_config(domain % configs, "config_fraction_loss_to_lipids", config_fraction_loss_to_lipids) - call MPAS_pool_get_config(domain % configs, "config_fraction_exudation_to_saccharids", config_fraction_exudation_to_saccharids) - call MPAS_pool_get_config(domain % configs, "config_fraction_exudation_to_lipids", config_fraction_exudation_to_lipids) - call MPAS_pool_get_config(domain % configs, "config_remineralization_saccharids", config_remineralization_saccharids) - call MPAS_pool_get_config(domain % configs, "config_remineralization_lipids", config_remineralization_lipids) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_diatoms", config_mobility_type_diatoms) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_small_plankton", config_mobility_type_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_phaeocystis", config_mobility_type_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_nitrate", config_mobility_type_nitrate) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_ammonium", config_mobility_type_ammonium) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_silicate", config_mobility_type_silicate) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_DMSPp", config_mobility_type_DMSPp) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_DMSPd", config_mobility_type_DMSPd) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_humics", config_mobility_type_humics) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_saccharids", config_mobility_type_saccharids) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_lipids", config_mobility_type_lipids) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_inorganic_carbon", config_mobility_type_inorganic_carbon) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_proteins", config_mobility_type_proteins) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dissolved_iron", config_mobility_type_dissolved_iron) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_particulate_iron", config_mobility_type_particulate_iron) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_black_carbon1", config_mobility_type_black_carbon1) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_black_carbon2", config_mobility_type_black_carbon2) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust1", config_mobility_type_dust1) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust2", config_mobility_type_dust2) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust3", config_mobility_type_dust3) - call MPAS_pool_get_config(domain % configs, "config_mobility_type_dust4", config_mobility_type_dust4) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_diatoms", config_ratio_C_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_small_plankton", config_ratio_C_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_phaeocystis", config_ratio_C_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_chla_to_N_diatoms", config_ratio_chla_to_N_diatoms) - call MPAS_pool_get_config(domain % configs, "config_ratio_chla_to_N_small_plankton", config_ratio_chla_to_N_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_ratio_chla_to_N_phaeocystis", config_ratio_chla_to_N_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_scales_absorption_diatoms", config_scales_absorption_diatoms) - call MPAS_pool_get_config(domain % configs, "config_scales_absorption_small_plankton", config_scales_absorption_small_plankton) - call MPAS_pool_get_config(domain % configs, "config_scales_absorption_phaeocystis", config_scales_absorption_phaeocystis) - call MPAS_pool_get_config(domain % configs, "config_ratio_C_to_N_proteins", config_ratio_C_to_N_proteins) - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "ONE", ONE) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nSnowLayers", nSnowLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nBioLayers",nBioLayers) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDON", nDON) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nDissolvedIron", nDissolvedIron) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "maxIronType", maxIronType) - - use_nitrogen = .false. - if (config_use_skeletal_biochemistry .or. config_use_vertical_biochemistry) & - use_nitrogen = .true. - - allocate(tracerObject % index_verticalAerosolsConc(maxAerosolType)) - allocate(tracerObject % index_verticalAerosolsConcLayer(maxAerosolType)) - allocate(tracerObject % index_verticalAerosolsConcShortwave(maxAerosolType)) - tracerObject % nzAerosolsIndex = nzAerosols - - allocate(tracerObject % index_algaeConc(maxAlgaeType)) - allocate(tracerObject % index_algaeConcLayer(maxAlgaeType)) - tracerObject % nAlgaeIndex = nAlgae - - allocate(tracerObject % index_algalCarbon(maxAlgaeType)) - allocate(tracerObject % index_algalCarbonLayer(maxAlgaeType)) - tracerObject % nAlgalCarbonIndex = nAlgae - - allocate(tracerObject % index_DOCConc(maxDOCType)) - allocate(tracerObject % index_DOCConcLayer(maxDOCType)) - tracerObject % nDOCIndex = nDOC - - allocate(tracerObject % index_DICConc(maxDICType)) - allocate(tracerObject % index_DICConcLayer(maxDICType)) - tracerObject % nDICIndex = nDIC - - allocate(tracerObject % index_algalChlorophyll(maxAlgaeType)) - allocate(tracerObject % index_algalChlorophyllLayer(maxAlgaeType)) - tracerObject % nAlgalChlorophyllIndex = nAlgae - - allocate(tracerObject % index_DONConc(maxDONType)) - allocate(tracerObject % index_DONConcLayer(maxDONType)) - tracerObject % nDONIndex = nDON - - allocate(tracerObject % index_particulateIronConc(maxIronType)) - allocate(tracerObject % index_particulateIronConcLayer(maxIronType)) - tracerObject % nParticulateIronIndex = nParticulateIron - - allocate(tracerObject % index_dissolvedIronConc(maxIronType)) - allocate(tracerObject % index_dissolvedIronConcLayer(maxIronType)) - tracerObject % nDissolvedIronIndex = nDissolvedIron - - call colpkg_init_zbgc(& - nBioLayers, & - nIceLayers, & - nSnowLayers, & - nAlgae, & - nzAerosols, & - nDOC, & - nDIC, & - nDON, & - nDissolvedIron, & - nParticulateIron, & - tracerObject % firstAncestorMask, & - tracerObject % parentIndex, & - tracerObject % ancestorNumber, & - tracerObject % ancestorIndices, & - tracerObject % nBioTracersShortwave, & - config_use_brine, & - tracerObject % index_brineFraction,& - tracerObject % nTracers, & - tracerObject % nBioTracers, & - tracerObject % index_nitrateConc, & - tracerObject % index_ammoniumConc, & - tracerObject % index_silicateConc, & - tracerObject % index_DMSConc, & - tracerObject % index_nonreactiveConc, & - tracerObject % index_verticalSalinity, & - tracerObject % index_algaeConc, & - tracerObject % index_algalCarbon, & - tracerObject % index_algalChlorophyll, & - tracerObject % index_DOCConc, & - tracerObject % index_DONConc, & - tracerObject % index_DICConc, & - tracerObject % index_verticalAerosolsConc, & - tracerObject % index_DMSPpConc, & - tracerObject % index_DMSPdConc, & - tracerObject % index_dissolvedIronConc, & - tracerObject % index_particulateIronConc, & - tracerObject % index_mobileFraction, & - config_use_nitrate, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_vertical_zsalinity, & - use_nitrogen, & - config_use_carbon, & - config_use_chlorophyll, & - config_use_DON, & - config_use_iron,& - config_use_zaerosols, & - tracerObject % index_verticalAerosolsConcShortwave, & - tracerObject % index_chlorophyllShortwave, & - tracerObject % index_algaeConcLayer, & - tracerObject % index_nitrateConcLayer, & - tracerObject % index_ammoniumConcLayer, & - tracerObject % index_silicateConcLayer, & - tracerObject % index_DMSConcLayer, & - tracerObject % index_DMSPpConcLayer, & - tracerObject % index_DMSPdConcLayer, & - tracerObject % index_algalCarbonLayer, & - tracerObject % index_algalChlorophyllLayer, & - tracerObject % index_DICConcLayer, & - tracerObject % index_DOCConcLayer, & - tracerObject % index_nonreactiveConcLayer, & - tracerObject % index_DONConcLayer, & - tracerObject % index_dissolvedIronConcLayer, & - tracerObject % index_particulateIronConcLayer, & - tracerObject % index_verticalAerosolsConcLayer, & - tracerObject % index_humicsConc, & - tracerObject % index_humicsConcLayer, & - config_use_humics, & - config_use_vertical_zsalinity, & - config_use_skeletal_biochemistry, & - config_use_vertical_tracers, & - config_use_shortwave_bioabsorption, & - config_use_vertical_biochemistry, & - config_fraction_biotracer_in_frazil, & - config_new_ice_fraction_biotracer, & - tracerObject % index_LayerIndexToDataArray, & - tracerObject % index_LayerIndexToBioIndex, & - tracerObject % nTracersNotBio, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - config_ratio_Si_to_N_diatoms, & - config_ratio_Si_to_N_small_plankton, & - config_ratio_Si_to_N_phaeocystis, & - config_ratio_S_to_N_diatoms, & - config_ratio_S_to_N_small_plankton, & - config_ratio_S_to_N_phaeocystis, & - config_ratio_Fe_to_C_diatoms, & - config_ratio_Fe_to_C_small_plankton, & - config_ratio_Fe_to_C_phaeocystis, & - config_ratio_Fe_to_N_diatoms, & - config_ratio_Fe_to_N_small_plankton, & - config_ratio_Fe_to_N_phaeocystis, & - config_ratio_Fe_to_DON, & - config_ratio_Fe_to_DOC_saccharids, & - config_ratio_Fe_to_DOC_lipids, & - config_chla_absorptivity_of_diatoms, & - config_chla_absorptivity_of_small_plankton, & - config_chla_absorptivity_of_phaeocystis, & - config_light_attenuation_diatoms, & - config_light_attenuation_small_plankton, & - config_light_attenuation_phaeocystis, & - config_light_inhibition_diatoms, & - config_light_inhibition_small_plankton, & - config_light_inhibition_phaeocystis, & - config_maximum_growth_rate_diatoms, & - config_maximum_growth_rate_small_plankton, & - config_maximum_growth_rate_phaeocystis, & - config_temperature_growth_diatoms, & - config_temperature_growth_small_plankton, & - config_temperature_growth_phaeocystis, & - config_grazed_fraction_diatoms, & - config_grazed_fraction_small_plankton, & - config_grazed_fraction_phaeocystis, & - config_mortality_diatoms, & - config_mortality_small_plankton, & - config_mortality_phaeocystis, & - config_temperature_mortality_diatoms, & - config_temperature_mortality_small_plankton, & - config_temperature_mortality_phaeocystis, & - config_exudation_diatoms, & - config_exudation_small_plankton, & - config_exudation_phaeocystis, & - config_nitrate_saturation_diatoms, & - config_nitrate_saturation_small_plankton, & - config_nitrate_saturation_phaeocystis, & - config_ammonium_saturation_diatoms, & - config_ammonium_saturation_small_plankton, & - config_ammonium_saturation_phaeocystis, & - config_silicate_saturation_diatoms, & - config_silicate_saturation_small_plankton, & - config_silicate_saturation_phaeocystis, & - config_iron_saturation_diatoms, & - config_iron_saturation_small_plankton, & - config_iron_saturation_phaeocystis, & - config_fraction_spilled_to_DON, & - config_degredation_of_DON, & - config_fraction_DON_ammonium, & - config_fraction_loss_to_saccharids, & - config_fraction_loss_to_lipids, & - config_fraction_exudation_to_saccharids, & - config_fraction_exudation_to_lipids, & - config_remineralization_saccharids, & - config_remineralization_lipids, & - config_mobility_type_diatoms, & - config_mobility_type_small_plankton, & - config_mobility_type_phaeocystis, & - config_mobility_type_saccharids, & - config_mobility_type_lipids, & - config_mobility_type_inorganic_carbon, & - config_mobility_type_proteins, & - config_mobility_type_dissolved_iron, & - config_mobility_type_particulate_iron, & - config_mobility_type_black_carbon1, & - config_mobility_type_black_carbon2, & - config_mobility_type_dust1, & - config_mobility_type_dust2, & - config_mobility_type_dust3, & - config_mobility_type_dust4, & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_chla_to_N_diatoms, & - config_ratio_chla_to_N_small_plankton, & - config_ratio_chla_to_N_phaeocystis, & - config_scales_absorption_diatoms, & - config_scales_absorption_small_plankton, & - config_scales_absorption_phaeocystis, & - config_ratio_C_to_N_proteins, & - config_mobility_type_nitrate, & - config_mobility_type_ammonium, & - config_mobility_type_DMSPp, & - config_mobility_type_DMSPd, & - config_mobility_type_silicate, & - config_mobility_type_humics, & - config_rapid_mobile_to_stationary_time, & - config_long_mobile_to_stationary_time) - - ! check calculated tracer array size - if (nTracers_temp /= tracerObject % nTracers) then - call mpas_log_write(& - "init_column_tracer_object_for_biogeochemistry: nTracers_temp: $i, nTracers: $i", & - messageType=MPAS_LOG_CRIT, intArgs=(/nTracers_temp, tracerObject % nTracers/)) - endif - - end subroutine init_column_tracer_object_for_biogeochemistry - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! init_column_biogeochemistry -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 17th September 2015 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine init_column_biogeochemistry_profiles(domain, tracerObject) - - use ice_colpkg, only: & - colpkg_init_bgc, & - colpkg_init_hbrine, & - colpkg_init_zsalinity - - type(domain_type), intent(inout) :: domain - - type(ciceTracerObjectType), intent(inout) :: & - tracerObject - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - biogeochemistry, & - diagnostics_biogeochemistry, & - ocean_coupling, & - tracers - - logical, pointer :: & - config_use_brine, & - config_use_vertical_zsalinity, & - config_use_vertical_tracers, & - config_use_skeletal_biochemistry, & - config_do_restart_zsalinity, & - config_do_restart_bgc, & - config_do_restart_hbrine, & - config_use_macromolecules - - real(kind=RKIND), pointer :: & - config_dt, & - config_snow_porosity_at_ice_surface - - real(kind=RKIND), dimension(:), pointer :: & - oceanNitrateConc, & - oceanSilicateConc, & - oceanAmmoniumConc, & - oceanDMSConc, & - oceanDMSPConc, & - oceanHumicsConc, & - seaSurfaceSalinity , & - verticalGrid, & ! cgrid - interfaceBiologyGrid, & ! igrid - biologyGrid, & ! bgrid - verticalShortwaveGrid, & ! swgrid - interfaceGrid, & ! icgrid - rayleighCriteriaReal, & - DOCPoolFractions - - real(kind=RKIND), dimension(:,:), pointer :: & - oceanAlgaeConc, & - oceanDOCConc, & - oceanDICConc, & - oceanDONConc, & - oceanParticulateIronConc, & - oceanDissolvedIronConc, & - oceanZAerosolConc, & - oceanBioConcentrations, & - totalVerticalBiologyIce, & - totalVerticalBiologySnow - - integer, dimension(:,:), pointer :: & - newlyFormedIce - - real(kind=RKIND), dimension(:,:,:), pointer :: & - bioPorosity, & - bioDiffusivity, & - bioTemperature, & - bioPermeability, & - bioShortwaveFlux, & - bioTracerShortwave, & - iceSalinity, & - brineFraction - - integer, pointer :: & - nCellsSolve, & - nIceLayers, & - nBioLayers, & - nBioLayersP1, & - nBioLayersP2, & - nCategories, & - nShortwaveBio, & - nZBGCTracers, & - maxAerosolType, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType - - integer :: & - iCell - - logical :: & - abortFlag, & - rayleighCriteria, & - setGetPhysicsTracers, & - setGetBGCTracers - - character(len=strKIND) :: & - abortMessage - - call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_do_restart_zsalinity", config_do_restart_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_do_restart_bgc", config_do_restart_bgc) - call MPAS_pool_get_config(domain % configs, "config_do_restart_hbrine", config_do_restart_hbrine) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(domain % configs, "config_dt", config_dt) - call MPAS_pool_get_config(domain % configs, "config_snow_porosity_at_ice_surface", config_snow_porosity_at_ice_surface) - call MPAS_pool_get_config(domain % configs, "config_use_macromolecules", config_use_macromolecules) - - setGetPhysicsTracers = .false. - setGetBGCTracers = .true. - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "diagnostics_biogeochemistry", diagnostics_biogeochemistry) - - call MPAS_pool_get_array(biogeochemistry, "bioPorosity", bioPorosity) - call MPAS_pool_get_array(biogeochemistry, "bioDiffusivity", bioDiffusivity) - call MPAS_pool_get_array(biogeochemistry, "bioTemperature", bioTemperature) - call MPAS_pool_get_array(biogeochemistry, "bioPermeability", bioPermeability) - call MPAS_pool_get_array(biogeochemistry, "bioShortwaveFlux", bioShortwaveFlux) - call MPAS_pool_get_array(biogeochemistry, "oceanBioConcentrations", oceanBioConcentrations) - call MPAS_pool_get_array(biogeochemistry, "totalVerticalBiologyIce", totalVerticalBiologyIce) - call MPAS_pool_get_array(biogeochemistry, "totalVerticalBiologySnow", totalVerticalBiologySnow) - - call MPAS_pool_get_array(biogeochemistry, "bioTracerShortwave", bioTracerShortwave) - call MPAS_pool_get_array(biogeochemistry, "interfaceBiologyGrid", interfaceBiologyGrid) - call MPAS_pool_get_array(biogeochemistry, "interfaceGrid", interfaceGrid) - call MPAS_pool_get_array(biogeochemistry, "rayleighCriteriaReal", rayleighCriteriaReal) - call MPAS_pool_get_array(biogeochemistry, "verticalGrid", verticalGrid) - call MPAS_pool_get_array(biogeochemistry, "biologyGrid", biologyGrid) - call MPAS_pool_get_array(biogeochemistry, "verticalShortwaveGrid", verticalShortwaveGrid) - call MPAS_pool_get_array(biogeochemistry, "oceanAlgaeConc", oceanAlgaeConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDOCConc", oceanDOCConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDICConc", oceanDICConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDONConc", oceanDONConc) - call MPAS_pool_get_array(biogeochemistry, "oceanParticulateIronConc", oceanParticulateIronConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDissolvedIronConc", oceanDissolvedIronConc) - call MPAS_pool_get_array(biogeochemistry, "oceanNitrateConc", oceanNitrateConc) - call MPAS_pool_get_array(biogeochemistry, "oceanSilicateConc", oceanSilicateConc) - call MPAS_pool_get_array(biogeochemistry, "oceanAmmoniumConc", oceanAmmoniumConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSConc", oceanDMSConc) - call MPAS_pool_get_array(biogeochemistry, "oceanDMSPConc", oceanDMSPConc) - call MPAS_pool_get_array(biogeochemistry, "oceanHumicsConc", oceanHumicsConc) - call MPAS_pool_get_array(biogeochemistry, "oceanZAerosolConc", oceanZAerosolConc) - call MPAS_pool_get_array(biogeochemistry, "newlyFormedIce", newlyFormedIce) - call MPAS_pool_get_array(biogeochemistry, "DOCPoolFractions", DOCPoolFractions) - - call MPAS_pool_get_subpool(block % structs, "ocean_coupling", ocean_coupling) - call MPAS_pool_get_array(ocean_coupling, "seaSurfaceSalinity", seaSurfaceSalinity) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_array(tracers, "iceSalinity", iceSalinity, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - - call MPAS_pool_get_dimension(block % dimensions, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(block % dimensions, "nCategories", nCategories) - call MPAS_pool_get_dimension(block % dimensions, "nIceLayers", nIceLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP2", nBioLayersP2) - call MPAS_pool_get_dimension(block % dimensions, "nShortwaveBio", nShortwaveBio) - call MPAS_pool_get_dimension(block % dimensions, "nZBGCTracers", nZBGCTracers) - call MPAS_pool_get_dimension(block % dimensions, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(block % dimensions, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(block % dimensions, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(block % dimensions, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(block % dimensions, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(block % dimensions, "maxIronType", maxIronType) - - call colpkg_init_hbrine(& - biologyGrid, & - interfaceBiologyGrid, & - verticalGrid, & - interfaceGrid, & - verticalShortwaveGrid, & - nBioLayers, & - nIceLayers, & - config_snow_porosity_at_ice_surface) - - ! code abort - abortFlag = .false. - abortMessage = "" - - do iCell = 1, nCellsSolve - if (.not. config_do_restart_hbrine) then - ! initialize newly formed ice - newlyFormedIce(:,iCell) = 1 - - ! initialize brine fraction - brineFraction(:,:,iCell) = 1.0_RKIND - endif - - ! set the category tracer array - call set_cice_tracer_array_category(block, tracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - if (config_use_vertical_zsalinity) then - call colpkg_init_zsalinity(& - nBioLayers, & - tracerObject % nTracersNotBio, & - config_do_restart_zsalinity, & - rayleighCriteria, & - rayleighCriteriaReal(iCell), & - tracerArrayCategory(tracerObject % nTracersNotBio+1:tracerObject % nTracers,:), & - tracerObject % index_verticalSalinity, & - nCategories, & - seaSurfaceSalinity(iCell)) - endif - - if (config_use_vertical_tracers .or. config_use_skeletal_biochemistry) then - call colpkg_init_bgc(& - config_dt, & - nCategories, & - nBioLayers, & - nIceLayers, & - tracerObject % nTracersNotBio, & - verticalGrid, & - interfaceBiologyGrid, & - config_do_restart_bgc, & - tracerObject % nTracers, & - tracerObject % nBiotracers, & - iceSalinity(:,:,iCell), & - tracerArrayCategory(tracerObject % nTracersNotBio+1:tracerObject % nTracers,:), & - seaSurfaceSalinity(iCell), & - oceanNitrateConc(iCell), & - oceanAmmoniumConc(iCell), & - oceanSilicateConc(iCell), & - oceanDMSPConc(iCell), & - oceanDMSConc(iCell), & - oceanAlgaeConc(:,iCell), & - oceanDOCConc(:,iCell), & - oceanDONConc(:,iCell), & - oceanDICConc(:,iCell), & - oceanDissolvedIronConc(:,iCell), & - oceanParticulateIronConc(:,iCell), & - oceanZAerosolConc(:,iCell), & - oceanHumicsConc(iCell), & - oceanBioConcentrations(:,iCell), & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - nZBGCTracers, & - maxAerosolType, & - DOCPoolFractions, & - config_use_macromolecules, & - abortFlag, & - abortMessage) - - ! code abort - if (abortFlag) then - call mpas_log_write(& - "init_column_biogeochemistry_profiles: colpkg_init_bgc: "//trim(abortMessage), & - messageType=MPAS_LOG_CRIT) - exit - endif - - endif ! biogeochemistry - - ! get the category tracer array - call get_cice_tracer_array_category(block, tracerObject, & - tracerArrayCategory, iCell, setGetPhysicsTracers, setGetBGCTracers) - - enddo ! iCell - - ! code abort - call seaice_critical_error_write_block(domain, block, abortFlag) - call seaice_check_critical_error(domain, abortFlag) - - block => block % next - end do - - end subroutine init_column_biogeochemistry_profiles - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_reinitialize_diagnostics_thermodynamics -! -!> \brief Reinitialize thermodynamics diagnostics -!> \author Adrian K. Turner, LANL -!> \date 27th September 2015 -!> \details -!> Reinitialize thermodynamics diagnostics -! -!----------------------------------------------------------------------- - - subroutine seaice_column_reinitialize_diagnostics_thermodynamics(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - atmosFluxesPool, & - meltGrowthRatesPool, & - diagnosticsPool, & - tracersAggregatePool, & - pondsPool, & - shortwavePool, & - dragPool, & - snowPool - - ! atmospheric fluxes - real(kind=RKIND), dimension(:), pointer :: & - surfaceHeatFlux, & - surfaceConductiveFlux - - real(kind=RKIND), dimension(:,:), pointer :: & - surfaceHeatFluxCategory, & - surfaceConductiveFluxCategory, & - latentHeatFluxCategory, & - sensibleHeatFluxCategory - - ! melt growth rates - real(kind=RKIND), dimension(:), pointer :: & - congelation, & - frazilFormation, & - snowiceFormation, & - snowThicknessChange, & - surfaceIceMelt, & - snowMelt, & - basalIceMelt, & - lateralIceMelt - - ! snow model - real(kind=RKIND), dimension(:), pointer :: & - snowLossToLeads, & - snowMeltMassCell, & - snowDensityViaContent, & - snowDensityViaCompaction, & - snowRadiusInStandardRadiationScheme - - real(kind=RKIND), dimension(:,:), pointer :: & - snowMeltMassCategory, & - snowRadiusInStandardRadiationSchemeCategory - - ! diagnostic tendencies - real(kind=RKIND), dimension(:), pointer :: & - iceAreaTendencyThermodynamics, & - iceVolumeTendencyThermodynamics, & - iceAgeTendencyThermodynamics, & - iceAreaCell, & - iceVolumeCell, & - iceAgeCell - - ! pond fluxes - real(kind=RKIND), dimension(:), pointer :: & - pondFreshWaterFlux - - ! shortwave - real(kind=RKIND), dimension(:), pointer :: & - bareIceAlbedoCell, & - snowAlbedoCell, & - pondAlbedoCell - - ! drag variables - real(kind=RKIND), pointer :: & - config_ice_ocean_drag_coefficient - - real(kind=RKIND), dimension(:), pointer :: & - airOceanDragCoefficientRatio, & - oceanDragCoefficient, & - oceanDragCoefficientSkin, & - oceanDragCoefficientFloe, & - oceanDragCoefficientKeel, & - airDragCoefficient, & - airDragCoefficientSkin, & - airDragCoefficientFloe, & - airDragCoefficientPond, & - airDragCoefficientRidge, & - dragFreeboard, & - dragIceSnowDraft, & - dragRidgeHeight, & - dragRidgeSeparation, & - dragKeelDepth, & - dragKeelSeparation, & - dragFloeLength, & - dragFloeSeparation - - logical, pointer :: & - config_use_ice_age, & - config_use_form_drag, & - config_use_column_physics, & - config_use_column_snow_tracers - - call MPAS_pool_get_config(domain % blocklist % configs, "config_use_column_physics", config_use_column_physics) - - if (config_use_column_physics) then - - block => domain % blocklist - do while (associated(block)) - - ! atmospheric fluxes - call MPAS_pool_get_subpool(block % structs, "atmos_fluxes", atmosFluxesPool) - - call MPAS_pool_get_array(atmosFluxesPool, "surfaceHeatFlux", surfaceHeatFlux) - call MPAS_pool_get_array(atmosFluxesPool, "surfaceConductiveFlux", surfaceConductiveFlux) - call MPAS_pool_get_array(atmosFluxesPool, "surfaceHeatFluxCategory", surfaceHeatFluxCategory) - call MPAS_pool_get_array(atmosFluxesPool, "surfaceConductiveFluxCategory", surfaceConductiveFluxCategory) - call MPAS_pool_get_array(atmosFluxesPool, "latentHeatFluxCategory", latentHeatFluxCategory) - call MPAS_pool_get_array(atmosFluxesPool, "sensibleHeatFluxCategory", sensibleHeatFluxCategory) - - surfaceHeatFlux = 0.0_RKIND - surfaceConductiveFlux = 0.0_RKIND - surfaceHeatFluxCategory = 0.0_RKIND - surfaceConductiveFluxCategory = 0.0_RKIND - latentHeatFluxCategory = 0.0_RKIND - sensibleHeatFluxCategory = 0.0_RKIND - - ! melt growth rates - call MPAS_pool_get_subpool(block % structs, "melt_growth_rates", meltGrowthRatesPool) - - call MPAS_pool_get_array(meltGrowthRatesPool, "congelation", congelation) - call MPAS_pool_get_array(meltGrowthRatesPool, "frazilFormation", frazilFormation) - call MPAS_pool_get_array(meltGrowthRatesPool, "snowiceFormation", snowiceFormation) - call MPAS_pool_get_array(meltGrowthRatesPool, "snowThicknessChange", snowThicknessChange) - call MPAS_pool_get_array(meltGrowthRatesPool, "surfaceIceMelt", surfaceIceMelt) - call MPAS_pool_get_array(meltGrowthRatesPool, "snowMelt", snowMelt) - call MPAS_pool_get_array(meltGrowthRatesPool, "basalIceMelt", basalIceMelt) - call MPAS_pool_get_array(meltGrowthRatesPool, "lateralIceMelt", lateralIceMelt) - - congelation = 0.0_RKIND - frazilFormation = 0.0_RKIND - snowiceFormation = 0.0_RKIND - snowThicknessChange = 0.0_RKIND - surfaceIceMelt = 0.0_RKIND - snowMelt = 0.0_RKIND - basalIceMelt = 0.0_RKIND - lateralIceMelt = 0.0_RKIND - - ! tendancies - call MPAS_pool_get_config(block % configs, "config_use_ice_age", config_use_ice_age) - - call MPAS_pool_get_subpool(block % structs, "diagnostics", diagnosticsPool) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracersAggregatePool) - - call MPAS_pool_get_array(diagnosticsPool, "iceAreaTendencyThermodynamics", iceAreaTendencyThermodynamics) - call MPAS_pool_get_array(diagnosticsPool, "iceVolumeTendencyThermodynamics", iceVolumeTendencyThermodynamics) - call MPAS_pool_get_array(diagnosticsPool, "iceAgeTendencyThermodynamics", iceAgeTendencyThermodynamics) - - call MPAS_pool_get_array(tracersAggregatePool, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracersAggregatePool, "iceVolumeCell", iceVolumeCell) - call MPAS_pool_get_array(tracersAggregatePool, "iceAgeCell", iceAgeCell) - - ! thermodynamic tendencies - iceAreaTendencyThermodynamics = iceAreaCell - iceVolumeTendencyThermodynamics = iceVolumeCell - if (config_use_ice_age) then - iceAgeTendencyThermodynamics = iceAgeCell - else - iceAgeTendencyThermodynamics = 0.0_RKIND - endif - - ! ponds - call MPAS_pool_get_subpool(block % structs, "ponds", pondsPool) - - call MPAS_pool_get_array(pondsPool, "pondFreshWaterFlux", pondFreshWaterFlux) - - pondFreshWaterFlux(:) = 0.0_RKIND - - !fresh_ai (:,:,:) = c0 - !fsalt_ai (:,:,:) = c0 - !fhocn_ai (:,:,:) = c0 - !fswthru_ai(:,:,:) = c0 - - ! shortwave - call MPAS_pool_get_subpool(block % structs, "shortwave", shortwavePool) - - call MPAS_pool_get_array(shortwavePool, "bareIceAlbedoCell", bareIceAlbedoCell) - call MPAS_pool_get_array(shortwavePool, "snowAlbedoCell", snowAlbedoCell) - call MPAS_pool_get_array(shortwavePool, "pondAlbedoCell", pondAlbedoCell) - - bareIceAlbedoCell = 0.0_RKIND - snowAlbedoCell = 0.0_RKIND - pondAlbedoCell = 0.0_RKIND - - ! form drag - call MPAS_pool_get_config(block % configs, "config_ice_ocean_drag_coefficient", & - config_ice_ocean_drag_coefficient) - - call MPAS_pool_get_subpool(block % structs, "drag", dragPool) - - call MPAS_pool_get_array(dragPool, "oceanDragCoefficient", oceanDragCoefficient) - call MPAS_pool_get_array(dragPool, "airDragCoefficient", airDragCoefficient) - - oceanDragCoefficient = config_ice_ocean_drag_coefficient - airDragCoefficient = seaice_column_initial_air_drag_coefficient() - - call MPAS_pool_get_config(block % configs, "config_use_form_drag", config_use_form_drag) - - if (config_use_form_drag) then - - call MPAS_pool_get_array(dragPool, "airOceanDragCoefficientRatio", airOceanDragCoefficientRatio) - call MPAS_pool_get_array(dragPool, "oceanDragCoefficientSkin", oceanDragCoefficientSkin) - call MPAS_pool_get_array(dragPool, "oceanDragCoefficientFloe", oceanDragCoefficientFloe) - call MPAS_pool_get_array(dragPool, "oceanDragCoefficientKeel", oceanDragCoefficientKeel) - call MPAS_pool_get_array(dragPool, "airDragCoefficientSkin", airDragCoefficientSkin) - call MPAS_pool_get_array(dragPool, "airDragCoefficientFloe", airDragCoefficientFloe) - call MPAS_pool_get_array(dragPool, "airDragCoefficientPond", airDragCoefficientPond) - call MPAS_pool_get_array(dragPool, "airDragCoefficientRidge", airDragCoefficientRidge) - call MPAS_pool_get_array(dragPool, "dragFreeboard", dragFreeboard) - call MPAS_pool_get_array(dragPool, "dragIceSnowDraft", dragIceSnowDraft) - call MPAS_pool_get_array(dragPool, "dragRidgeHeight", dragRidgeHeight) - call MPAS_pool_get_array(dragPool, "dragRidgeSeparation", dragRidgeSeparation) - call MPAS_pool_get_array(dragPool, "dragKeelDepth", dragKeelDepth) - call MPAS_pool_get_array(dragPool, "dragKeelSeparation", dragKeelSeparation) - call MPAS_pool_get_array(dragPool, "dragFloeLength", dragFloeLength) - call MPAS_pool_get_array(dragPool, "dragFloeSeparation", dragFloeSeparation) - - airOceanDragCoefficientRatio = 0.0_RKIND - oceanDragCoefficientSkin = 0.0_RKIND - oceanDragCoefficientFloe = 0.0_RKIND - oceanDragCoefficientKeel = 0.0_RKIND - airDragCoefficientSkin = 0.0_RKIND - airDragCoefficientFloe = 0.0_RKIND - airDragCoefficientPond = 0.0_RKIND - airDragCoefficientRidge = 0.0_RKIND - dragFreeboard = 0.0_RKIND - dragIceSnowDraft = 0.0_RKIND - dragRidgeHeight = 0.0_RKIND - dragRidgeSeparation = 0.0_RKIND - dragKeelDepth = 0.0_RKIND - dragKeelSeparation = 0.0_RKIND - dragFloeLength = 0.0_RKIND - dragFloeSeparation = 0.0_RKIND - - endif ! config_use_form_drag - - ! snow - call MPAS_pool_get_config(block % configs, "config_use_column_snow_tracers", config_use_column_snow_tracers) - if (config_use_column_snow_tracers) then - - call MPAS_pool_get_subpool(block % structs, "snow", snowPool) - call MPAS_pool_get_array(snowPool, "snowLossToLeads", snowLossToLeads) - call MPAS_pool_get_array(snowPool, "snowMeltMassCell", snowMeltMassCell) - call MPAS_pool_get_array(snowPool, "snowMeltMassCategory", snowMeltMassCategory) - call MPAS_pool_get_array(snowPool, "snowDensityViaContent", snowDensityViaContent) - call MPAS_pool_get_array(snowPool, "snowDensityViaCompaction", snowDensityViaCompaction) - call MPAS_pool_get_array(snowPool, "snowRadiusInStandardRadiationScheme", snowRadiusInStandardRadiationScheme) - call MPAS_pool_get_array(snowPool, "snowRadiusInStandardRadiationSchemeCategory", snowRadiusInStandardRadiationSchemeCategory) - - snowLossToLeads = 0.0_RKIND - snowMeltMassCell = 0.0_RKIND - snowMeltMassCategory = 0.0_RKIND - snowDensityViaContent = 0.0_RKIND - snowDensityViaCompaction = 0.0_RKIND - snowRadiusInStandardRadiationScheme = 0.0_RKIND - snowRadiusInStandardRadiationSchemeCategory = 0.0_RKIND - - end if ! config_use_column_snow_tracers - - block => block % next - end do - - endif ! config_use_column_physics - - end subroutine seaice_column_reinitialize_diagnostics_thermodynamics - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_reinitialize_diagnostics_dynamics -! -!> \brief Reinitialize dynamics diagnostics -!> \author Adrian K. Turner, LANL -!> \date 27th September 2015 -!> \details -!> Reinitialize dynamics diagnostics -! -!----------------------------------------------------------------------- - - subroutine seaice_column_reinitialize_diagnostics_dynamics(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - velocitySolverPool, & - velocityWeakPool, & - velocityVariationalPool, & - ridgingPool, & - diagnosticsPool, & - tracersAggregatePool - - ! dynamics - real(kind=RKIND), dimension(:), pointer :: & - oceanStressU, & - oceanStressV, & - airStressVertexU, & - airStressVertexV, & - stressDivergenceU, & - stressDivergenceV, & - surfaceTiltForceU, & - surfaceTiltForceV - - real(kind=RKIND), dimension(:,:), pointer :: & - principalStress1Var, & - principalStress2Var, & - replacementPressureVar - - real(kind=RKIND), dimension(:), pointer :: & - principalStress1Weak, & - principalStress2Weak, & - replacementPressureWeak - - ! ridging - real(kind=RKIND), dimension(:), pointer :: & - areaLossRidge, & - areaGainRidge, & - iceVolumeRidged, & - openingRateRidge - - ! diagnostic tendencies - real(kind=RKIND), dimension(:), pointer :: & - iceAreaTendencyTransport, & - iceVolumeTendencyTransport, & - iceAgeTendencyTransport, & - iceAreaCell, & - iceVolumeCell, & - iceAgeCell - - logical, pointer :: & - config_use_ice_age, & - config_use_column_physics, & - config_use_velocity_solver - - character(len=strKIND), pointer :: & - config_stress_divergence_scheme - - call MPAS_pool_get_config(domain % blocklist % configs, "config_use_column_physics", config_use_column_physics) - call MPAS_pool_get_config(domain % blocklist % configs, "config_use_velocity_solver", config_use_velocity_solver) - call MPAS_pool_get_config(domain % blocklist % configs, "config_stress_divergence_scheme", config_stress_divergence_scheme) - - if (config_use_column_physics) then - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_subpool(block % structs, "velocity_solver", velocitySolverPool) - - call MPAS_pool_get_array(velocitySolverPool, "oceanStressU", oceanStressU) - call MPAS_pool_get_array(velocitySolverPool, "oceanStressV", oceanStressV) - call MPAS_pool_get_array(velocitySolverPool, "airStressVertexU", airStressVertexU) - call MPAS_pool_get_array(velocitySolverPool, "airStressVertexV", airStressVertexV) - call MPAS_pool_get_array(velocitySolverPool, "stressDivergenceU", stressDivergenceU) - call MPAS_pool_get_array(velocitySolverPool, "stressDivergenceV", stressDivergenceV) - call MPAS_pool_get_array(velocitySolverPool, "surfaceTiltForceU", surfaceTiltForceU) - call MPAS_pool_get_array(velocitySolverPool, "surfaceTiltForceV", surfaceTiltForceV) - - oceanStressU = 0.0_RKIND - oceanStressV = 0.0_RKIND - airStressVertexU = 0.0_RKIND - airStressVertexV = 0.0_RKIND - stressDivergenceU = 0.0_RKIND - stressDivergenceV = 0.0_RKIND - surfaceTiltForceU = 0.0_RKIND - surfaceTiltForceV = 0.0_RKIND - - if (config_use_velocity_solver .and. trim(config_stress_divergence_scheme) == "weak") then - - call MPAS_pool_get_subpool(block % structs, "velocity_weak", velocityWeakPool) - - call MPAS_pool_get_array(velocityWeakPool, "principalStress1", principalStress1Weak) - call MPAS_pool_get_array(velocityWeakPool, "principalStress2", principalStress2Weak) - call MPAS_pool_get_array(velocityWeakPool, "replacementPressure", replacementPressureWeak) - - principalStress1Weak = 0.0_RKIND - principalStress2Weak = 0.0_RKIND - replacementPressureWeak = 0.0_RKIND - - else if (config_use_velocity_solver .and. trim(config_stress_divergence_scheme) == "variational") then - - call MPAS_pool_get_subpool(block % structs, "velocity_variational", velocityVariationalPool) - - call MPAS_pool_get_array(velocityVariationalPool, "principalStress1", principalStress1Var) - call MPAS_pool_get_array(velocityVariationalPool, "principalStress2", principalStress2Var) - call MPAS_pool_get_array(velocityVariationalPool, "replacementPressure", replacementPressureVar) - - principalStress1Var = 0.0_RKIND - principalStress2Var = 0.0_RKIND - replacementPressureVar = 0.0_RKIND - - endif - - call MPAS_pool_get_subpool(block % structs, "ridging", ridgingPool) - - call MPAS_pool_get_array(ridgingPool, "areaLossRidge", areaLossRidge) - call MPAS_pool_get_array(ridgingPool, "areaGainRidge", areaGainRidge) - call MPAS_pool_get_array(ridgingPool, "iceVolumeRidged", iceVolumeRidged) - call MPAS_pool_get_array(ridgingPool, "openingRateRidge", openingRateRidge) - - areaLossRidge = 0.0_RKIND - areaGainRidge = 0.0_RKIND - iceVolumeRidged = 0.0_RKIND - openingRateRidge = 0.0_RKIND - - ! tendancies - call MPAS_pool_get_config(block % configs, "config_use_ice_age", config_use_ice_age) - - call MPAS_pool_get_subpool(block % structs, "diagnostics", diagnosticsPool) - call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracersAggregatePool) - - call MPAS_pool_get_array(diagnosticsPool, "iceAreaTendencyTransport", iceAreaTendencyTransport) - call MPAS_pool_get_array(diagnosticsPool, "iceVolumeTendencyTransport", iceVolumeTendencyTransport) - call MPAS_pool_get_array(diagnosticsPool, "iceAgeTendencyTransport", iceAgeTendencyTransport) - - call MPAS_pool_get_array(tracersAggregatePool, "iceAreaCell", iceAreaCell) - call MPAS_pool_get_array(tracersAggregatePool, "iceVolumeCell", iceVolumeCell) - call MPAS_pool_get_array(tracersAggregatePool, "iceAgeCell", iceAgeCell) - - ! transport tendencies - iceAreaTendencyTransport = iceAreaCell - iceVolumeTendencyTransport = iceVolumeCell - if (config_use_ice_age) then - iceAgeTendencyTransport = iceAgeCell - else - iceAgeTendencyTransport = 0.0_RKIND - endif - - block => block % next - end do - - endif ! config_use_column_physics - - end subroutine seaice_column_reinitialize_diagnostics_dynamics - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_column_reinitialize_diagnostics_bgc -! -!> \brief Reinitialize BGC diagnostics -!> \author Adrian K. Turner, LANL -!> \date 27th September 2015 -!> \details -!> Reinitialize BGC diagnostics -! -!----------------------------------------------------------------------- - - subroutine seaice_column_reinitialize_diagnostics_bgc(domain) - - type(domain_type) :: domain - - type(block_type), pointer :: block - - type(MPAS_pool_type), pointer :: & - biogeochemistryPool, & - diagnostics_biogeochemistryPool - - ! biogeochemistry - real(kind=RKIND), dimension(:), pointer :: & - primaryProduction, & - netSpecificAlgalGrowthRate, & - netBrineHeight, & - zSalinityFlux, & - zSalinityGDFlux, & - totalChlorophyll, & - totalCarbonContentCell - - real(kind=RKIND), dimension(:,:), pointer :: & - oceanBioFluxes, & - atmosIceBioFluxes, & - snowIceBioFluxes, & - totalVerticalBiologyIce, & - totalVerticalBiologySnow, & - bgridPorosityIceCell, & - bgridSalinityIceCell, & - bgridTemperatureIceCell - - real(kind=RKIND), dimension(:,:,:), pointer :: & - bioTracerShortwave - - logical, pointer :: & - config_use_column_physics, & - config_use_column_biogeochemistry, & - config_use_column_shortwave, & - config_use_column_package, & - config_use_vertical_tracers, & - config_use_vertical_zsalinity, & - config_use_zaerosols - - call MPAS_pool_get_config(domain % blocklist % configs, "config_use_column_physics", config_use_column_physics) - - if (config_use_column_physics) then - - block => domain % blocklist - do while (associated(block)) - - ! biogeochemistry - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols", config_use_zaerosols) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) - - if (config_use_column_biogeochemistry .or. config_use_zaerosols) then - - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistryPool) - call MPAS_pool_get_subpool(block % structs, "diagnostics_biogeochemistry", diagnostics_biogeochemistryPool) - - if (config_use_vertical_tracers) then - call MPAS_pool_get_array(biogeochemistryPool, "primaryProduction", primaryProduction) - call MPAS_pool_get_array(biogeochemistryPool, "totalChlorophyll", totalChlorophyll) - call MPAS_pool_get_array(biogeochemistryPool, "netSpecificAlgalGrowthRate", netSpecificAlgalGrowthRate) - call MPAS_pool_get_array(diagnostics_biogeochemistryPool, "bgridSalinityIceCell", bgridSalinityIceCell) - call MPAS_pool_get_array(diagnostics_biogeochemistryPool, "bgridPorosityIceCell", bgridPorosityIceCell) - call MPAS_pool_get_array(diagnostics_biogeochemistryPool, "bgridTemperatureIceCell", bgridTemperatureIceCell) - - primaryProduction = 0.0_RKIND - totalChlorophyll = 0.0_RKIND - netSpecificAlgalGrowthRate = 0.0_RKIND - bgridSalinityIceCell = 0.0_RKIND - bgridPorosityIceCell = 0.0_RKIND - bgridTemperatureIceCell = 0.0_RKIND - - end if - - if (config_use_vertical_zsalinity) then - call MPAS_pool_get_array(biogeochemistryPool, "zSalinityFlux", zSalinityFlux) - call MPAS_pool_get_array(biogeochemistryPool, "zSalinityGDFlux", zSalinityGDFlux) - - zSalinityFlux = 0.0_RKIND - zSalinityGDFlux = 0.0_RKIND - - end if - - call MPAS_pool_get_array(biogeochemistryPool, "netBrineHeight", netBrineHeight) - call MPAS_pool_get_array(biogeochemistryPool, "oceanBioFluxes", oceanBioFluxes) - call MPAS_pool_get_array(biogeochemistryPool, "atmosIceBioFluxes", atmosIceBioFluxes) - call MPAS_pool_get_array(biogeochemistryPool, "snowIceBioFluxes", snowIceBioFluxes) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBiologyIce", totalVerticalBiologyIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBiologySnow", totalVerticalBiologySnow) - call MPAS_pool_get_array(biogeochemistryPool, "totalCarbonContentCell", totalCarbonContentCell) - - - netBrineHeight = 0.0_RKIND - oceanBioFluxes = 0.0_RKIND - atmosIceBioFluxes = 0.0_RKIND - snowIceBioFluxes = 0.0_RKIND - totalVerticalBiologyIce = 0.0_RKIND - totalVerticalBiologySnow = 0.0_RKIND - totalCarbonContentCell = 0.0_RKIND - - endif - - call MPAS_pool_get_config(block % configs, "config_use_column_shortwave", config_use_column_shortwave) - - if (config_use_column_biogeochemistry .or. config_use_column_shortwave .or. config_use_zaerosols) then - - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistryPool) - call MPAS_pool_get_array(biogeochemistryPool, "bioTracerShortwave", bioTracerShortwave) - bioTracerShortwave = 0.0_RKIND - - endif - - block => block % next - end do - - endif ! config_use_column_physics - - end subroutine seaice_column_reinitialize_diagnostics_bgc - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_separate_snow_ice_tracers -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 13 March 2017 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_separate_snow_ice_tracers(domain) - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers - - logical, pointer :: & - config_use_vertical_biochemistry, & - config_use_nitrate, & - config_use_carbon, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - real(kind=RKIND), dimension(:,:,:), pointer :: & - verticalAerosolsConc, & - verticalAerosolsSnow, & - verticalAerosolsIce, & - verticalDissolvedIronConc, & - verticalParticulateIronConc, & - verticalHumicsConc, & - verticalNonreactiveConc, & - verticalDMSPdConc, & - verticalDMSPpConc, & - verticalDMSConc, & - verticalAmmoniumConc, & - verticalSilicateConc, & - verticalNitrateConc, & - verticalDONConc, & - verticalDICConc, & - verticalDOCConc, & - verticalAlgaeConc, & - verticalDissolvedIronSnow, & - verticalParticulateIronSnow, & - verticalHumicsSnow, & - verticalNonreactiveSnow, & - verticalDMSPdSnow, & - verticalDMSPpSnow, & - verticalDMSSnow, & - verticalAmmoniumSnow, & - verticalSilicateSnow, & - verticalNitrateSnow, & - verticalDONSnow, & - verticalDICSnow, & - verticalDOCSnow, & - verticalAlgaeSnow, & - verticalDissolvedIronIce, & - verticalParticulateIronIce, & - verticalHumicsIce, & - verticalNonreactiveIce, & - verticalDMSPdIce, & - verticalDMSPpIce, & - verticalDMSIce, & - verticalAmmoniumIce, & - verticalSilicateIce, & - verticalNitrateIce, & - verticalDONIce, & - verticalDICIce, & - verticalDOCIce, & - verticalAlgaeIce - - integer, pointer :: & - nCellsSolve, & - nBioLayersP1, & - nBioLayersP3, & - nCategories, & - nzAerosols, & - TWO, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron - - integer :: & - iCell, & - iBioTracers, & - iCategory, & - iBioData, & - iBioCount, & - iSnowCount, & - iIceCount - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nCategories", nCategories) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_ammonium",config_use_ammonium) - call MPAS_pool_get_config(block % configs, "config_use_silicate",config_use_silicate) - call MPAS_pool_get_config(block % configs, "config_use_DMS",config_use_DMS) - call MPAS_pool_get_config(block % configs, "config_use_nonreactive",config_use_nonreactive) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_use_DON",config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_iron",config_use_iron) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(mesh, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(mesh, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(mesh, "TWO", TWO) - call MPAS_pool_get_dimension(mesh, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(mesh, "nDOC", nDOC) - call MPAS_pool_get_dimension(mesh, "nDIC", nDIC) - call MPAS_pool_get_dimension(mesh, "nDON", nDON) - call MPAS_pool_get_dimension(mesh, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(mesh, "nDissolvedIron", nDissolvedIron) - - call MPAS_pool_get_array(tracers, "verticalAerosolsConc",verticalAerosolsConc,1) - call MPAS_pool_get_array(tracers, "verticalAerosolsSnow",verticalAerosolsSnow,1) - call MPAS_pool_get_array(tracers, "verticalAerosolsIce",verticalAerosolsIce,1) - call MPAS_pool_get_array(tracers, "verticalAlgaeConc",verticalAlgaeConc,1) - call MPAS_pool_get_array(tracers, "verticalDOCConc",verticalDOCConc,1) - call MPAS_pool_get_array(tracers, "verticalDICConc",verticalDICConc,1) - call MPAS_pool_get_array(tracers, "verticalDONConc",verticalDONConc,1) - call MPAS_pool_get_array(tracers, "verticalNitrateConc",verticalNitrateConc,1) - call MPAS_pool_get_array(tracers, "verticalSilicateConc",verticalSilicateConc,1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumConc",verticalAmmoniumConc,1) - call MPAS_pool_get_array(tracers, "verticalDMSConc",verticalDMSConc,1) - call MPAS_pool_get_array(tracers, "verticalDMSPpConc",verticalDMSPpConc,1) - call MPAS_pool_get_array(tracers, "verticalDMSPdConc",verticalDMSPdConc,1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveConc",verticalNonreactiveConc,1) - call MPAS_pool_get_array(tracers, "verticalHumicsConc",verticalHumicsConc,1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronConc",verticalParticulateIronConc,1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronConc",verticalDissolvedIronConc,1) - call MPAS_pool_get_array(tracers, "verticalAlgaeSnow",verticalAlgaeSnow,1) - call MPAS_pool_get_array(tracers, "verticalDOCSnow",verticalDOCSnow,1) - call MPAS_pool_get_array(tracers, "verticalDICSnow",verticalDICSnow,1) - call MPAS_pool_get_array(tracers, "verticalDONSnow",verticalDONSnow,1) - call MPAS_pool_get_array(tracers, "verticalNitrateSnow",verticalNitrateSnow,1) - call MPAS_pool_get_array(tracers, "verticalSilicateSnow",verticalSilicateSnow,1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumSnow",verticalAmmoniumSnow,1) - call MPAS_pool_get_array(tracers, "verticalDMSSnow",verticalDMSSnow,1) - call MPAS_pool_get_array(tracers, "verticalDMSPpSnow",verticalDMSPpSnow,1) - call MPAS_pool_get_array(tracers, "verticalDMSPdSnow",verticalDMSPdSnow,1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveSnow",verticalNonreactiveSnow,1) - call MPAS_pool_get_array(tracers, "verticalHumicsSnow",verticalHumicsSnow,1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronSnow",verticalParticulateIronSnow,1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronSnow",verticalDissolvedIronSnow,1) - call MPAS_pool_get_array(tracers, "verticalAlgaeIce",verticalAlgaeIce,1) - call MPAS_pool_get_array(tracers, "verticalDOCIce",verticalDOCIce,1) - call MPAS_pool_get_array(tracers, "verticalDICIce",verticalDICIce,1) - call MPAS_pool_get_array(tracers, "verticalDONIce",verticalDONIce,1) - call MPAS_pool_get_array(tracers, "verticalNitrateIce",verticalNitrateIce,1) - call MPAS_pool_get_array(tracers, "verticalSilicateIce",verticalSilicateIce,1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumIce",verticalAmmoniumIce,1) - call MPAS_pool_get_array(tracers, "verticalDMSIce",verticalDMSIce,1) - call MPAS_pool_get_array(tracers, "verticalDMSPpIce",verticalDMSPpIce,1) - call MPAS_pool_get_array(tracers, "verticalDMSPdIce",verticalDMSPdIce,1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveIce",verticalNonreactiveIce,1) - call MPAS_pool_get_array(tracers, "verticalHumicsIce",verticalHumicsIce,1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronIce",verticalParticulateIronIce,1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronIce",verticalDissolvedIronIce,1) - - do iCell = 1, nCellsSolve - do iCategory = 1, nCategories - - ! aerosols - if (config_use_zaerosols) then - do iBioTracers = 1, nzAerosols - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalAerosolsSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalAerosolsConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - - enddo - do iBioCount = 1, nBioLayersP1 - verticalAerosolsIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalAerosolsConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - endif - - ! algal nitrogen - if (config_use_vertical_biochemistry) then - do iBioTracers = 1, nAlgae - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalAlgaeSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalAlgaeConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalAlgaeIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalAlgaeConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - endif - - ! dissolved organic and inorganic carbon - if (config_use_carbon) then - do iBioTracers = 1, nDOC - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDOCSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalDOCConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDOCIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalDOCConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - do iBioTracers = 1, nDIC - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDICSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalDICConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDICIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalDICConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - endif - - ! nitrate - if (config_use_nitrate) then - do iBioCount = 1,TWO - verticalNitrateSnow(iBioCount,iCategory,iCell) = & - verticalNitrateConc(nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalNitrateIce(iBioCount,iCategory,iCell) = & - verticalNitrateConc(iBioCount,iCategory,iCell) - enddo - endif - - ! ammonium - if (config_use_ammonium) then - do iBioCount = 1,TWO - verticalAmmoniumSnow(iBioCount,iCategory,iCell) = & - verticalAmmoniumConc(nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalAmmoniumIce(iBioCount,iCategory,iCell) = & - verticalAmmoniumConc(iBioCount,iCategory,iCell) - enddo - endif - - ! silicate - if (config_use_silicate) then - do iBioCount = 1,TWO - verticalSilicateSnow(iBioCount,iCategory,iCell) = & - verticalSilicateConc(nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalSilicateIce(iBioCount,iCategory,iCell) = & - verticalSilicateConc(iBioCount,iCategory,iCell) - enddo - endif - - ! DMS, DMSPp, DMPSd - if (config_use_DMS) then - do iBioCount = 1,TWO - verticalDMSSnow(iBioCount,iCategory,iCell) = & - verticalDMSConc(nBioLayersP1+iBioCount,iCategory,iCell) - verticalDMSPpSnow(iBioCount,iCategory,iCell) = & - verticalDMSPpConc(nBioLayersP1+iBioCount,iCategory,iCell) - verticalDMSPdSnow(iBioCount,iCategory,iCell) = & - verticalDMSPdConc(nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDMSIce(iBioCount,iCategory,iCell) = & - verticalDMSConc(iBioCount,iCategory,iCell) - verticalDMSPpIce(iBioCount,iCategory,iCell) = & - verticalDMSPpConc(iBioCount,iCategory,iCell) - verticalDMSPdIce(iBioCount,iCategory,iCell) = & - verticalDMSPdConc(iBioCount,iCategory,iCell) - enddo - endif - - ! nonreactive tracer - if (config_use_nonreactive) then - do iBioCount = 1,TWO - verticalNonreactiveSnow(iBioCount,iCategory,iCell) = & - verticalNonreactiveConc(nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalNonreactiveIce(iBioCount,iCategory,iCell) = & - verticalNonreactiveConc(iBioCount,iCategory,iCell) - enddo - endif - - ! humics - if (config_use_humics) then - do iBioCount = 1,TWO - verticalHumicsSnow(iBioCount,iCategory,iCell) = & - verticalHumicsConc(nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalHumicsIce(iBioCount,iCategory,iCell) = & - verticalHumicsConc(iBioCount,iCategory,iCell) - enddo - endif - - ! proteins and amino acids - if (config_use_DON) then - do iBioTracers = 1, nDON - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDONSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalDONConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDONIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalDONConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - endif - - ! particulate and dissolved iron - if (config_use_iron) then - do iBioTracers = 1, nParticulateIron - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalParticulateIronSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalParticulateIronConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalParticulateIronIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalParticulateIronConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - do iBioTracers = 1, nDissolvedIron - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDissolvedIronSnow(iBioCount+iSnowCount,iCategory,iCell) = & - verticalDissolvedIronConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDissolvedIronIce(iBioCount+iIceCount,iCategory,iCell) = & - verticalDissolvedIronConc(iBioData+iBioCount,iCategory,iCell) - enddo - enddo - endif - - enddo - enddo - - block => block % next - end do - - end subroutine column_separate_snow_ice_tracers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! column_combine_snow_ice_tracers -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 13 Mar 2017 -!> \details -!> -! -!----------------------------------------------------------------------- - - subroutine column_combine_snow_ice_tracers(domain) - - type(domain_type), intent(inout) :: domain - - type(block_type), pointer :: & - block - - type(MPAS_pool_type), pointer :: & - mesh, & - tracers - - logical, pointer :: & - config_use_vertical_biochemistry, & - config_use_nitrate, & - config_use_carbon, & - config_use_ammonium, & - config_use_silicate, & - config_use_DMS, & - config_use_nonreactive, & - config_use_humics, & - config_use_DON, & - config_use_iron, & - config_use_zaerosols - - real(kind=RKIND), dimension(:,:,:), pointer :: & - verticalAerosolsConc, & - verticalAerosolsSnow, & - verticalAerosolsIce, & - verticalDissolvedIronConc, & - verticalParticulateIronConc, & - verticalHumicsConc, & - verticalNonreactiveConc, & - verticalDMSPdConc, & - verticalDMSPpConc, & - verticalDMSConc, & - verticalAmmoniumConc, & - verticalSilicateConc, & - verticalNitrateConc, & - verticalDONConc, & - verticalDICConc, & - verticalDOCConc, & - verticalAlgaeConc, & - verticalDissolvedIronSnow, & - verticalParticulateIronSnow, & - verticalHumicsSnow, & - verticalNonreactiveSnow, & - verticalDMSPdSnow, & - verticalDMSPpSnow, & - verticalDMSSnow, & - verticalAmmoniumSnow, & - verticalSilicateSnow, & - verticalNitrateSnow, & - verticalDONSnow, & - verticalDICSnow, & - verticalDOCSnow, & - verticalAlgaeSnow, & - verticalDissolvedIronIce, & - verticalParticulateIronIce, & - verticalHumicsIce, & - verticalNonreactiveIce, & - verticalDMSPdIce, & - verticalDMSPpIce, & - verticalDMSIce, & - verticalAmmoniumIce, & - verticalSilicateIce, & - verticalNitrateIce, & - verticalDONIce, & - verticalDICIce, & - verticalDOCIce, & - verticalAlgaeIce - - integer, pointer :: & - nCellsSolve, & - nBioLayersP1, & - nBioLayersP3, & - nCategories, & - nzAerosols, & - TWO, & - nAlgae, & - nDOC, & - nDIC, & - nDON, & - nParticulateIron, & - nDissolvedIron - - integer :: & - iCell, & - iBioTracers, & - iCategory, & - iBioData, & - iBioCount, & - iSnowCount, & - iIceCount - - call MPAS_pool_get_dimension(domain % blocklist % dimensions, "nCategories", nCategories) - - block => domain % blocklist - do while (associated(block)) - - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_ammonium",config_use_ammonium) - call MPAS_pool_get_config(block % configs, "config_use_silicate",config_use_silicate) - call MPAS_pool_get_config(block % configs, "config_use_DMS",config_use_DMS) - call MPAS_pool_get_config(block % configs, "config_use_nonreactive",config_use_nonreactive) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_use_DON",config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_iron",config_use_iron) - call MPAS_pool_get_config(block % configs, "config_use_zaerosols",config_use_zaerosols) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - - call MPAS_pool_get_dimension(mesh, "nCellsSolve", nCellsSolve) - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nzAerosols", nzAerosols) - call MPAS_pool_get_dimension(mesh, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(mesh, "nBioLayersP3", nBioLayersP3) - call MPAS_pool_get_dimension(mesh, "TWO", TWO) - call MPAS_pool_get_dimension(mesh, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(mesh, "nDOC", nDOC) - call MPAS_pool_get_dimension(mesh, "nDIC", nDIC) - call MPAS_pool_get_dimension(mesh, "nDON", nDON) - call MPAS_pool_get_dimension(mesh, "nParticulateIron", nParticulateIron) - call MPAS_pool_get_dimension(mesh, "nDissolvedIron", nDissolvedIron) - - call MPAS_pool_get_array(tracers, "verticalAerosolsConc",verticalAerosolsConc,1) - call MPAS_pool_get_array(tracers, "verticalAerosolsSnow",verticalAerosolsSnow,1) - call MPAS_pool_get_array(tracers, "verticalAerosolsIce",verticalAerosolsIce,1) - call MPAS_pool_get_array(tracers, "verticalAlgaeConc",verticalAlgaeConc,1) - call MPAS_pool_get_array(tracers, "verticalDOCConc",verticalDOCConc,1) - call MPAS_pool_get_array(tracers, "verticalDICConc",verticalDICConc,1) - call MPAS_pool_get_array(tracers, "verticalDONConc",verticalDONConc,1) - call MPAS_pool_get_array(tracers, "verticalNitrateConc",verticalNitrateConc,1) - call MPAS_pool_get_array(tracers, "verticalSilicateConc",verticalSilicateConc,1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumConc",verticalAmmoniumConc,1) - call MPAS_pool_get_array(tracers, "verticalDMSConc",verticalDMSConc,1) - call MPAS_pool_get_array(tracers, "verticalDMSPpConc",verticalDMSPpConc,1) - call MPAS_pool_get_array(tracers, "verticalDMSPdConc",verticalDMSPdConc,1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveConc",verticalNonreactiveConc,1) - call MPAS_pool_get_array(tracers, "verticalHumicsConc",verticalHumicsConc,1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronConc",verticalParticulateIronConc,1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronConc",verticalDissolvedIronConc,1) - call MPAS_pool_get_array(tracers, "verticalAlgaeSnow",verticalAlgaeSnow,1) - call MPAS_pool_get_array(tracers, "verticalDOCSnow",verticalDOCSnow,1) - call MPAS_pool_get_array(tracers, "verticalDICSnow",verticalDICSnow,1) - call MPAS_pool_get_array(tracers, "verticalDONSnow",verticalDONSnow,1) - call MPAS_pool_get_array(tracers, "verticalNitrateSnow",verticalNitrateSnow,1) - call MPAS_pool_get_array(tracers, "verticalSilicateSnow",verticalSilicateSnow,1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumSnow",verticalAmmoniumSnow,1) - call MPAS_pool_get_array(tracers, "verticalDMSSnow",verticalDMSSnow,1) - call MPAS_pool_get_array(tracers, "verticalDMSPpSnow",verticalDMSPpSnow,1) - call MPAS_pool_get_array(tracers, "verticalDMSPdSnow",verticalDMSPdSnow,1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveSnow",verticalNonreactiveSnow,1) - call MPAS_pool_get_array(tracers, "verticalHumicsSnow",verticalHumicsSnow,1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronSnow",verticalParticulateIronSnow,1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronSnow",verticalDissolvedIronSnow,1) - call MPAS_pool_get_array(tracers, "verticalAlgaeIce",verticalAlgaeIce,1) - call MPAS_pool_get_array(tracers, "verticalDOCIce",verticalDOCIce,1) - call MPAS_pool_get_array(tracers, "verticalDICIce",verticalDICIce,1) - call MPAS_pool_get_array(tracers, "verticalDONIce",verticalDONIce,1) - call MPAS_pool_get_array(tracers, "verticalNitrateIce",verticalNitrateIce,1) - call MPAS_pool_get_array(tracers, "verticalSilicateIce",verticalSilicateIce,1) - call MPAS_pool_get_array(tracers, "verticalAmmoniumIce",verticalAmmoniumIce,1) - call MPAS_pool_get_array(tracers, "verticalDMSIce",verticalDMSIce,1) - call MPAS_pool_get_array(tracers, "verticalDMSPpIce",verticalDMSPpIce,1) - call MPAS_pool_get_array(tracers, "verticalDMSPdIce",verticalDMSPdIce,1) - call MPAS_pool_get_array(tracers, "verticalNonreactiveIce",verticalNonreactiveIce,1) - call MPAS_pool_get_array(tracers, "verticalHumicsIce",verticalHumicsIce,1) - call MPAS_pool_get_array(tracers, "verticalParticulateIronIce",verticalParticulateIronIce,1) - call MPAS_pool_get_array(tracers, "verticalDissolvedIronIce",verticalDissolvedIronIce,1) - - do iCell = 1, nCellsSolve - do iCategory = 1, nCategories - - ! aerosols - if (config_use_zaerosols) then - do iBioTracers = 1, nzAerosols - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalAerosolsConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalAerosolsSnow(iBioCount+iSnowCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalAerosolsConc(iBioData+iBioCount,iCategory,iCell) = & - verticalAerosolsIce(iBioCount+iIceCount,iCategory,iCell) - enddo - enddo - endif - - ! algal nitrogen - if (config_use_vertical_biochemistry) then - do iBioTracers = 1, nAlgae - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalAlgaeConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalAlgaeSnow(iBioCount+iSnowCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalAlgaeConc(iBioData+iBioCount,iCategory,iCell) = & - verticalAlgaeIce(iBioCount+iIceCount,iCategory,iCell) - enddo - enddo - endif - - ! dissolved organic and inorganic carbon - if (config_use_carbon) then - do iBioTracers = 1, nDOC - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDOCConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDOCSnow(iBioCount+iSnowCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDOCConc(iBioData+iBioCount,iCategory,iCell) = & - verticalDOCIce(iBioCount+iIceCount,iCategory,iCell) - enddo - enddo - do iBioTracers = 1, nDIC - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDICConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDICSnow(iBioCount+iSnowCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDICConc(iBioData+iBioCount,iCategory,iCell) = & - verticalDICIce(iBioCount+iIceCount,iCategory,iCell) - enddo - enddo - endif - - ! nitrate - if (config_use_nitrate) then - do iBioCount = 1,TWO - verticalNitrateConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalNitrateSnow(iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalNitrateConc(iBioCount,iCategory,iCell) = & - verticalNitrateIce(iBioCount,iCategory,iCell) - enddo - endif - - ! ammonium - if (config_use_ammonium) then - do iBioCount = 1,TWO - verticalAmmoniumConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalAmmoniumSnow(iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalAmmoniumConc(iBioCount,iCategory,iCell) = & - verticalAmmoniumIce(iBioCount,iCategory,iCell) - enddo - endif - - ! silicate - if (config_use_silicate) then - do iBioCount = 1,TWO - verticalSilicateConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalSilicateSnow(iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalSilicateConc(iBioCount,iCategory,iCell) = & - verticalSilicateIce(iBioCount,iCategory,iCell) - enddo - endif - - ! DMS, DMSPp, DMPSd - if (config_use_DMS) then - do iBioCount = 1,TWO - verticalDMSConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDMSSnow(iBioCount,iCategory,iCell) - verticalDMSPpConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDMSPpSnow(iBioCount,iCategory,iCell) - verticalDMSPdConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDMSPdSnow(iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDMSConc(iBioCount,iCategory,iCell) = & - verticalDMSIce(iBioCount,iCategory,iCell) - verticalDMSPpConc(iBioCount,iCategory,iCell) = & - verticalDMSPpIce(iBioCount,iCategory,iCell) - verticalDMSPdConc(iBioCount,iCategory,iCell) = & - verticalDMSPdIce(iBioCount,iCategory,iCell) - enddo - endif - - ! nonreactive tracer - if (config_use_nonreactive) then - do iBioCount = 1,TWO - verticalNonreactiveConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalNonreactiveSnow(iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalNonreactiveConc(iBioCount,iCategory,iCell) = & - verticalNonreactiveIce(iBioCount,iCategory,iCell) - enddo - endif - - ! humics - if (config_use_humics) then - do iBioCount = 1,TWO - verticalHumicsConc(nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalHumicsSnow(iBioCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalHumicsConc(iBioCount,iCategory,iCell) = & - verticalHumicsIce(iBioCount,iCategory,iCell) - enddo - endif - - ! proteins and amino acids - if (config_use_DON) then - do iBioTracers = 1, nDON - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDONConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDONSnow(iBioCount+iSnowCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDONConc(iBioData+iBioCount,iCategory,iCell) = & - verticalDONIce(iBioCount+iIceCount,iCategory,iCell) - enddo - enddo - endif - - ! particulate and dissolved iron - if (config_use_iron) then - do iBioTracers = 1, nParticulateIron - iSnowCount = (iBioTracers-1)*2 - iIceCount = (iBioTracers-1)*nBioLayersP1 - iBioData = (iBioTracers-1)*nBioLayersP3 - - do iBioCount = 1,TWO - verticalDissolvedIronConc(iBioData+nBioLayersP1+iBioCount,iCategory,iCell) = & - verticalDissolvedIronSnow(iBioCount+iSnowCount,iCategory,iCell) - enddo - do iBioCount = 1, nBioLayersP1 - verticalDissolvedIronConc(iBioData+iBioCount,iCategory,iCell) = & - verticalDissolvedIronIce(iBioCount+iIceCount,iCategory,iCell) - enddo - enddo - endif - - enddo - enddo - - block => block % next - end do - - end subroutine column_combine_snow_ice_tracers - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_ocean_carbon_flux -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 26 May 2020 -!> \details Calculate the ocean carbon flux -!> by summing the appropriate biogeochemical tracer fluxes in units of mmol C/m2/s -!> -!> ocean carbon flux = algal nitrogen group fluxes * (C to N ratios) -!> + dissolved carbon group fluxes -!> + dissolved organic nitrogen * (C to N ratio) -!> + dissolved inorganic carbon fluxes + humic fluxes -! -!----------------------------------------------------------------------- - - subroutine seaice_ocean_carbon_flux(block,oceanCarbonFlux,oceanBioFluxes,iCell) - - real(kind=RKIND), dimension(:), intent(out) :: & - oceanCarbonFlux - - real(kind=RKIND), dimension(:,:,:), intent(in) :: & - oceanBioFluxes - - integer, intent(in) :: & - iCell - - type(block_type), intent(in) :: & - block - - logical, pointer :: & - config_use_column_biogeochemistry, & - config_use_vertical_biochemistry, & - config_use_carbon, & - config_use_DON, & - config_use_humics - - integer, pointer :: & - nAlgae, & - nDOC, & - nDON, & - nDIC - - type(MPAS_pool_type), pointer :: & - mesh, & - biogeochemistry - - real(kind=RKIND), pointer :: & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_C_to_N_proteins - - integer, pointer :: & - nCategories, & - nZBGCTracers, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - maxBCType, & - maxDustType, & - maxAerosolType - - real(kind=RKIND), dimension(:), allocatable :: & - ratio_C_to_N - - real(kind=RKIND), dimension(:,:), allocatable :: & - oceanBioFluxesAll - - integer :: & - iBioTracers, & - iBioData, & - iCategory - - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_diatoms", config_ratio_C_to_N_diatoms) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_small_plankton", config_ratio_C_to_N_small_plankton) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_phaeocystis", config_ratio_C_to_N_phaeocystis) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_proteins", config_ratio_C_to_N_proteins) - - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - call MPAS_pool_get_dimension(mesh, "nZBGCTracers", nZBGCTracers) - call MPAS_pool_get_dimension(mesh, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(mesh, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(mesh, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(mesh, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(mesh, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(mesh, "maxIronType", maxIronType) - call MPAS_pool_get_dimension(mesh, "maxBCType", maxBCType) - call MPAS_pool_get_dimension(mesh, "maxDustType", maxDustType) - - - allocate(oceanBioFluxesAll(nZBGCTracers,nCategories)) - allocate(ratio_C_to_N(3)) - - ratio_C_to_N(1) = config_ratio_C_to_N_diatoms - ratio_C_to_N(2) = config_ratio_C_to_N_small_plankton - ratio_C_to_N(3) = config_ratio_C_to_N_phaeocystis - - if (config_use_column_biogeochemistry) then - - do iCategory = 1, nCategories - - oceanCarbonFlux(iCategory) = 0.0_RKIND - oceanBioFluxesAll(:,iCategory) = 0.0_RKIND - - do iBioTracers = 1, ciceTracerObject % nBioTracers - iBioData = ciceTracerObject % index_LayerIndexToDataArray(iBioTracers) - oceanBioFluxesAll(iBioData,iCategory) = oceanBioFluxes(iBioTracers,iCategory,iCell) - enddo - iBioData = 0 - - ! Algae - do iBioTracers = 1, maxAlgaeType - iBioData = iBioData+1 - oceanCarbonFlux(iCategory) = oceanCarbonFlux(iCategory) + & - oceanBioFluxesAll(iBioData,iCategory) * ratio_C_to_N(iBioTracers) - enddo - - ! Nitrate - iBioData = iBioData+1 - - ! Polysaccharids and Lipids - do iBioTracers = 1, maxDOCType - iBioData = iBioData+1 - oceanCarbonFlux(iCategory) = oceanCarbonFlux(iCategory) + & - oceanBioFluxesAll(iBioData,iCategory) - enddo - - ! DIC - do iBioTracers = 1, maxDICType - iBioData = iBioData+1 - oceanCarbonFlux(iCategory) = oceanCarbonFlux(iCategory) + & - oceanBioFluxesAll(iBioData,iCategory) - enddo - - ! + Chlorophyll (maxAlgaeType) + Ammonium (1) + Silicate (1) + DMSPp (1) + DMSPd (1) - ! + DMS (1) + PON (1) - - iBioData = iBioData+maxAlgaeType + 6 - - ! DON - do iBioTracers = 1, maxDONType - iBioData = iBioData+1 - oceanCarbonFlux(iCategory) = oceanCarbonFlux(iCategory) + & - oceanBioFluxesAll(iBioData,iCategory) * config_ratio_C_to_N_proteins - enddo - - ! + dFe (maxIronType) + pFe (maxIronType) - ! + Black Carbon (maxBCType) + Dust (maxDustType) - - iBioData = iBioData + 2*maxIronType + maxBCType + maxDustType - - ! Humics - iBioData = iBioData+1 - oceanCarbonFlux(iCategory) = oceanCarbonFlux(iCategory) + & - oceanBioFluxesAll(iBioData,iCategory) - - enddo ! nCategories - endif - - deallocate(oceanBioFluxesAll) - deallocate(ratio_C_to_N) - - end subroutine seaice_ocean_carbon_flux - - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_ocean_carbon_flux_cell -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 26 May 2020 -!> \details Calculate the ocean carbon flux -!> by summing the appropriate biogeochemical tracer fluxes in units of mmol C/m2/s -!> -!> ocean carbon flux = algal nitrogen group fluxes * (C to N ratios) -!> + dissolved carbon group fluxes -!> + dissolved organic nitrogen * (C to N ratio) -!> + dissolved inorganic carbon fluxes + humic fluxes -! -!----------------------------------------------------------------------- - - subroutine seaice_ocean_carbon_flux_cell(block,oceanCarbonFlux,oceanBioFluxes,iCell) - - real(kind=RKIND), intent(out) :: & - oceanCarbonFlux - - real(kind=RKIND), dimension(:), intent(in) :: & - oceanBioFluxes - - integer, intent(in) :: & - iCell - - type(block_type), intent(in) :: & - block - - logical, pointer :: & - config_use_column_biogeochemistry, & - config_use_vertical_biochemistry, & - config_use_carbon, & - config_use_DON, & - config_use_humics - - integer, pointer :: & - nAlgae, & - nDOC, & - nDON, & - nDIC - - type(MPAS_pool_type), pointer :: & - mesh, & - biogeochemistry - - real(kind=RKIND), pointer :: & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_C_to_N_proteins - - integer, pointer :: & - nZBGCTracers, & - maxAlgaeType, & - maxDOCType, & - maxDICType, & - maxDONType, & - maxIronType, & - maxBCType, & - maxDustType, & - maxAerosolType - - real(kind=RKIND), dimension(:), allocatable :: & - ratio_C_to_N - - real(kind=RKIND), dimension(:), allocatable :: & - oceanBioFluxesAll - - integer :: & - iBioTracers, & - iBioData - - call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_diatoms", config_ratio_C_to_N_diatoms) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_small_plankton", config_ratio_C_to_N_small_plankton) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_phaeocystis", config_ratio_C_to_N_phaeocystis) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_proteins", config_ratio_C_to_N_proteins) - - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - - call MPAS_pool_get_dimension(mesh, "nZBGCTracers", nZBGCTracers) - call MPAS_pool_get_dimension(mesh, "maxAlgaeType", maxAlgaeType) - call MPAS_pool_get_dimension(mesh, "maxDOCType", maxDOCType) - call MPAS_pool_get_dimension(mesh, "maxDICType", maxDICType) - call MPAS_pool_get_dimension(mesh, "maxDONType", maxDONType) - call MPAS_pool_get_dimension(mesh, "maxAerosolType", maxAerosolType) - call MPAS_pool_get_dimension(mesh, "maxIronType", maxIronType) - call MPAS_pool_get_dimension(mesh, "maxBCType", maxBCType) - call MPAS_pool_get_dimension(mesh, "maxDustType", maxDustType) - - allocate(oceanBioFluxesAll(nZBGCTracers)) - allocate(ratio_C_to_N(3)) - - ratio_C_to_N(1) = config_ratio_C_to_N_diatoms - ratio_C_to_N(2) = config_ratio_C_to_N_small_plankton - ratio_C_to_N(3) = config_ratio_C_to_N_phaeocystis - - if (config_use_column_biogeochemistry) then - - oceanCarbonFlux = 0.0_RKIND - oceanBioFluxesAll(:) = 0.0_RKIND - - do iBioTracers = 1, ciceTracerObject % nBioTracers - iBioData = ciceTracerObject % index_LayerIndexToDataArray(iBioTracers) - oceanBioFluxesAll(iBioData) = oceanBioFluxes(iBioTracers) - enddo - iBioData = 0 - - ! Algae - do iBioTracers = 1, maxAlgaeType - iBioData = iBioData+1 - oceanCarbonFlux = oceanCarbonFlux + & - oceanBioFluxesAll(iBioData) * ratio_C_to_N(iBioTracers) - enddo - - ! Nitrate - iBioData = iBioData+1 - - ! Polysaccharids and Lipids - do iBioTracers = 1, maxDOCType - iBioData = iBioData+1 - oceanCarbonFlux = oceanCarbonFlux + & - oceanBioFluxesAll(iBioData) - enddo - - ! DIC - do iBioTracers = 1, maxDICType - iBioData = iBioData+1 - oceanCarbonFlux = oceanCarbonFlux + & - oceanBioFluxesAll(iBioData) - enddo - - ! + Chlorophyll (maxAlgaeType) + Ammonium (1) + Silicate (1) + DMSPp (1) + DMSPd (1) - ! + DMS (1) + PON (1) - - iBioData = iBioData+maxAlgaeType + 6 - - ! DON - do iBioTracers = 1, maxDONType - iBioData = iBioData+1 - oceanCarbonFlux = oceanCarbonFlux + & - oceanBioFluxesAll(iBioData) * config_ratio_C_to_N_proteins - enddo - - ! + dFe (maxIronType) + pFe (maxIronType) - ! + Black Carbon (maxBCType) + Dust (maxDustType) - - iBioData = iBioData + 2*maxIronType + maxBCType + maxDustType - - ! Humics - iBioData = iBioData+1 - oceanCarbonFlux = oceanCarbonFlux + & - oceanBioFluxesAll(iBioData) - - endif - - deallocate(oceanBioFluxesAll) - deallocate(ratio_C_to_N) - - end subroutine seaice_ocean_carbon_flux_cell - - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -! -! seaice_total_carbon_content_category -! -!> \brief -!> \author Nicole Jeffery, LANL -!> \date 26 May 2020 -!> \details Calculate the total carbon concentration in the sea ice category -!> by summing the appropriate biogeochemical tracers in units of mmol C -!> -!> Total carbon = algal nitrogen groups * (C to N ratios) + dissolved carbon groups -!> + dissolved inorganic carbon + humic material -!> + dissolved organic nitrogen * (C to N ratio) -! -!----------------------------------------------------------------------- - - subroutine seaice_total_carbon_content_category(block,totalCarbonContentCategory,iceAreaCategory,iceVolumeCategory,iCell) - - use seaice_constants, only: & - skeletalLayerThickness, & - seaicePuny - - real(kind=RKIND), dimension(:), intent(out) :: & - totalCarbonContentCategory - - real(kind=RKIND), dimension(:,:), intent(in) :: & - iceAreaCategory, & - iceVolumeCategory - - integer, intent(in) :: & - iCell - - type(block_type), intent(in) :: & - block - - logical, pointer :: & - config_use_skeletal_biochemistry, & - config_use_vertical_biochemistry, & - config_use_vertical_tracers, & - config_use_carbon, & - config_use_DON, & - config_use_humics - - integer, pointer :: & - nCategories, & - nBioLayersP1, & - nBioLayers, & - nAlgae, & - nDOC, & - nDIC, & - nDON - - type(MPAS_pool_type), pointer :: & - mesh, & - biogeochemistry, & - tracers - - real(kind=RKIND), dimension(:,:,:), pointer :: & - skeletalAlgaeConc, & - skeletalDOCConc, & - skeletalDICConc, & - skeletalDONConc, & - skeletalHumicsConc, & - verticalAlgaeConc, & - verticalDOCConc, & - verticalDICConc, & - verticalDONConc, & - verticalHumicsConc, & - brineFraction - - real(kind=RKIND), pointer :: & - config_ratio_C_to_N_diatoms, & - config_ratio_C_to_N_small_plankton, & - config_ratio_C_to_N_phaeocystis, & - config_ratio_C_to_N_proteins - - real(kind=RKIND), dimension(:), allocatable :: & - ratio_C_to_N, & - verticalGridSpace - - real(kind=RKIND) :: & - brineHeight - - integer :: & - iBioTracers, & - iBioCount, & - iLayers, & - iCategory - - call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) - call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) - call MPAS_pool_get_config(block % configs, "config_use_carbon", config_use_carbon) - call MPAS_pool_get_config(block % configs, "config_use_DON", config_use_DON) - call MPAS_pool_get_config(block % configs, "config_use_humics",config_use_humics) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_diatoms", config_ratio_C_to_N_diatoms) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_small_plankton", config_ratio_C_to_N_small_plankton) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_phaeocystis", config_ratio_C_to_N_phaeocystis) - call MPAS_pool_get_config(block % configs, "config_ratio_C_to_N_proteins", config_ratio_C_to_N_proteins) - - call MPAS_pool_get_dimension(block % dimensions, "nBioLayers", nBioLayers) - call MPAS_pool_get_dimension(block % dimensions, "nBioLayersP1", nBioLayersP1) - call MPAS_pool_get_dimension(block % dimensions, "nAlgae", nAlgae) - call MPAS_pool_get_dimension(block % dimensions, "nDOC", nDOC) - call MPAS_pool_get_dimension(block % dimensions, "nDIC", nDIC) - call MPAS_pool_get_dimension(block % dimensions, "nDON", nDON) - - call MPAS_pool_get_subpool(block % structs, "tracers", tracers) - call MPAS_pool_get_subpool(block % structs, "biogeochemistry", biogeochemistry) - call MPAS_pool_get_subpool(block % structs, "mesh", mesh) - - call MPAS_pool_get_dimension(mesh, "nCategories", nCategories) - - call MPAS_pool_get_array(tracers, "skeletalAlgaeConc", skeletalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDOCConc", skeletalDOCConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDICConc", skeletalDICConc, 1) - call MPAS_pool_get_array(tracers, "skeletalDONConc", skeletalDONConc, 1) - call MPAS_pool_get_array(tracers, "skeletalHumicsConc", skeletalHumicsConc, 1) - call MPAS_pool_get_array(tracers, "verticalAlgaeConc", verticalAlgaeConc, 1) - call MPAS_pool_get_array(tracers, "verticalDOCConc", verticalDOCConc, 1) - call MPAS_pool_get_array(tracers, "verticalDICConc", verticalDICConc, 1) - call MPAS_pool_get_array(tracers, "verticalDONConc", verticalDONConc, 1) - call MPAS_pool_get_array(tracers, "verticalHumicsConc", verticalHumicsConc, 1) - call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) - - allocate(ratio_C_to_N(3)) - allocate(verticalGridSpace(nBioLayersP1)) - - ratio_C_to_N(1) = config_ratio_C_to_N_diatoms - ratio_C_to_N(2) = config_ratio_C_to_N_small_plankton - ratio_C_to_N(3) = config_ratio_C_to_N_phaeocystis - - - verticalGridSpace(:) = 1.0_RKIND/real(nBioLayers,kind=RKIND) - verticalGridSpace(1) = verticalGridSpace(1)/2.0_RKIND - verticalGridSpace(nBioLayersP1) = verticalGridSpace(1) - totalCarbonContentCategory(:) = 0.0_RKIND - - - if (config_use_skeletal_biochemistry) then - - do iCategory = 1, nCategories - ! algal nitrogen - do iBioTracers = 1, nAlgae - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + skeletalAlgaeConc(iBioTracers,iCategory,iCell)* & - skeletalLayerThickness * ratio_C_to_N(iBioTracers) - enddo - - if (config_use_carbon) then - ! DOC - do iBioTracers = 1, nDOC - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + skeletalDOCConc(iBioTracers,iCategory,iCell)* & - skeletalLayerThickness - enddo - - ! DIC - do iBioTracers = 1, nDIC - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + skeletalDICConc(iBioTracers,iCategory,iCell)* & - skeletalLayerThickness - enddo - endif - - if (config_use_DON) then - ! DON - do iBioTracers = 1, nDON - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + skeletalDONConc(iBioTracers,iCategory,iCell)* & - config_ratio_C_to_N_proteins * skeletalLayerThickness - enddo - endif - - ! humic material - if (config_use_humics) & - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + skeletalHumicsConc(1,iCategory,iCell)* & - skeletalLayerThickness - enddo - elseif (config_use_vertical_tracers) then - - do iCategory = 1, nCategories - brineHeight = 0.0_RKIND - if (iceAreaCategory(iCategory,iCell) > seaicePuny) then - brineHeight = iceVolumeCategory(iCategory,iCell)/iceAreaCategory(iCategory,iCell) * brineFraction(1,iCategory,iCell) - endif - - if (config_use_vertical_biochemistry) then - iBioCount = 0 - ! algal nitrogen - do iBioTracers = 1, nAlgae - do iLayers = 1,nBioLayersP1 - iBiocount = iBiocount + 1 - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + & - verticalAlgaeConc(iBioCount,iCategory,iCell) * ratio_C_to_N(iBioTracers) * & - verticalGridSpace(iLayers) * brineHeight - enddo - iBioCount = iBioCount+2 ! snow layers - enddo - endif - - if (config_use_carbon) then - iBioCount = 0 - ! DOC - do iBioTracers = 1, nDOC - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + & - verticalDOCConc(iBioCount,iCategory,iCell) * verticalGridSpace(iLayers) * brineHeight - enddo - iBioCount = iBioCount+2 ! snow layers - enddo - iBioCount = 0 - ! DIC - do iBioTracers = 1, nDIC - - do iLayers = 1,nBioLayersP1 - iBioCount = iBioCount + 1 - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + & - verticalDICConc(iBioCount,iCategory,iCell) * verticalGridSpace(iLayers) * brineHeight - enddo - iBioCount = iBioCount + 2 ! snow layers - enddo - endif - - if (config_use_DON) then - iBioCount = 0 - ! dissolved organic nitrogen - do iBioTracers = 1, nDON - do iLayers = 1,nBioLayersP1 - iBiocount = iBiocount + 1 - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + & - verticalDONConc(iBioCount,iCategory,iCell) * config_ratio_C_to_N_proteins * & - verticalGridSpace(iLayers) * brineHeight - enddo - iBioCount = iBioCount+2 ! snow layers - enddo - endif - - ! humic material - if (config_use_humics) then - do iLayers = 1, nBioLayersP1 - totalCarbonContentCategory(iCategory) = totalCarbonContentCategory(iCategory) + & - verticalHumicsConc(iLayers,iCategory,iCell) * verticalGridSpace(iLayers) * brineHeight - enddo - endif - enddo - endif - - deallocate(ratio_C_to_N) - deallocate(verticalGridSpace) - - end subroutine seaice_total_carbon_content_category - -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| -!----------------------------------------------------------------------- -! Warning messages -!----------------------------------------------------------------------- - - subroutine column_write_warnings(logAsErrors) - - use ice_colpkg, only: colpkg_get_warnings - - character(len=strKINDWarnings), dimension(:), allocatable :: & - warnings - - logical, intent(in) :: & - logAsErrors - - integer :: & - iWarning - - call colpkg_get_warnings(warnings) - - if (logAsErrors) then - do iWarning = 1, size(warnings) - call mpas_log_write(trim(warnings(iWarning)), messageType=MPAS_LOG_ERR) - enddo ! iWarning - else - do iWarning = 1, size(warnings) - call mpas_log_write(trim(warnings(iWarning)), messageType=MPAS_LOG_WARN) - enddo ! iWarning - endif - - end subroutine column_write_warnings - -!----------------------------------------------------------------------- - -end module seaice_column diff --git a/components/mpas-seaice/src/shared/mpas_seaice_constants.F b/components/mpas-seaice/src/shared/mpas_seaice_constants.F index 6a611f64d2cf..6852084479b4 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_constants.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_constants.F @@ -6,9 +6,6 @@ !> \author Adrian K. Turner and Elizabeth Hunke, LANL !> \date 2013-2014, 2023 !> \details -!> Values in this module have been copied from the two ice_constants_colpkg.F90 -!> modules in the column physics package (in column/). They will remain -!> duplicates until the column physics package is deprecated. ! !----------------------------------------------------------------------- diff --git a/components/mpas-seaice/src/shared/mpas_seaice_forcing.F b/components/mpas-seaice/src/shared/mpas_seaice_forcing.F index 868189757005..4bbd66039cda 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_forcing.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_forcing.F @@ -35,6 +35,7 @@ module seaice_forcing post_oceanic_coupling type (MPAS_forcing_group_type), pointer, public :: seaiceForcingGroups + logical, public :: use_restart_ic ! forcing parameters real (kind=RKIND), parameter :: & @@ -1841,19 +1842,38 @@ subroutine init_atm_iron_bgc_forcing(domain, clock) forcingIntervalMonthly, & forcingReferenceTimeMonthly + type (MPAS_Time_Type) :: currTime + character(len=strKIND) :: timeStamp + integer :: ierr + ! get forcing configuration options call MPAS_pool_get_config(domain % configs, "config_do_restart", config_do_restart) + currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr) + call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr) + timeStamp = '0000'//trim(timeStamp(5:)) + ! create the dust iron solubility forcing group - call MPAS_forcing_init_group(& - seaiceForcingGroups, & - "seaice_atm_bgc_forcing_monthly", & - domain, & - '0000-01-01_00:00:00', & - '0000-01-01_00:00:00', & - '0001-00-00_00:00:00', & - config_do_restart) + if (use_restart_ic) then + call MPAS_forcing_init_group(& + seaiceForcingGroups, & + "seaice_atm_bgc_forcing_monthly", & + domain, & + '0000-01-01_00:00:00', & + '0000-01-01_00:00:00', & + '0001-00-00_00:00:00', & + .false.) + else + call MPAS_forcing_init_group(& + seaiceForcingGroups, & + "seaice_atm_bgc_forcing_monthly", & + domain, & + '0000-01-01_00:00:00', & !timeStamp, & + '0000-01-01_00:00:00', & + '0001-00-00_00:00:00', & + config_do_restart) + endif forcingIntervalMonthly = "00-01-00_00:00:00" forcingReferenceTimeMonthly = "0001-01-15_00:00:00" @@ -1862,12 +1882,12 @@ subroutine init_atm_iron_bgc_forcing(domain, clock) call MPAS_forcing_init_field(& domain % streamManager, & seaiceForcingGroups, & - 'seaice_atm_bgc_forcing_monthly', & - 'IRON_Zolubility_wet', & - 'DustIronMonthlyForcing', & - 'atmos_forcing', & - 'IRON_Zolubility_wet', & - 'linear', & + "seaice_atm_bgc_forcing_monthly", & + "IRON_Zolubility_wet", & + "DustIronMonthlyForcing", & + "atmos_forcing", & + "IRON_Zolubility_wet", & + "linear", & forcingReferenceTimeMonthly, & forcingIntervalMonthly) @@ -1875,12 +1895,12 @@ subroutine init_atm_iron_bgc_forcing(domain, clock) call MPAS_forcing_init_field(& domain % streamManager, & seaiceForcingGroups, & - 'seaice_atm_bgc_forcing_monthly', & - 'IRON_Zolubility_dry', & - 'DustIronMonthlyForcing', & - 'atmos_forcing', & - 'IRON_Zolubility_dry', & - 'linear', & + "seaice_atm_bgc_forcing_monthly", & + "IRON_Zolubility_dry", & + "DustIronMonthlyForcing", & + "atmos_forcing", & + "IRON_Zolubility_dry", & + "linear", & forcingReferenceTimeMonthly, & forcingIntervalMonthly) @@ -1888,12 +1908,12 @@ subroutine init_atm_iron_bgc_forcing(domain, clock) call MPAS_forcing_init_field(& domain % streamManager, & seaiceForcingGroups, & - 'seaice_atm_bgc_forcing_monthly', & - 'dust_FLUZ_WET', & - 'DustIronMonthlyForcing', & - 'atmos_forcing', & - 'dust_FLUZ_WET', & - 'linear', & + "seaice_atm_bgc_forcing_monthly", & + "dust_FLUZ_WET", & + "DustIronMonthlyForcing", & + "atmos_forcing", & + "dust_FLUZ_WET", & + "linear", & forcingReferenceTimeMonthly, & forcingIntervalMonthly) @@ -1901,12 +1921,12 @@ subroutine init_atm_iron_bgc_forcing(domain, clock) call MPAS_forcing_init_field(& domain % streamManager, & seaiceForcingGroups, & - 'seaice_atm_bgc_forcing_monthly', & - 'dust_FLUZ_DRY', & - 'DustIronMonthlyForcing', & - 'atmos_forcing', & - 'dust_FLUZ_DRY', & - 'linear', & + "seaice_atm_bgc_forcing_monthly", & + "dust_FLUZ_DRY", & + "DustIronMonthlyForcing", & + "atmos_forcing", & + "dust_FLUZ_DRY", & + "linear", & forcingReferenceTimeMonthly, & forcingIntervalMonthly) @@ -1914,18 +1934,18 @@ subroutine init_atm_iron_bgc_forcing(domain, clock) call MPAS_forcing_init_field(& domain % streamManager, & seaiceForcingGroups, & - 'seaice_atm_bgc_forcing_monthly', & - 'IRON_in_duzt_fraction', & - 'DustIronMonthlyForcing', & - 'atmos_forcing', & - 'IRON_in_duzt_fraction', & - 'linear', & + "seaice_atm_bgc_forcing_monthly", & + "IRON_in_duzt_fraction", & + "DustIronMonthlyForcing", & + "atmos_forcing", & + "IRON_in_duzt_fraction", & + "linear", & forcingReferenceTimeMonthly, & forcingIntervalMonthly) call MPAS_forcing_init_field_data(& seaiceForcingGroups, & - 'seaice_atm_bgc_forcing_monthly', & + "seaice_atm_bgc_forcing_monthly", & domain % streamManager, & config_do_restart, & .false.) @@ -2754,8 +2774,6 @@ subroutine prepare_oceanic_coupling_variables_ncar(block, firstTimeStep) use icepack_intfc, only: & icepack_sea_freezing_temperature - use seaice_column, only: & - seaice_column_sea_freezing_temperature type (block_type), pointer :: block @@ -2801,7 +2819,7 @@ subroutine prepare_oceanic_coupling_variables_ncar(block, firstTimeStep) call MPAS_pool_get_array(ocean_coupling, "oceanMixedLayerDepth", oceanMixedLayerDepth) call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCellsSolve ! ensure physical realism @@ -2812,18 +2830,7 @@ subroutine prepare_oceanic_coupling_variables_ncar(block, firstTimeStep) seaFreezingTemperature(iCell) = icepack_sea_freezing_temperature(seaSurfaceSalinity(iCell)) enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - do iCell = 1, nCellsSolve - - ! ensure physical realism - seaSurfaceSalinity(iCell) = max(seaSurfaceSalinity(iCell), 0.0_RKIND) - oceanMixedLayerDepth(iCell) = max(oceanMixedLayerDepth(iCell), 0.0_RKIND) - - ! sea freezing temperature - seaFreezingTemperature(iCell) = seaice_column_sea_freezing_temperature(seaSurfaceSalinity(iCell)) - - enddo ! iCell - endif ! config_column_physics_type +! endif ! config_column_physics_type ! only update sea surface temperature on first non-restart timestep if (firstTimeStep .and. .not. config_do_restart) then @@ -2853,9 +2860,6 @@ end subroutine prepare_oceanic_coupling_variables_ncar subroutine prepare_oceanic_coupling_variables_ISPOL(block, firstTimeStep) - use ice_colpkg, only: & - colpkg_sea_freezing_temperature - use icepack_intfc, only: & icepack_sea_freezing_temperature @@ -2902,7 +2906,7 @@ subroutine prepare_oceanic_coupling_variables_ISPOL(block, firstTimeStep) call MPAS_pool_get_array(ocean_coupling, "oceanMixedLayerDepth", oceanMixedLayerDepth) call MPAS_pool_get_array(ocean_coupling, "seaFreezingTemperature", seaFreezingTemperature) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCellsSolve ! ensure physical realism @@ -2913,18 +2917,7 @@ subroutine prepare_oceanic_coupling_variables_ISPOL(block, firstTimeStep) seaFreezingTemperature(iCell) = icepack_sea_freezing_temperature(seaSurfaceSalinity(iCell)) enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - do iCell = 1, nCellsSolve - - ! ensure physical realism - seaSurfaceSalinity(iCell) = max(seaSurfaceSalinity(iCell), 0.0_RKIND) - oceanMixedLayerDepth(iCell) = max(oceanMixedLayerDepth(iCell), 0.0_RKIND) - - ! sea freezing temperature - seaFreezingTemperature(iCell) = colpkg_sea_freezing_temperature(seaSurfaceSalinity(iCell)) - - enddo ! iCell - endif ! config_column_physics_type +! endif ! config_column_physics_type ! only update sea surface temperature on first non-restart timestep if (firstTimeStep .and. .not. config_do_restart) then @@ -3305,7 +3298,8 @@ end subroutine data_iceberg_forcing subroutine get_data_iceberg_fluxes(domain) use seaice_constants, only: & - seaiceLatentHeatMelting ! latent heat of melting of fresh ice (J/kg) + seaiceLatentHeatMelting, & ! latent heat of melting of fresh ice (J/kg) + seaiceFreshIceSpecificHeat ! specific heat of fresh ice (J/kg/K) type(domain_type), intent(inout) :: & domain @@ -3330,6 +3324,7 @@ subroutine get_data_iceberg_fluxes(domain) bergLatentHeatFlux ! iceberg latent heat flux for ocean (J/m^2/s) real(kind=RKIND), pointer :: & + bergTemperature, & ! iceberg temperature areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux, & ! area integrated, annual mean freshwater flux from icebegs and ice shelves (kg/s) runningMeanRemovedIceRunoff ! the area integrated, running mean of removed ice runoff (kg/s) @@ -3339,11 +3334,8 @@ subroutine get_data_iceberg_fluxes(domain) real(kind=RKIND) :: & scaling - ! dc including as parameters here so as not to create new namelist options - real(kind=RKIND), parameter :: & - specificHeatFreshIce = 2106.0_RKIND, & ! specific heat of fresh ice J * kg^-1 * K^-1 - bergTemperature = -4.0_RKIND ! iceberg temperature, assumed constant - + call MPAS_pool_get_config(domain % configs, "config_iceberg_temperature", & + bergTemperature) call MPAS_pool_get_config(domain % configs, "config_scale_dib_by_removed_ice_runoff", & config_scale_dib_by_removed_ice_runoff) @@ -3376,8 +3368,7 @@ subroutine get_data_iceberg_fluxes(domain) bergFreshwaterFlux(iCell) = scaling * bergFreshwaterFluxData(iCell) bergLatentHeatFlux(iCell) = -scaling * bergFreshwaterFluxData(iCell) * & - (seaiceLatentHeatMelting - specificHeatFreshIce*bergTemperature) - + (seaiceLatentHeatMelting - seaiceFreshIceSpecificHeat*bergTemperature) enddo block => block % next diff --git a/components/mpas-seaice/src/shared/mpas_seaice_icepack.F b/components/mpas-seaice/src/shared/mpas_seaice_icepack.F index f22b9a5afded..b76b03fd4400 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_icepack.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_icepack.F @@ -142,7 +142,6 @@ module seaice_icepack index_nonreactiveConc, & ! nt_bgc_PON index_humicsConc, & ! nt_bgc_hum index_mobileFraction, & ! nt_zbgc_frac - index_verticalSalinity, & ! nt_bgc_S index_chlorophyllShortwave, & ! nlt_chl_sw index_nitrateConcLayer, & ! nlt_bgc_Nit index_ammoniumConcLayer, & ! nlt_bgc_Am @@ -5781,7 +5780,6 @@ subroutine init_column_tracer_object_tracer_number(domain, tracerObject) config_use_aerosols, & config_use_brine, & config_use_column_biogeochemistry, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_biochemistry, & config_use_vertical_tracers, & config_use_skeletal_biochemistry, & @@ -5829,7 +5827,6 @@ subroutine init_column_tracer_object_tracer_number(domain, tracerObject) call MPAS_pool_get_config(domain % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) -! call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) call MPAS_pool_get_config(domain % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) @@ -5926,12 +5923,6 @@ subroutine init_column_tracer_object_tracer_number(domain, tracerObject) if (config_use_brine) & tracerObject % nTracers = tracerObject % nTracers + 1 - ! vertical zSalinity !echmod deprecate -! if (config_use_vertical_zsalinity) then -! tracerObject % nTracers = tracerObject % nTracers + nBioLayers -! tracerObject % nBioTracersLayer = tracerObject % nBioTracersLayer + 1 -! endif - nMobileTracers = 0 ! Skeletal Biogeochemistry @@ -7375,7 +7366,6 @@ subroutine set_cice_biogeochemistry_tracer_array_category(block, tracerObject, t logical, pointer :: & config_use_skeletal_biochemistry, & config_use_vertical_biochemistry, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_tracers, & config_use_brine, & config_use_nitrate, & @@ -7433,7 +7423,6 @@ subroutine set_cice_biogeochemistry_tracer_array_category(block, tracerObject, t verticalParticulateIronConc, & verticalDissolvedIronConc, & verticalAerosolsConc, & - verticalSalinity, & brineFraction, & mobileFraction @@ -7443,7 +7432,6 @@ subroutine set_cice_biogeochemistry_tracer_array_category(block, tracerObject, t iLayers call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) -! call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) @@ -7499,7 +7487,6 @@ subroutine set_cice_biogeochemistry_tracer_array_category(block, tracerObject, t call MPAS_pool_get_array(tracers, "verticalParticulateIronConc", verticalParticulateIronConc, 1) call MPAS_pool_get_array(tracers, "verticalDissolvedIronConc", verticalDissolvedIronConc, 1) call MPAS_pool_get_array(tracers, "verticalAerosolsConc", verticalAerosolsConc, 1) - call MPAS_pool_get_array(tracers, "verticalSalinity", verticalSalinity, 1) call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) call MPAS_pool_get_array(tracers, "mobileFraction", mobileFraction, 1) @@ -7706,14 +7693,6 @@ subroutine set_cice_biogeochemistry_tracer_array_category(block, tracerObject, t enddo enddo endif - - ! salinity used with BL99 thermodynamics !echmod deprecate -! if (config_use_vertical_zsalinity) then -! do iLayers = 1, nBioLayers -! tracerArrayCategory(tracerObject % index_verticalSalinity+iLayers-1,:) = & -! verticalSalinity(iLayers,:,iCell) -! enddo -! endif endif end subroutine set_cice_biogeochemistry_tracer_array_category @@ -7747,7 +7726,6 @@ subroutine get_cice_biogeochemistry_tracer_array_category(block, tracerObject, t logical, pointer :: & config_use_skeletal_biochemistry, & config_use_vertical_biochemistry, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_tracers, & config_use_brine, & config_use_nitrate, & @@ -7805,7 +7783,6 @@ subroutine get_cice_biogeochemistry_tracer_array_category(block, tracerObject, t verticalParticulateIronConc, & verticalDissolvedIronConc, & verticalAerosolsConc, & - verticalSalinity, & brineFraction, & mobileFraction @@ -7816,7 +7793,6 @@ subroutine get_cice_biogeochemistry_tracer_array_category(block, tracerObject, t call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) -! call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) @@ -7871,7 +7847,6 @@ subroutine get_cice_biogeochemistry_tracer_array_category(block, tracerObject, t call MPAS_pool_get_array(tracers, "verticalParticulateIronConc", verticalParticulateIronConc, 1) call MPAS_pool_get_array(tracers, "verticalDissolvedIronConc", verticalDissolvedIronConc, 1) call MPAS_pool_get_array(tracers, "verticalAerosolsConc", verticalAerosolsConc, 1) - call MPAS_pool_get_array(tracers, "verticalSalinity", verticalSalinity, 1) call MPAS_pool_get_array(tracers, "brineFraction", brineFraction, 1) call MPAS_pool_get_array(tracers, "mobileFraction", mobileFraction, 1) @@ -8086,14 +8061,6 @@ subroutine get_cice_biogeochemistry_tracer_array_category(block, tracerObject, t enddo enddo endif - - ! salinity used with BL99 thermodynamics !echmod deprecate -! if (config_use_vertical_zsalinity) then -! do iLayers = 1, nBioLayers -! verticalSalinity(iLayers,:,iCell) = & -! tracerArrayCategory(tracerObject % index_verticalSalinity+iLayers-1,:) -! enddo -! endif endif end subroutine get_cice_biogeochemistry_tracer_array_category @@ -8127,7 +8094,6 @@ subroutine set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace logical, pointer :: & config_use_skeletal_biochemistry, & config_use_vertical_biochemistry, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_tracers, & config_use_brine, & config_use_nitrate, & @@ -8189,7 +8155,6 @@ subroutine set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace verticalParticulateIronConcCell, & verticalDissolvedIronConcCell, & verticalAerosolsConcCell, & - verticalSalinityCell, & verticalAlgaeIceCell, & verticalDOCIceCell, & verticalDICIceCell, & @@ -8216,7 +8181,6 @@ subroutine set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) -! call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) @@ -8287,7 +8251,6 @@ subroutine set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace call MPAS_pool_get_array(tracers_aggregate, "verticalParticulateIronIceCell", verticalParticulateIronIceCell) call MPAS_pool_get_array(tracers_aggregate, "verticalDissolvedIronIceCell", verticalDissolvedIronIceCell) call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsIceCell", verticalAerosolsIceCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSalinityCell", verticalSalinityCell) call MPAS_pool_get_array(tracers_aggregate, "brineFractionCell", brineFractionCell) ! biogeochemistry @@ -8579,13 +8542,6 @@ subroutine set_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace enddo enddo endif - - ! salinity used with BL99 thermodynamics !echmod deprecate -! if (config_use_vertical_zsalinity) then -! do iLayers = 1, nBioLayers -! tracerArrayCell(tracerObject % index_verticalSalinity+iLayers-1) = verticalSalinityCell(iLayers,iCell) -! enddo -! endif endif end subroutine set_cice_biogeochemistry_tracer_array_cell @@ -8619,7 +8575,6 @@ subroutine get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace logical, pointer :: & config_use_skeletal_biochemistry, & config_use_vertical_biochemistry, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_tracers, & config_use_brine, & config_use_nitrate, & @@ -8684,7 +8639,6 @@ subroutine get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace verticalParticulateIronConcCell, & verticalDissolvedIronConcCell, & verticalAerosolsConcCell, & - verticalSalinityCell, & verticalAlgaeIceCell, & verticalDOCIceCell, & verticalDICIceCell, & @@ -8718,7 +8672,6 @@ subroutine get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace call MPAS_pool_get_config(block % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) call MPAS_pool_get_config(block % configs, "config_use_vertical_biochemistry", config_use_vertical_biochemistry) -! call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(block % configs, "config_use_brine", config_use_brine) call MPAS_pool_get_config(block % configs, "config_use_nitrate", config_use_nitrate) @@ -8791,7 +8744,6 @@ subroutine get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace call MPAS_pool_get_array(tracers_aggregate, "verticalDissolvedIronIceCell", verticalDissolvedIronIceCell) call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsIceCell", verticalAerosolsIceCell) call MPAS_pool_get_array(tracers_aggregate, "verticalAerosolsSnowCell", verticalAerosolsSnowCell) - call MPAS_pool_get_array(tracers_aggregate, "verticalSalinityCell", verticalSalinityCell) call MPAS_pool_get_array(tracers_aggregate, "brineFractionCell", brineFractionCell) call MPAS_pool_get_array(tracers_aggregate, "verticalAlgaeTotalCarbonIceCell", verticalAlgaeTotalCarbonIceCell) call MPAS_pool_get_array(tracers_aggregate, "verticalDOCLabileIceCell", verticalDOCLabileIceCell) @@ -9116,13 +9068,6 @@ subroutine get_cice_biogeochemistry_tracer_array_cell(block, tracerObject, trace enddo enddo endif - - ! salinity used with BL99 thermodynamics !echmod deprecate -! if (config_use_vertical_zsalinity) then -! do iLayers = 1, nBioLayers -! verticalSalinityCell(iLayers,iCell) = tracerArrayCell(tracerObject % index_verticalSalinity+iLayers-1) -! enddo -! endif endif end subroutine get_cice_biogeochemistry_tracer_array_cell @@ -9484,11 +9429,9 @@ subroutine check_column_package_configs(domain) config_calc_surface_temperature, & config_use_form_drag, & config_use_level_ice, & - config_use_cesm_meltponds, & ! deprecated config_use_level_meltponds, & config_use_topo_meltponds, & config_include_pond_freshwater_feedback, & - config_use_vertical_zsalinity, & ! deprecated config_use_brine, & config_use_vertical_tracers, & config_use_vertical_biochemistry, & @@ -9546,14 +9489,12 @@ subroutine check_column_package_configs(domain) call MPAS_pool_get_config(domain % configs, "config_snow_to_ice_transition_depth", config_snow_to_ice_transition_depth) call MPAS_pool_get_config(domain % configs, "config_use_form_drag", config_use_form_drag) call MPAS_pool_get_config(domain % configs, "config_use_level_ice", config_use_level_ice) - call MPAS_pool_get_config(domain % configs, "config_use_cesm_meltponds", config_use_cesm_meltponds) ! deprecated call MPAS_pool_get_config(domain % configs, "config_use_level_meltponds", config_use_level_meltponds) call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) call MPAS_pool_get_config(domain % configs, "config_include_pond_freshwater_feedback", config_include_pond_freshwater_feedback) call MPAS_pool_get_config(domain % configs, "config_ocean_heat_transfer_type", config_ocean_heat_transfer_type) call MPAS_pool_get_config(domain % configs, "config_sea_freezing_temperature_type", config_sea_freezing_temperature_type) call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) - call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) ! deprecated call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) @@ -9583,27 +9524,6 @@ subroutine check_column_package_configs(domain) ! Check values !----------------------------------------------------------------------- - ! deprecate cesm ponds - if (config_use_cesm_meltponds) then - call mpas_log_write(& - "check_column_package_configs: config_use_cesm_meltponds = .true. but cesm ponds have been deprecated", & - messageType=MPAS_LOG_CRIT) - endif - - ! deprecate vertical zSalinity - if (config_use_vertical_zsalinity) then - call mpas_log_write(& - "check_column_package_configs: config_use_vertical_zsalinity = .true. but vertical zSalinity has been deprecated", & - messageType=MPAS_LOG_CRIT) - endif - - ! deprecate 0-layer thermo - if (trim(config_thermodynamics_type(1:4)) == "zero") then - call mpas_log_write(& - "check_column_package_configs: config_thermodynamics_type) = zero layer but 0-layer thermo has been deprecated", & - messageType=MPAS_LOG_WARN) - endif - ! check config_thermodynamics_type value if (.not. (trim(config_thermodynamics_type) == "BL99" .or. & trim(config_thermodynamics_type) == "mushy")) then @@ -9929,7 +9849,6 @@ subroutine init_icepack_package_tracer_flags(domain) config_use_topo_meltponds, & config_use_aerosols, & config_use_brine, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_zaerosols, & config_use_nitrate, & config_use_DON, & @@ -9957,7 +9876,6 @@ subroutine init_icepack_package_tracer_flags(domain) call MPAS_pool_get_config(domain % configs, "config_use_topo_meltponds", config_use_topo_meltponds) call MPAS_pool_get_config(domain % configs, "config_use_aerosols", config_use_aerosols) call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) -! call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(domain % configs, "config_use_zaerosols", config_use_zaerosols) call MPAS_pool_get_config(domain % configs, "config_use_nitrate", config_use_nitrate) call MPAS_pool_get_config(domain % configs, "config_use_DON", config_use_DON) @@ -10158,7 +10076,6 @@ subroutine init_icepack_package_tracer_indices(tracerObject) nlt_bgc_hum_in = tracerObject % index_humicsConcLayer, & nlt_bgc_PON_in = tracerObject % index_nonreactiveConcLayer, & nt_zbgc_frac_in = tracerObject % index_mobileFraction, & - nt_bgc_S_in = tracerObject % index_verticalSalinity, & ! name change nt_zbgc_S->nt_bgc_S_in nlt_chl_sw_in = tracerObject % index_chlorophyllShortwave, & nlt_zaero_sw_in = tracerObject % index_verticalAerosolsConcShortwave, & bio_index_o_in = tracerObject % index_LayerIndexToDataArray, & @@ -11345,11 +11262,6 @@ subroutine init_icepack_package_configs(domain) ! if true, solve skeletal biochemistry !skl_bgc = config_use_skeletal_biochemistry -! zsalinity has been deprecated -! ! solve_zsal: -! ! if true, update salinity profile from solve_S_dt -! !solve_zsal = config_use_vertical_zsalinity - ! modal_aero: ! if true, use modal aerosal optical properties ! only for use with tr_aero or tr_zaero @@ -12277,9 +12189,6 @@ subroutine init_icepack_non_activated_pointers(domain) call set_stand_in_tracer_array(block, "verticalAerosolsSnow") call set_stand_in_tracer_array(block, "verticalAerosolsIce") endif -! if (.not. pkgTracerZSalinityActive) then !echmod - deprecate -! call set_stand_in_tracer_array(block, "verticalSalinity") -! endif ! snow density tracer if (.not. pkgColumnTracerEffectiveSnowDensityActive) then @@ -12607,9 +12516,6 @@ subroutine finalize_icepack_non_activated_pointers(domain) call finalize_stand_in_tracer_array(block, "verticalAerosolsSnow") call finalize_stand_in_tracer_array(block, "verticalAerosolsIce") endif -! if (.not. pkgTracerZSalinityActive) then !echmod deprecate -! call finalize_stand_in_tracer_array(block, "verticalSalinity") -! endif ! snow density tracer if (.not. pkgColumnTracerEffectiveSnowDensityActive) then @@ -13017,7 +12923,6 @@ subroutine init_column_tracer_object_for_biogeochemistry(domain, tracerObject) logical, pointer :: & config_use_brine, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_biochemistry, & config_use_vertical_tracers, & config_use_skeletal_biochemistry, & @@ -13176,7 +13081,6 @@ subroutine init_column_tracer_object_for_biogeochemistry(domain, tracerObject) tracerObject % nTracers = tracerObject % nTracersNotBio call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) -! call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) @@ -13547,7 +13451,6 @@ subroutine init_zbgc_tracer_indices(domain, tracerObject, use_nitrogen, nTracers logical, pointer :: & config_use_brine, & -! config_use_vertical_zsalinity, & !echmod deprecate config_use_vertical_biochemistry, & config_use_vertical_tracers, & config_use_skeletal_biochemistry, & @@ -13632,7 +13535,6 @@ subroutine init_zbgc_tracer_indices(domain, tracerObject, use_nitrogen, nTracers zAeroType call MPAS_pool_get_config(domain % configs, "config_use_brine", config_use_brine) -! call MPAS_pool_get_config(domain % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) !echmod deprecate call MPAS_pool_get_config(domain % configs, "config_use_shortwave_bioabsorption", config_use_shortwave_bioabsorption) call MPAS_pool_get_config(domain % configs, "config_use_vertical_tracers", config_use_vertical_tracers) call MPAS_pool_get_config(domain % configs, "config_use_skeletal_biochemistry", config_use_skeletal_biochemistry) @@ -15019,8 +14921,6 @@ subroutine seaice_icepack_reinitialize_diagnostics_bgc(domain) primaryProduction, & netSpecificAlgalGrowthRate, & netBrineHeight, & -! zSalinityFlux, & !echmod deprecate -! zSalinityGDFlux, & !echmod deprecate totalChlorophyll, & totalCarbonContentCell, & totalVerticalDiatomIce, & @@ -15075,7 +14975,6 @@ subroutine seaice_icepack_reinitialize_diagnostics_bgc(domain) config_use_column_shortwave, & config_use_column_physics, & config_use_vertical_tracers, & -! config_use_vertical_zsalinity, & config_use_zaerosols call MPAS_pool_get_config(domain % blocklist % configs, "config_use_column_physics", config_use_column_physics) @@ -15089,7 +14988,6 @@ subroutine seaice_icepack_reinitialize_diagnostics_bgc(domain) call MPAS_pool_get_config(block % configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) call MPAS_pool_get_config(block % configs, "config_use_zaerosols", config_use_zaerosols) call MPAS_pool_get_config(block % configs, "config_use_vertical_tracers", config_use_vertical_tracers) -! call MPAS_pool_get_config(block % configs, "config_use_vertical_zsalinity", config_use_vertical_zsalinity) if (config_use_column_biogeochemistry .or. config_use_zaerosols) then @@ -15098,101 +14996,106 @@ subroutine seaice_icepack_reinitialize_diagnostics_bgc(domain) call MPAS_pool_get_subpool(block % structs, "tracers_aggregate", tracers_aggregatePool) if (config_use_vertical_tracers) then - call MPAS_pool_get_array(biogeochemistryPool, "primaryProduction", primaryProduction) - call MPAS_pool_get_array(biogeochemistryPool, "totalChlorophyll", totalChlorophyll) - call MPAS_pool_get_array(biogeochemistryPool, "netSpecificAlgalGrowthRate", netSpecificAlgalGrowthRate) call MPAS_pool_get_array(diagnostics_biogeochemistryPool, "bgridSalinityIceCell", bgridSalinityIceCell) call MPAS_pool_get_array(diagnostics_biogeochemistryPool, "bgridPorosityIceCell", bgridPorosityIceCell) call MPAS_pool_get_array(diagnostics_biogeochemistryPool, "bgridTemperatureIceCell", bgridTemperatureIceCell) - primaryProduction = 0.0_RKIND - totalChlorophyll = 0.0_RKIND - netSpecificAlgalGrowthRate = 0.0_RKIND + call MPAS_pool_get_array(biogeochemistryPool, "netBrineHeight", netBrineHeight) + call MPAS_pool_get_array(biogeochemistryPool, "oceanBioFluxes", oceanBioFluxes) + call MPAS_pool_get_array(biogeochemistryPool, "atmosIceBioFluxes", atmosIceBioFluxes) + call MPAS_pool_get_array(biogeochemistryPool, "snowIceBioFluxes", snowIceBioFluxes) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBiologyIce", totalVerticalBiologyIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBiologySnow", totalVerticalBiologySnow) + call MPAS_pool_get_array(biogeochemistryPool, "totalCarbonContentCell", totalCarbonContentCell) + bgridSalinityIceCell = 0.0_RKIND bgridPorosityIceCell = 0.0_RKIND bgridTemperatureIceCell = 0.0_RKIND + netBrineHeight = 0.0_RKIND + oceanBioFluxes = 0.0_RKIND + atmosIceBioFluxes = 0.0_RKIND + snowIceBioFluxes = 0.0_RKIND + totalVerticalBiologyIce = 0.0_RKIND + totalVerticalBiologySnow = 0.0_RKIND + totalCarbonContentCell = 0.0_RKIND + end if + if (config_use_column_biogeochemistry) then + call MPAS_pool_get_array(biogeochemistryPool, "primaryProduction", primaryProduction) + call MPAS_pool_get_array(biogeochemistryPool, "totalChlorophyll", totalChlorophyll) + call MPAS_pool_get_array(biogeochemistryPool, "netSpecificAlgalGrowthRate", netSpecificAlgalGrowthRate) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDiatomIce", totalVerticalDiatomIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalSmallPlanktonIce", totalVerticalSmallPlanktonIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalPhaeocystisIce", totalVerticalPhaeocystisIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalPolysaccharidsIce", totalVerticalPolysaccharidsIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalLipidsIce", totalVerticalLipidsIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDICIce", totalVerticalDICIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalProteinsIce", totalVerticalProteinsIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalNitrateIce", totalVerticalNitrateIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalSilicateIce", totalVerticalSilicateIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalAmmoniumIce", totalVerticalAmmoniumIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDMSIce", totalVerticalDMSIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDMSPpIce", totalVerticalDMSPpIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDMSPdIce", totalVerticalDMSPdIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalNonreactiveIce", totalVerticalNonreactiveIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalHumicsIce", totalVerticalHumicsIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalParticulateIronIce", totalVerticalParticulateIronIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDissolvedIronIce", totalVerticalDissolvedIronIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDissolvedIronSnow", totalVerticalDissolvedIronSnow) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalAlgaeCarbonIce", totalVerticalAlgaeCarbonIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDOCLabileIce", totalVerticalDOCLabileIce) + + primaryProduction = 0.0_RKIND + totalChlorophyll = 0.0_RKIND + netSpecificAlgalGrowthRate = 0.0_RKIND + totalVerticalDiatomIce = 0.0_RKIND + totalVerticalSmallPlanktonIce = 0.0_RKIND + totalVerticalPhaeocystisIce = 0.0_RKIND + totalVerticalPolysaccharidsIce = 0.0_RKIND + totalVerticalLipidsIce = 0.0_RKIND + totalVerticalDICIce = 0.0_RKIND + totalVerticalProteinsIce = 0.0_RKIND + totalVerticalNitrateIce = 0.0_RKIND + totalVerticalSilicateIce = 0.0_RKIND + totalVerticalAmmoniumIce = 0.0_RKIND + totalVerticalDMSIce = 0.0_RKIND + totalVerticalDMSPpIce = 0.0_RKIND + totalVerticalDMSPdIce = 0.0_RKIND + totalVerticalNonreactiveIce = 0.0_RKIND + totalVerticalHumicsIce = 0.0_RKIND + totalVerticalParticulateIronIce= 0.0_RKIND + totalVerticalDissolvedIronIce = 0.0_RKIND + totalVerticalDissolvedIronSnow = 0.0_RKIND + totalVerticalAlgaeCarbonIce = 0.0_RKIND + totalVerticalDOCLabileIce = 0.0_RKIND end if - call MPAS_pool_get_array(biogeochemistryPool, "netBrineHeight", netBrineHeight) - call MPAS_pool_get_array(biogeochemistryPool, "oceanBioFluxes", oceanBioFluxes) - call MPAS_pool_get_array(biogeochemistryPool, "atmosIceBioFluxes", atmosIceBioFluxes) - call MPAS_pool_get_array(biogeochemistryPool, "snowIceBioFluxes", snowIceBioFluxes) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBiologyIce", totalVerticalBiologyIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBiologySnow", totalVerticalBiologySnow) - call MPAS_pool_get_array(biogeochemistryPool, "totalCarbonContentCell", totalCarbonContentCell) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDiatomIce", totalVerticalDiatomIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalSmallPlanktonIce", totalVerticalSmallPlanktonIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalPhaeocystisIce", totalVerticalPhaeocystisIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalPolysaccharidsIce", totalVerticalPolysaccharidsIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalLipidsIce", totalVerticalLipidsIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDICIce", totalVerticalDICIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalProteinsIce", totalVerticalProteinsIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalNitrateIce", totalVerticalNitrateIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalSilicateIce", totalVerticalSilicateIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalAmmoniumIce", totalVerticalAmmoniumIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDMSIce", totalVerticalDMSIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDMSPpIce", totalVerticalDMSPpIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDMSPdIce", totalVerticalDMSPdIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalNonreactiveIce", totalVerticalNonreactiveIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalHumicsIce", totalVerticalHumicsIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalParticulateIronIce", totalVerticalParticulateIronIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDissolvedIronIce", totalVerticalDissolvedIronIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDissolvedIronSnow", totalVerticalDissolvedIronSnow) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDustIce", totalVerticalDustIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDustSnow", totalVerticalDustSnow) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC1Ice", totalVerticalBC1Ice) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC1Snow", totalVerticalBC1Snow) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC2Ice", totalVerticalBC2Ice) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC2Snow", totalVerticalBC2Snow) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBCIce", totalVerticalBCIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBCSnow", totalVerticalBCSnow) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalAlgaeCarbonIce", totalVerticalAlgaeCarbonIce) - call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDOCLabileIce", totalVerticalDOCLabileIce) - call MPAS_pool_get_array(tracers_aggregatePool, "verticalBCTotalIceCell", verticalBCTotalIceCell) - call MPAS_pool_get_array(tracers_aggregatePool, "verticalDustTotalIceCell", verticalDustTotalIceCell) - call MPAS_pool_get_array(tracers_aggregatePool, "verticalDustTotalSnowCell", verticalDustTotalSnowCell) - call MPAS_pool_get_array(tracers_aggregatePool, "verticalBCTotalSnowCell", verticalBCTotalSnowCell) - - - netBrineHeight = 0.0_RKIND - oceanBioFluxes = 0.0_RKIND - atmosIceBioFluxes = 0.0_RKIND - snowIceBioFluxes = 0.0_RKIND - totalVerticalBiologyIce = 0.0_RKIND - totalVerticalBiologySnow = 0.0_RKIND - totalCarbonContentCell = 0.0_RKIND - totalVerticalDiatomIce = 0.0_RKIND - totalVerticalSmallPlanktonIce = 0.0_RKIND - totalVerticalPhaeocystisIce = 0.0_RKIND - totalVerticalPolysaccharidsIce = 0.0_RKIND - totalVerticalLipidsIce = 0.0_RKIND - totalVerticalDICIce = 0.0_RKIND - totalVerticalProteinsIce = 0.0_RKIND - totalVerticalNitrateIce = 0.0_RKIND - totalVerticalSilicateIce = 0.0_RKIND - totalVerticalAmmoniumIce = 0.0_RKIND - totalVerticalDMSIce = 0.0_RKIND - totalVerticalDMSPpIce = 0.0_RKIND - totalVerticalDMSPdIce = 0.0_RKIND - totalVerticalNonreactiveIce = 0.0_RKIND - totalVerticalHumicsIce = 0.0_RKIND - totalVerticalParticulateIronIce = 0.0_RKIND - totalVerticalDissolvedIronIce = 0.0_RKIND - totalVerticalDissolvedIronSnow = 0.0_RKIND - totalVerticalBC1Ice = 0.0_RKIND - totalVerticalBC2Ice = 0.0_RKIND - totalVerticalDustIce = 0.0_RKIND - totalVerticalBC1Snow = 0.0_RKIND - totalVerticalBC2Snow = 0.0_RKIND - totalVerticalBCSnow = 0.0_RKIND - totalVerticalBCIce = 0.0_RKIND - totalVerticalDustSnow = 0.0_RKIND - totalVerticalAlgaeCarbonIce = 0.0_RKIND - totalVerticalDOCLabileIce = 0.0_RKIND - verticalBCTotalIceCell = 0.0_RKIND - verticalDustTotalIceCell = 0.0_RKIND - verticalBCTotalSnowCell = 0.0_RKIND - verticalDustTotalSnowCell = 0.0_RKIND + if (config_use_zaerosols) then + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDustIce", totalVerticalDustIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalDustSnow", totalVerticalDustSnow) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC1Ice", totalVerticalBC1Ice) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC1Snow", totalVerticalBC1Snow) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC2Ice", totalVerticalBC2Ice) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBC2Snow", totalVerticalBC2Snow) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBCIce", totalVerticalBCIce) + call MPAS_pool_get_array(biogeochemistryPool, "totalVerticalBCSnow", totalVerticalBCSnow) + call MPAS_pool_get_array(tracers_aggregatePool, "verticalBCTotalIceCell", verticalBCTotalIceCell) + call MPAS_pool_get_array(tracers_aggregatePool, "verticalDustTotalIceCell", verticalDustTotalIceCell) + call MPAS_pool_get_array(tracers_aggregatePool, "verticalDustTotalSnowCell", verticalDustTotalSnowCell) + call MPAS_pool_get_array(tracers_aggregatePool, "verticalBCTotalSnowCell", verticalBCTotalSnowCell) + + totalVerticalBC1Ice = 0.0_RKIND + totalVerticalBC2Ice = 0.0_RKIND + totalVerticalDustIce = 0.0_RKIND + totalVerticalBC1Snow = 0.0_RKIND + totalVerticalBC2Snow = 0.0_RKIND + totalVerticalBCSnow = 0.0_RKIND + totalVerticalBCIce = 0.0_RKIND + totalVerticalDustSnow = 0.0_RKIND + verticalBCTotalIceCell = 0.0_RKIND + verticalDustTotalIceCell = 0.0_RKIND + verticalBCTotalSnowCell = 0.0_RKIND + verticalDustTotalSnowCell = 0.0_RKIND + endif endif diff --git a/components/mpas-seaice/src/shared/mpas_seaice_initialize.F b/components/mpas-seaice/src/shared/mpas_seaice_initialize.F index 2e476aea5209..2a4510bea396 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_initialize.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_initialize.F @@ -57,10 +57,6 @@ subroutine seaice_init(& seaice_init_icepack_constants, & seaice_init_icepack_physics_package_parameters, & seaice_init_icepack_physics_package_variables - use seaice_column, only: & - seaice_init_column_constants, & - seaice_init_column_physics_package_parameters, & - seaice_init_column_physics_package_variables use seaice_forcing, only: seaice_forcing_init, seaice_reset_coupler_fluxes use seaice_diagnostics, only: & seaice_set_testing_system_test_arrays @@ -97,8 +93,6 @@ subroutine seaice_init(& ! set column constants if (trim(config_column_physics_type) == "icepack") then call seaice_init_icepack_constants() - else if (trim(config_column_physics_type) == "column_package") then - call seaice_init_column_constants() else call MPAS_log_write("Unknown config_column_physics_type: "//trim(config_column_physics_type), MPAS_LOG_CRIT) endif ! config_column_physics_type @@ -127,11 +121,9 @@ subroutine seaice_init(& ! init the basic column physics package call mpas_log_write(" Initialize column parameters...") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_init_icepack_physics_package_parameters(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_init_column_physics_package_parameters(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type ! init coupler fluxes call mpas_log_write(" Initialize coupler fields...") @@ -153,11 +145,9 @@ subroutine seaice_init(& ! column physics initialization call mpas_log_write(" Initialize column variables...") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_init_icepack_physics_package_variables(domain, clock) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_init_column_physics_package_variables(domain, clock) - endif ! config_column_physics_type +! endif ! config_column_physics_type ! init ice state call mpas_log_write(" Initialize ice state...") @@ -197,8 +187,6 @@ subroutine seaice_init_post_clock_advance(& use seaice_icepack, only: & seaice_init_icepack_shortwave - use seaice_column, only: & - seaice_init_column_shortwave type(domain_type), intent(inout) :: & domain !< Input/Output: @@ -220,11 +208,9 @@ subroutine seaice_init_post_clock_advance(& call MPAS_pool_get_config(domain % configs, "config_column_physics_type", config_column_physics_type) if (config_use_column_physics .and. config_use_column_shortwave .and. .not. config_do_restart) then - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_init_icepack_shortwave(domain, clock) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_init_column_shortwave(domain, clock) - endif ! config_column_physics_type +! endif ! config_column_physics_type endif end subroutine seaice_init_post_clock_advance @@ -303,8 +289,6 @@ subroutine init_ice_state(& seaice_init_square_point_test_case_hex use seaice_icepack, only: & seaice_icepack_aggregate - use seaice_column, only: & - seaice_column_aggregate type(domain_type), intent(inout) :: & domain !< Input/Output: @@ -503,11 +487,9 @@ subroutine init_ice_state(& call MPAS_pool_get_config(domain % blocklist % configs, "config_use_column_physics", config_use_column_physics) call MPAS_pool_get_config(domain % blocklist % configs, "config_column_physics_type", config_column_physics_type) if (config_use_column_physics) then - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_aggregate(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_aggregate(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type endif end subroutine init_ice_state!}}} @@ -643,10 +625,6 @@ subroutine init_ice_state_uniform_1D(& use seaice_constants, only: & seaiceDegreesToRadians - use ice_colpkg, only: & - colpkg_init_trcr, & - colpkg_enthalpy_snow - use icepack_intfc, only: & icepack_init_enthalpy, & icepack_enthalpy_snow, & @@ -763,7 +741,7 @@ subroutine init_ice_state_uniform_1D(& surfaceTemperature(1,:,iCell) = seaFreezingTemperature(iCell) iceEnthalpy(:,:,iCell) = 0.0_RKIND - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iSnowLayer = 1, nSnowLayers snowEnthalpy(iSnowLayer,:,iCell) = icepack_enthalpy_snow(0.0_RKIND) @@ -789,34 +767,7 @@ subroutine init_ice_state_uniform_1D(& call seaice_icepack_write_warnings(icepack_warnings_aborted()) endif - else if (trim(config_column_physics_type) == "column_package") then - - do iSnowLayer = 1, nSnowLayers - snowEnthalpy(iSnowLayer,:,iCell) = colpkg_enthalpy_snow(0.0_RKIND) - end do - - if (latCell(iCell) > config_initial_latitude_north * seaiceDegreesToRadians .or. & - latCell(iCell) < config_initial_latitude_south * seaiceDegreesToRadians) then - - ! has ice - iceAreaCategory(1,1,iCell) = config_initial_ice_area - iceVolumeCategory(1,1,iCell) = config_initial_ice_volume - snowVolumeCategory(1,1,iCell) = config_initial_snow_volume - surfaceTemperature(1,1,iCell) = -1.0_RKIND - - call colpkg_init_trcr(& - airTemperature(iCell), & - seaFreezingTemperature(iCell), & - initialSalinityProfile(:,iCell), & - initialMeltingTemperatureProfile(:,iCell), & - surfaceTemperature(1,1,iCell), & - nIceLayers, & - nSnowLayers, & - iceEnthalpy(:,1,iCell), & - snowEnthalpy(:,1,iCell)) - endif - - endif ! config_column_physics_type +! endif ! config_column_physics_type iceAreaCell(iCell) = sum(iceAreaCategory(1,:,iCell)) surfaceTemperatureCell(iCell) = -20.15_RKIND @@ -857,10 +808,6 @@ subroutine init_ice_cice_default(& use seaice_icepack, only: & seaice_icepack_write_warnings - use seaice_column, only: & - seaice_column_init_trcr, & - seaice_column_enthalpy_snow - type(block_type), intent(inout) :: & block !< Input/Output: @@ -974,7 +921,7 @@ subroutine init_ice_cice_default(& landIceMask(iCell) == 0) then ! has ice - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCategory = 1, nCategories iceAreaCategory(1,iCategory,iCell) = initialCategoryIceArea(iCategory) @@ -993,27 +940,7 @@ subroutine init_ice_cice_default(& call seaice_icepack_write_warnings(icepack_warnings_aborted()) enddo ! iCategory - else if (trim(config_column_physics_type) == "column_package") then - do iCategory = 1, nCategories - - iceAreaCategory(1,iCategory,iCell) = initialCategoryIceArea(iCategory) - iceVolumeCategory(1,iCategory,iCell) = initialCategoryIceArea(iCategory) * initialCategoryIceThickness(iCategory) - snowVolumeCategory(1,iCategory,iCell) = min(iceAreaCategory(1,iCategory,iCell) * initialCategorySnowThickness, & - 0.2_RKIND * iceVolumeCategory(1,iCategory,iCell)) - - call seaice_column_init_trcr(& - airTemperature(iCell), & - seaFreezingTemperature(iCell), & - initialSalinityProfile(:,iCell), & - initialMeltingTemperatureProfile(:,iCell), & - surfaceTemperature(1,iCategory,iCell), & - nIceLayers, & - nSnowLayers, & - iceEnthalpy(:,iCategory,iCell), & - snowEnthalpy(:,iCategory,iCell)) - - enddo ! iCategory - endif ! config_column_physics_type +! endif ! config_column_physics_type else @@ -1023,15 +950,11 @@ subroutine init_ice_cice_default(& snowVolumeCategory(1,:,iCell) = 0.0_RKIND surfaceTemperature(1,:,iCell) = seaFreezingTemperature(iCell) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iSnowLayer = 1, nSnowLayers snowEnthalpy(iSnowLayer,:,iCell) = icepack_enthalpy_snow(0.0_RKIND) end do - else if (trim(config_column_physics_type) == "column_package") then - do iSnowLayer = 1, nSnowLayers - snowEnthalpy(iSnowLayer,:,iCell) = seaice_column_enthalpy_snow(0.0_RKIND) - end do - endif ! config_column_physics_type +! endif ! config_column_physics_type endif @@ -1082,9 +1005,6 @@ subroutine initial_category_areas_and_volumes(& use seaice_icepack, only: & seaice_icepack_write_warnings - use seaice_column, only: & - seaice_column_init_itd - ! Note: the resulting average ice thickness ! tends to be less than hbar due to the ! nonlinear distribution of ice thicknesses @@ -1142,22 +1062,11 @@ subroutine initial_category_areas_and_volumes(& if (.not. config_use_column_physics) then - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call icepack_init_itd(& categoryThicknessLimits) call seaice_icepack_write_warnings(icepack_warnings_aborted()) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_init_itd(& - nCategories, & - categoryThicknessLimits, & - abortFlag, & - abortMessage) - if (abortFlag) then - call mpas_log_write(& - "initial_category_areas_and_volumes: "//trim(abortMessage), & - MPAS_LOG_CRIT) - endif - endif ! config_column_physics_type +! endif ! config_column_physics_type endif @@ -1226,10 +1135,6 @@ subroutine init_ice_single_cell(& use seaice_constants, only: & seaiceDegreesToRadians - use ice_colpkg, only: & - colpkg_init_trcr, & - colpkg_enthalpy_snow - use icepack_intfc, only: & icepack_init_enthalpy, & icepack_enthalpy_snow, & @@ -1321,7 +1226,7 @@ subroutine init_ice_single_cell(& do iCell = 1, nCellsSolve - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then ! has ice do iCategory = 1, nCategories @@ -1342,29 +1247,7 @@ subroutine init_ice_single_cell(& enddo ! iCategory - else if (trim(config_column_physics_type) == "column_package") then - - ! has ice - do iCategory = 1, nCategories - - iceAreaCategory(1,iCategory,iCell) = config_initial_ice_area - iceVolumeCategory(1,iCategory,iCell) = config_initial_ice_volume - snowVolumeCategory(1,iCategory,iCell) = config_initial_snow_volume - - call colpkg_init_trcr(& - airTemperature(iCell), & - seaFreezingTemperature(iCell), & - initialSalinityProfile(:,iCell), & - initialMeltingTemperatureProfile(:,iCell), & - surfaceTemperature(1,iCategory,iCell), & - nIceLayers, & - nSnowLayers, & - iceEnthalpy(:,iCategory,iCell), & - snowEnthalpy(:,iCategory,iCell)) - - enddo ! iCategory - - endif ! config_column_physics_type +! endif ! config_column_physics_type enddo ! iCell @@ -1409,10 +1292,6 @@ subroutine init_ice_ridging(& use seaice_icepack, only: & seaice_icepack_write_warnings - use seaice_column, only: & - seaice_column_init_trcr, & - seaice_column_enthalpy_snow - type(block_type), intent(inout) :: & block !< Input/Output: @@ -1533,7 +1412,7 @@ subroutine init_ice_ridging(& initialCategoryIceThickness(4) = (categoryThicknessLimits(4) + categoryThicknessLimits(4)) * 0.5_RKIND initialCategoryIceThickness(5) = categoryThicknessLimits(5) + 1.0_RKIND - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCellsSolve if (seaSurfaceTemperature(iCell) <= seaFreezingTemperature(iCell) + 0.2_RKIND .and. & @@ -1576,51 +1455,7 @@ subroutine init_ice_ridging(& endif enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - do iCell = 1, nCellsSolve - - if (seaSurfaceTemperature(iCell) <= seaFreezingTemperature(iCell) + 0.2_RKIND .and. & - (latCell(iCell) > config_initial_latitude_north * seaiceDegreesToRadians .or. & - latCell(iCell) < config_initial_latitude_south * seaiceDegreesToRadians) .and. & - landIceMask(iCell) == 0) then - - ! has ice - do iCategory = 1, nCategories - - iceAreaCategory(1,iCategory,iCell) = initialCategoryIceArea(iCategory) - iceVolumeCategory(1,iCategory,iCell) = initialCategoryIceArea(iCategory) * initialCategoryIceThickness(iCategory) - snowVolumeCategory(1,iCategory,iCell) = min(iceAreaCategory(1,iCategory,iCell) * initialCategorySnowThickness, & - 0.2_RKIND * iceVolumeCategory(1,iCategory,iCell)) - - call seaice_column_init_trcr(& - airTemperature(iCell), & - seaFreezingTemperature(iCell), & - initialSalinityProfile(:,iCell), & - initialMeltingTemperatureProfile(:,iCell), & - surfaceTemperature(1,iCategory,iCell), & - nIceLayers, & - nSnowLayers, & - iceEnthalpy(:,iCategory,iCell), & - snowEnthalpy(:,iCategory,iCell)) - - enddo ! iCategory - - else - - ! no ice - iceAreaCategory(1,:,iCell) = 0.0_RKIND - iceVolumeCategory(1,:,iCell) = 0.0_RKIND - snowVolumeCategory(1,:,iCell) = 0.0_RKIND - - surfaceTemperature(1,:,iCell) = seaFreezingTemperature(iCell) - do iSnowLayer = 1, nSnowLayers - snowEnthalpy(iSnowLayer,:,iCell) = seaice_column_enthalpy_snow(0.0_RKIND) - end do - - endif - - enddo ! iCell - endif ! config_column_physics_type +! endif ! config_column_physics_type ! clean up deallocate(initialCategoryIceArea) @@ -2504,11 +2339,6 @@ subroutine initialize_coupler_fields(domain) use seaice_icepack, only: & !echmod - use icepack_intfc directly seaice_icepack_init_ocean_conc, & seaice_icepack_initial_air_drag_coefficient - use seaice_column, only: & - seaice_column_liquidus_temperature, & - seaice_column_init_ocean_conc, & - seaice_column_initial_air_drag_coefficient - use seaice_constants, only: & seaiceStefanBoltzmann, & seaiceFreshWaterFreezingPoint @@ -2623,15 +2453,11 @@ subroutine initialize_coupler_fields(domain) call MPAS_pool_get_config(block % configs, "config_do_restart", config_do_restart) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCells seaFreezingTemperature(iCell) = icepack_liquidus_temperature(seaSurfaceSalinity(iCell)) enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - do iCell = 1, nCells - seaFreezingTemperature(iCell) = seaice_column_liquidus_temperature(seaSurfaceSalinity(iCell)) - enddo ! iCell - endif ! config_column_physics_type +! endif ! config_column_physics_type ! sea surface temperature is not initialized if we're restarting if (.not. config_do_restart) then @@ -2652,11 +2478,9 @@ subroutine initialize_coupler_fields(domain) call MPAS_pool_get_subpool(block % structs, "drag", drag) call MPAS_pool_get_array(drag, "airDragCoefficient", airDragCoefficient) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then airDragCoefficient = seaice_icepack_initial_air_drag_coefficient() - else if (trim(config_column_physics_type) == "column_package") then - airDragCoefficient = seaice_column_initial_air_drag_coefficient() - endif ! config_column_physics_type +! endif ! config_column_physics_type endif @@ -2724,7 +2548,7 @@ subroutine initialize_coupler_fields(domain) call MPAS_pool_get_array(biogeochemistry, "carbonToNitrogenRatioAlgae", carbonToNitrogenRatioAlgae) call MPAS_pool_get_array(biogeochemistry, "carbonToNitrogenRatioDON", carbonToNitrogenRatioDON) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCells call seaice_icepack_init_ocean_conc(& @@ -2745,33 +2569,7 @@ subroutine initialize_coupler_fields(domain) carbonToNitrogenRatioDON(:)) enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - do iCell = 1, nCells - - call seaice_column_init_ocean_conc(& - oceanAmmoniumConc(iCell), & - oceanDMSPConc(iCell), & - oceanDMSConc(iCell), & - oceanAlgaeConc(:,iCell), & - oceanDOCConc(:,iCell), & - oceanDICConc(:,iCell), & - oceanDONConc(:,iCell), & - oceanDissolvedIronConc(:,iCell), & - oceanParticulateIronConc(:,iCell), & - oceanHumicsConc(iCell), & - oceanNitrateConc(iCell), & - oceanSilicateConc(iCell),& - oceanZAerosolConc(:,iCell), & - maxDICType, & - maxDONType, & - maxIronType, & - maxAerosolType, & - carbonToNitrogenRatioAlgae(:), & - carbonToNitrogenRatioDON(:)) - - enddo ! iCell - - endif ! config_column_physics_type +! endif ! config_column_physics_type endif ! config_use_column_biogeochemistry @@ -2956,10 +2754,7 @@ subroutine seaice_check_configs_coupled(domain) config_use_column_snow_tracers, & config_use_snow_liquid_ponds, & config_use_high_frequency_coupling, & - config_limit_air_temperatures, & ! only used for CORE forcing - config_use_congelation_basal_melt, & ! deprecate with colpkg - config_use_lateral_melt, & ! deprecate with colpkg - config_use_latent_processes ! deprecate with colpkg + config_limit_air_temperatures ! only used for CORE forcing #ifdef CCSMCOUPLED ! abort @@ -3083,9 +2878,6 @@ subroutine seaice_check_configs_coupled(domain) call MPAS_pool_get_config(domain % configs, "config_use_shortwave_redistribution", config_use_shortwave_redistribution) call MPAS_pool_get_config(domain % configs, "config_use_high_frequency_coupling", config_use_high_frequency_coupling) call MPAS_pool_get_config(domain % configs, "config_limit_air_temperatures", config_limit_air_temperatures) - call MPAS_pool_get_config(domain % configs, "config_use_latent_processes", config_use_latent_processes) ! colpkg - call MPAS_pool_get_config(domain % configs, "config_use_lateral_melt", config_use_lateral_melt) ! colpkg - call MPAS_pool_get_config(domain % configs, "config_use_congelation_basal_melt", config_use_congelation_basal_melt) ! colpkg if (trim(config_column_physics_type) /= "icepack") then call mpas_log_write(& @@ -3195,24 +2987,6 @@ subroutine seaice_check_configs_coupled(domain) messageType=MPAS_LOG_WARN) endif - if (trim(config_column_physics_type) == 'icepack' .and. .not. config_use_latent_processes) then ! colpkg - call mpas_log_write(& - 'seaice_check_configs_coupled: config_use_latent_processes is not available in icepack', & - messageType=MPAS_LOG_WARN) - endif - - if (trim(config_column_physics_type) == 'icepack' .and. .not. config_use_lateral_melt) then ! colpkg - call mpas_log_write(& - 'seaice_check_configs_coupled: config_use_lateral_melt is not available in icepack', & - messageType=MPAS_LOG_WARN) - endif - - if (trim(config_column_physics_type) == 'icepack' .and. .not. config_use_congelation_basal_melt) then ! colpkg - call mpas_log_write(& - 'seaice_check_configs_coupled: config_use_congelation_basal_melt is not available in icepack', & - messageType=MPAS_LOG_WARN) - endif - #endif end subroutine seaice_check_configs_coupled diff --git a/components/mpas-seaice/src/shared/mpas_seaice_prescribed.F b/components/mpas-seaice/src/shared/mpas_seaice_prescribed.F index 3d3a7940f22a..13cc1273fe31 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_prescribed.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_prescribed.F @@ -130,15 +130,6 @@ subroutine seaice_run_prescribed_ice(domain) use seaice_constants, only: & seaicePuny - use ice_colpkg, only: & - colpkg_enthalpy_snow, & - colpkg_enthalpy_ice, & - colpkg_salinity_profile - - use seaice_column, only: & ! colpkg - seaice_column_reinitialize_fluxes, & - seaice_column_aggregate - use icepack_intfc, only: & icepack_enthalpy_snow, & icepack_salinity_profile @@ -304,7 +295,7 @@ subroutine seaice_run_prescribed_ice(domain) temperatureGradient = seaFreezingTemperature(iCell) - surfaceTemperature(1,iCategory,iCell) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then ! ice quantities do iIceLayer = 1, nIceLayers @@ -321,24 +312,7 @@ subroutine seaice_run_prescribed_ice(domain) snowEnthalpy(iSnowLayer,iCategory,iCell) = icepack_enthalpy_snow(surfaceTemperature(1,iCategory,iCell)) enddo ! iSnowLayer - else if (trim(config_column_physics_type) == "column_package") then - - ! ice quantities - do iIceLayer = 1, nIceLayers - - depth = (real(iIceLayer,kind=RKIND) - 0.5_RKIND) / real(nIceLayers,kind=RKIND) - iceTemperature = surfaceTemperature(1,iCategory,iCell) + temperatureGradient * depth - iceSalinity(iIceLayer,iCategory,iCell) = colpkg_salinity_profile(depth) - iceEnthalpy(iIceLayer,iCategory,iCell) = colpkg_enthalpy_ice(iceTemperature,iceSalinity(iIceLayer,iCategory,iCell)) - - enddo ! iIceLayer - - ! snow quantities - do iSnowLayer = 1, nSnowLayers - snowEnthalpy(iSnowLayer,iCategory,iCell) = colpkg_enthalpy_snow(surfaceTemperature(1,iCategory,iCell)) - enddo ! iSnowLayer - - endif ! config_column_physics_type +! endif ! config_column_physics_type endif @@ -375,11 +349,9 @@ subroutine seaice_run_prescribed_ice(domain) enddo ! aggregate tracers - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_aggregate(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_aggregate(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type ! set non-computed fluxes, ice velocities, ice-ocn stresses to zero blockPtr => domain % blocklist @@ -404,11 +376,9 @@ subroutine seaice_run_prescribed_ice(domain) enddo ! reinitialize fluxes - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_reinitialize_fluxes(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_reinitialize_fluxes(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type endif ! prescribed ice mode diff --git a/components/mpas-seaice/src/shared/mpas_seaice_time_integration.F b/components/mpas-seaice/src/shared/mpas_seaice_time_integration.F index d1e04db9dab8..b2e6d7ae3353 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_time_integration.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_time_integration.F @@ -65,14 +65,6 @@ subroutine seaice_timestep(& seaice_icepack_reinitialize_diagnostics_thermodynamics, & seaice_icepack_reinitialize_diagnostics_bgc, & seaice_icepack_reinitialize_diagnostics_dynamics - use seaice_column, only: & - seaice_column_predynamics_time_integration, & - seaice_column_dynamics_time_integration, & - seaice_column_postdynamics_time_integration, & - seaice_column_reinitialize_fluxes, & - seaice_column_reinitialize_diagnostics_thermodynamics, & - seaice_column_reinitialize_diagnostics_bgc, & - seaice_column_reinitialize_diagnostics_dynamics use seaice_prescribed, only: & seaice_run_prescribed_ice @@ -125,13 +117,10 @@ subroutine seaice_timestep(& ! reinitialize diagnostics call mpas_timer_start("Reinitialize diagnostics thermodynamics/bgc") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_reinitialize_diagnostics_thermodynamics(domain) call seaice_icepack_reinitialize_diagnostics_bgc(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_reinitialize_diagnostics_thermodynamics(domain) - call seaice_column_reinitialize_diagnostics_bgc(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type call mpas_timer_stop("Reinitialize diagnostics thermodynamics/bgc") call MPAS_pool_get_config(configs, "config_use_advection", config_use_advection) @@ -141,11 +130,9 @@ subroutine seaice_timestep(& ! pre dynamics column physics call mpas_timer_start("Column pre-dynamics") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_predynamics_time_integration(domain, clock) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_predynamics_time_integration(domain, clock) - endif ! config_column_physics_type +! endif ! config_column_physics_type call mpas_timer_stop("Column pre-dynamics") ! dynamics @@ -158,11 +145,9 @@ subroutine seaice_timestep(& ! reinitialize dynamics diagnostics call mpas_timer_start("Reinitialize diagnostics dynamics") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_reinitialize_diagnostics_dynamics(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_reinitialize_diagnostics_dynamics(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type call mpas_timer_stop("Reinitialize diagnostics dynamics") ! velocity solve @@ -178,11 +163,9 @@ subroutine seaice_timestep(& ! ridging call mpas_timer_start("Column") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_dynamics_time_integration(domain, clock) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_dynamics_time_integration(domain, clock) - endif ! config_column_physics_type +! endif ! config_column_physics_type call mpas_timer_stop("Column") enddo ! iDynamicsSubcycle @@ -190,11 +173,9 @@ subroutine seaice_timestep(& ! shortwave call mpas_timer_start("Column post-dynamics") - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_postdynamics_time_integration(domain, clock) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_postdynamics_time_integration(domain, clock) - endif ! config_column_physics_type +! endif ! config_column_physics_type call mpas_timer_stop("Column post-dynamics") ! check the physical state of the model @@ -278,8 +259,6 @@ subroutine seaice_timestep_finalize(& use seaice_icepack, only: & seaice_icepack_reinitialize_fluxes - use seaice_column, only: & - seaice_column_reinitialize_fluxes type(domain_type), intent(in) :: & domain @@ -289,11 +268,9 @@ subroutine seaice_timestep_finalize(& call MPAS_pool_get_config(domain % configs, "config_column_physics_type", config_column_physics_type) - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then call seaice_icepack_reinitialize_fluxes(domain) - else if (trim(config_column_physics_type) == "column_package") then - call seaice_column_reinitialize_fluxes(domain) - endif ! config_column_physics_type +! endif ! config_column_physics_type end subroutine seaice_timestep_finalize diff --git a/components/mpas-seaice/src/shared/mpas_seaice_velocity_solver.F b/components/mpas-seaice/src/shared/mpas_seaice_velocity_solver.F index 3009b618161b..a46a8e40013f 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_velocity_solver.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_velocity_solver.F @@ -1322,9 +1322,6 @@ subroutine ice_strength(domain) use seaice_icepack, only: & seaice_icepack_write_warnings - use seaice_column, only: & - seaice_column_ice_strength - use seaice_constants, only: & seaiceIceStrengthConstantHiblerP, & seaiceIceStrengthConstantHiblerC @@ -1422,7 +1419,7 @@ subroutine ice_strength(domain) else - if (trim(config_column_physics_type) == "icepack") then +! if (trim(config_column_physics_type) == "icepack") then do iCell = 1, nCellsSolve icePressure(iCell) = 0.0_RKIND @@ -1442,27 +1439,7 @@ subroutine ice_strength(domain) endif ! solveStress enddo ! iCell - else if (trim(config_column_physics_type) == "column_package") then - do iCell = 1, nCellsSolve - - icePressure(iCell) = 0.0_RKIND - - if (solveStress(iCell) == 1) then - - ! this routine doesnt reset icePressure - call seaice_column_ice_strength(& - nCategories, & - iceAreaCell(iCell), & - iceVolumeCell(iCell), & - openWaterArea(iCell), & - iceAreaCategory(1,:,iCell), & - iceVolumeCategory(1,:,iCell), & - icePressure(iCell)) - - endif ! solveStress - - enddo ! iCell - endif ! config_column_physics_type +! endif ! config_column_physics_type endif diff --git a/components/ww3/cime_config/buildlib_cmake b/components/ww3/cime_config/buildlib_cmake index 42d92b2f0ad4..d67f8c94c670 100755 --- a/components/ww3/cime_config/buildlib_cmake +++ b/components/ww3/cime_config/buildlib_cmake @@ -16,94 +16,25 @@ sys.path.append(_LIBDIR) from standard_script_setup import * from CIME.buildlib import parse_input from CIME.case import Case -from CIME.build import get_standard_makefile_args -from CIME.utils import expect, run_bld_cmd_ensure_logging, safe_copy, run_cmd_no_fail logger = logging.getLogger(__name__) ############################################################################### def buildlib(bldroot, installpath, case): ############################################################################### - caseroot = case.get_value("CASEROOT") - casebuild = case.get_value("CASEBUILD") - casetools = case.get_value("CASETOOLS") - srcroot = case.get_value("SRCROOT") - mach = case.get_value("MACH") - objroot = case.get_value("OBJROOT") - libroot = case.get_value("LIBROOT") - gmake_j = case.get_value("GMAKE_J") - gmake = case.get_value("GMAKE") - compiler = case.get_value("COMPILER") - mpilib = case.get_value("MPILIB") - comp_interface = case.get_value("COMP_INTERFACE") - exeroot = case.get_value("EXEROOT") - ninst_value = case.get_value("NINST_VALUE") - rundir = case.get_value("RUNDIR") - - # Define WW3 repository directories - repodir = "{}/components/ww3/src".format(srcroot) - modeldir = "{}/WW3/model".format(repodir) - builddir = "{}/wav".format(exeroot) - - # work dirs are placed in the binary/build area. - bindir_source = "{}/bin".format(modeldir) - bindir = "{}/bin".format(builddir) - shutil.copytree(bindir_source, bindir) - auxdir_source = "{}/aux".format(modeldir) - auxdir = "{}/aux".format(builddir) - shutil.copytree(auxdir_source, auxdir) - ftndir_source = "{}/ftn".format(modeldir) - ftndir = "{}/ftn".format(builddir) - shutil.copytree(ftndir_source, ftndir) - - tmpdir = "{}/tmp".format(builddir) - - # Run w3_setup to create wwatch3.env file - env_file = os.path.join(bindir, "wwatch3.env") - if os.path.exists(env_file): - os.remove(env_file) - - comp = compiler.capitalize() - - # Get serial fortran and C compilers from Macros - make_args = get_standard_makefile_args(case, shared_lib=True) - sf90 = run_cmd_no_fail("make -f {}/Macros.make {} -p | grep 'SFC :='".format(caseroot, make_args)).split(":=")[-1].strip() - scc = run_cmd_no_fail("make -f {}/Macros.make {} -p | grep 'SCC :='".format(caseroot, make_args)).split(":=")[-1].strip() - - inp_file = os.path.join(bindir, "w3_setup.inp") - with open(inp_file, "w") as fd: - fd.write( -"""y - -{} -{} -{} - - -y -""".format(sf90, scc, tmpdir)) - - run_bld_cmd_ensure_logging("./w3_setup {} -s E3SM < w3_setup.inp".format(builddir), logger, from_dir=bindir) - os.remove(inp_file) - - # Generate pre-processed WW3 source code - ww3_exe = ['ww3_shel','ww3_grid'] - for exe in ww3_exe: - run_bld_cmd_ensure_logging("./w3_source {}".format(exe), logger, from_dir=bindir) - for exe in ww3_exe: - tarfile = "{}/work/{}.tar.gz".format(builddir,exe) - shutil.move(tarfile, tmpdir) - run_bld_cmd_ensure_logging("tar -xzvf {}.tar.gz".format(exe), logger, from_dir=tmpdir) - run_bld_cmd_ensure_logging("rm ww3_shel.F90", logger, from_dir=tmpdir) - run_bld_cmd_ensure_logging("rm ww3_grid.F90", logger, from_dir=tmpdir) + srcroot = case.get_value("SRCROOT") + caseroot = case.get_value("CASEROOT") + casebuild = case.get_value("CASEBUILD") with open(os.path.join(casebuild, "ww3conf", "Filepath"), "w") as fd: - fd.write( -"""{}/SourceMods/src.ww3 -{} -{}/components/ww3/src/cpl -""".format(caseroot, tmpdir, srcroot)) + fd.write(f"{caseroot}/SourceMods/src.ww3\n") + fd.write(f"{srcroot}/components/ww3/src/WW3/model/src\n") + fd.write(f"{srcroot}/components/ww3/src/WW3/model/src/SCRIP\n") + fd.write(f"{srcroot}/components/ww3/src/cpl\n") + + cmake_args = " -DSWITCH=E3SM" + return cmake_args ############################################################################### def _main_func(): diff --git a/components/ww3/src/WW3 b/components/ww3/src/WW3 index a02d532b0e03..ad107eb52b5e 160000 --- a/components/ww3/src/WW3 +++ b/components/ww3/src/WW3 @@ -1 +1 @@ -Subproject commit a02d532b0e033312929cd23306c764cb21678433 +Subproject commit ad107eb52b5e18117d4ca77fb03bb187d5db9245 diff --git a/components/ww3/src/cpl/wav_comp_mct.F90 b/components/ww3/src/cpl/wav_comp_mct.F90 index 43ba7bcf6a73..f83fec41809b 100644 --- a/components/ww3/src/cpl/wav_comp_mct.F90 +++ b/components/ww3/src/cpl/wav_comp_mct.F90 @@ -149,7 +149,6 @@ MODULE WAV_COMP_MCT use wmscrpmd, only: grid_area use w3parall, only: init_get_isea use w3dispmd, only: wavnu1 - use w3triamd, only: SETUGIOBP !/ use w3initmd, only: w3init use w3wavemd, only: w3wave @@ -924,8 +923,6 @@ SUBROUTINE WAV_INIT_MCT( EClock, cdata, x2w_w, w2x_w, NLFilename ) DW(0) = 0. - CALL SETUGIOBP - call mpi_barrier ( mpi_comm, ierr ) endif diff --git a/components/ww3/src/ww3_utils.cmake b/components/ww3/src/ww3_utils.cmake new file mode 100644 index 000000000000..f652ebc0057a --- /dev/null +++ b/components/ww3/src/ww3_utils.cmake @@ -0,0 +1,116 @@ +# Set switch file on command line when running CMake +#set(SWITCH "" CACHE STRING "Switch file, either full path, relative path from location of top-level WW3/ dir, or a switch in model/bin") + +function(parse_switches) + # parse cache variable + set(SWITCH "" CACHE STRING "Switch file") + + # path to the top level of WW3 submodule + set(WW3_DIR "${PROJECT_SOURCE_DIR}/ww3/src/WW3") + + # Search for switch file as a full path or in model/bin + if(EXISTS ${SWITCH}) + set(switch_file ${SWITCH}) + else() + set(switch_file ${WW3_DIR}/model/bin/switch_${SWITCH}) + if(NOT EXISTS ${switch_file}) + message(FATAL_ERROR "Switch file '${switch_file}' does not exist, set switch with -DSWITCH=") + endif() + endif() + + # Copy switch file to build dir + configure_file(${switch_file} ${CMAKE_BINARY_DIR}/cmake/wav/switch COPYONLY) + + # Open switch file and parse switches + file(STRINGS ${CMAKE_BINARY_DIR}/cmake/wav/switch switch_strings) + separate_arguments(switches UNIX_COMMAND ${switch_strings}) + + # Include list of src files to make file more readable + # defines variables "ftn_src", "pdlib_src", "scrip_src", and "scripnc_src" + include(${WW3_DIR}/model/src/cmake/src_list.cmake) + + #------------------------- + # Determine switch specific files + #------------------------- + include(${WW3_DIR}/model/src/cmake/check_switches.cmake) + # make (temporary) directory strcuture that `check_switches` expects + file(MAKE_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/cmake) + # Copy json file so that path checked by `check_switches` function is correct + configure_file(${WW3_DIR}/model/src/cmake/switches.json ${CMAKE_CURRENT_SOURCE_DIR}/cmake COPYONLY) + # use WW3 fucntion to parse the switches + check_switches("${switches}" switch_files) + # remove the temporary directory needed to make `check_switches` work + file(REMOVE_RECURSE ${CMAKE_CURRENT_SOURCE_DIR}/cmake) + + set(SWITCH_SOURCES) + + # add relative path to filenames + list(APPEND srcfiles ${ftn_src} ${switch_files}) + foreach(filename ${srcfiles} ) + list(APPEND SWITCH_SOURCES ww3/src/WW3/model/src/${filename}) + endforeach() + + # if using switch fix the relative path to needed source files + if("SCRIP" IN_LIST switches) + foreach(filepath ${scrip_src}) + get_filename_component(BASENAME ${filepath} NAME) + list(APPEND SWITCH_SOURCES ww3/src/WW3/model/src/SCRIP/${BASENAME}) + endforeach() + endif() + + # if using switch fix the relative path to needed source files + if("SCRIPNC" IN_LIST switches) + foreach(filepath ${scripnc_src}) + get_filename_component(BASENAME ${filepath} NAME) + list(APPEND SWITCH_SOURCES ww3/src/WW3/model/src/SCRIP/${BASENAME}) + endforeach() + endif() + # manually add NETCDF metadata module + list(APPEND SWITCH_SOURCES ww3/src/WW3/model/src/w3ounfmetamd.F90) + + # return the master list of all files needed + set(SWITCH_SOURCES ${SWITCH_SOURCES} PARENT_SCOPE) + # and the list of switches used to determine master list + set(switches ${switches} PARENT_SCOPE) +endfunction() + +function(cull_sources_from_switches SOURCES GEN_F90_SOURCES) + + # parse the switch file and get lists of needed source files + parse_switches() + + # first check that GEN_F90_SOURCES is an empty list + list(LENGTH GEN_F90_SOURCES GEN_F90_LENGTH) + if(GEN_F90_LENGTH GREATER 0) + message(FATAL_ERROR + "Culling of WW3 source files based on switches does not support" + "generated files but, LENGTH(GEN_F90_SOURCES)=${GEN_F90_LENGTH}") + endif() + + # create a copy before iterating to avoid issues with modifying list + set(SOURCES_CULLED ${SOURCES}) + + # loop over all source files found in SourceMods directories + foreach(filepath ${SOURCES}) + # skip files in the cpl directory because we want all those. + if(${filepath} MATCHES "ww3/src/cpl/.+\.[Ff]90") + continue() + endif() + + if(NOT ${filepath} IN_LIST SWITCH_SOURCES) + list(REMOVE_ITEM SOURCES_CULLED ${filepath}) + endif() + endforeach() + + list(LENGTH SOURCES ORIGINAL_LENGTH) + list(LENGTH SOURCES_CULLED CULLED_LENGTH) + + if(${ORIGINAL_LENGTH} EQUAL ${CULLED_LENGTH}) + message(FATAL_ERROR "No culling based on switches occured. Something is incorrect") + endif() + + # return list of switches + set(switches ${switches} PARENT_SCOPE) + set(SOURCES_CULLED ${SOURCES_CULLED} PARENT_SCOPE) + set(GEN_F90_SOURCES_CULLED ${GEN_F90_SOURCES} PARENT_SCOPE) +endfunction() diff --git a/docs/refs/eamxx.bib b/docs/refs/eamxx.bib new file mode 100644 index 000000000000..75ea44c1517f --- /dev/null +++ b/docs/refs/eamxx.bib @@ -0,0 +1,148 @@ +@article{Bogenschutz_Krueger13, +author = {Bogenschutz, Peter A. and Krueger, Steven K.}, +title = {A simplified PDF parameterization of subgrid-scale clouds and turbulence for cloud-resolving models}, +journal = {Journal of Advances in Modeling Earth Systems}, +volume = {5}, +number = {2}, +pages = {195-211}, +keywords = {cloud parameterization, turbulence, boundary layer clouds}, +doi = {https://doi.org/10.1002/jame.20018}, +url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/jame.20018}, +year = {2013} +} + +@Article{Bradley_et22, +AUTHOR = {Bradley, A. M. and Bosler, P. A. and Guba, O.}, +TITLE = {Islet: interpolation semi-Lagrangian element-based transport}, +JOURNAL = {Geoscientific Model Development}, +VOLUME = {15}, +YEAR = {2022}, +NUMBER = {16}, +PAGES = {6285--6310}, +URL = {https://gmd.copernicus.org/articles/15/6285/2022/}, +DOI = {10.5194/gmd-15-6285-2022} +} + +@article{Caldwell_et21, +author = {Caldwell, P. M. and Terai, C. R. and Hillman, B. and Keen, N. D. and Bogenschutz, P. and Lin, W. and Beydoun, H. and Taylor, M. and Bertagna, L. and Bradley, A. M. and Clevenger, T. C. and Donahue, A. S. and Eldred, C. and Foucar, J. and Golaz, J.-C. and Guba, O. and Jacob, R. and Johnson, J. and Krishna, J. and Liu, W. and Pressel, K. and Salinger, A. G. and Singh, B. and Steyer, A. and Ullrich, P. and Wu, D. and Yuan, X. and Shpund, J. and Ma, H.-Y. and Zender, C. S.}, +title = {Convection-Permitting Simulations With the E3SM Global Atmosphere Model}, +journal = {Journal of Advances in Modeling Earth Systems}, +volume = {13}, +number = {11}, +pages = {e2021MS002544}, +keywords = {cloud resolving model, storm resolving model, general circulation model, convection permitting model, E3SM}, +doi = {https://doi.org/10.1029/2021MS002544}, +url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2021MS002544}, +eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2021MS002544}, +note = {e2021MS002544 2021MS002544}, +year = {2021} +} + +@article{Fiedler_Panofsky72, +author = {Fiedler, F. and Panofsky, H. A.}, +title = {The geostrophic drag coefficient and the ‘effective’ roughness length}, +journal = {Quarterly Journal of the Royal Meteorological Society}, +volume = {98}, +number = {415}, +pages = {213-220}, +doi = {https://doi.org/10.1002/qj.49709841519}, +url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.49709841519}, +eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.49709841519}, +abstract = {Abstract An ‘effective’ roughness length is defined for use over heterogeneous terrain as the roughness length which homogeneous terrain would have to give the correct surface stress over a given area. A method is suggested to compute geostrophic drag coefficient, wind-contour angle and surface heat flux, given this roughness length, latitude, geostrophic wind speed and insolation or ground-air temperature differences.}, +year = {1972} +} + + +@article{Hannah_et21, +author = {Hannah, Walter M. and Bradley, Andrew M. and Guba, Oksana and Tang, Qi and Golaz, Jean-Christophe and Wolfe, Jon}, +title = {Separating Physics and Dynamics Grids for Improved Computational Efficiency in Spectral Element Earth System Models}, +journal = {Journal of Advances in Modeling Earth Systems}, +volume = {13}, +number = {7}, +pages = {e2020MS002419}, +keywords = {computational efficiency, E3SM, effective resolution, grid remap methods}, +doi = {https://doi.org/10.1029/2020MS002419}, +url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2020MS002419}, +eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2020MS002419}, +note = {e2020MS002419 2020MS002419}, +year = {2021} +} + +@article {Morrison_Milbrandt15, + author = "Hugh Morrison and Jason A. Milbrandt", + title = "Parameterization of Cloud Microphysics Based on the Prediction of Bulk Ice Particle Properties. Part I: Scheme Description and Idealized Tests", + journal = "Journal of the Atmospheric Sciences", + year = "2015", + publisher = "American Meteorological Society", + address = "Boston MA, USA", + volume = "72", + number = "1", + doi = "10.1175/JAS-D-14-0065.1", + pages= "287 - 311", + url = "https://journals.ametsoc.org/view/journals/atsc/72/1/jas-d-14-0065.1.xml" +} + +@article{Pincus_et19, +author = {Pincus, Robert and Mlawer, Eli J. and Delamere, Jennifer S.}, +title = {Balancing Accuracy, Efficiency, and Flexibility in Radiation Calculations for Dynamical Models}, +journal = {Journal of Advances in Modeling Earth Systems}, +volume = {11}, +number = {10}, +pages = {3074-3089}, +keywords = {radiation, atmospheric model, parameterization}, +doi = {https://doi.org/10.1029/2019MS001621}, +url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2019MS001621}, +eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2019MS001621}, +year = {2019} +} + +@Article{Stevens_et17, +AUTHOR = {Stevens, B. and Fiedler, S. and Kinne, S. and Peters, K. and Rast, S. and M\"usse, J. and Smith, S. J. and Mauritsen, T.}, +TITLE = {MACv2-SP: a parameterization of anthropogenic aerosol optical properties and an associated Twomey effect for use in CMIP6}, +JOURNAL = {Geoscientific Model Development}, +VOLUME = {10}, +YEAR = {2017}, +NUMBER = {1}, +PAGES = {433--452}, +URL = {https://gmd.copernicus.org/articles/10/433/2017/}, +DOI = {10.5194/gmd-10-433-2017} +} + +@article{Taylor_et20, +author = {Taylor, Mark A. and Guba, Oksana and Steyer, Andrew and Ullrich, Paul A. and Hall, David M. and Eldred, Christopher}, +title = {An Energy Consistent Discretization of the Nonhydrostatic Equations in Primitive Variables}, +journal = {Journal of Advances in Modeling Earth Systems}, +volume = {12}, +number = {1}, +pages = {e2019MS001783}, +keywords = {nonhydrostatic, hamiltonian, dynamical core, energy conservation, mimetic}, +doi = {https://doi.org/10.1029/2019MS001783}, +url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2019MS001783}, +eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2019MS001783}, +note = {e2019MS001783 10.1029/2019MS001783}, +year = {2020} +} + +@techreport{tiedtke_ecmwf_1979, + address = {Shinfield Park, Reading}, + type = {Technical {Report}}, + title = {{ECMWF} model parameterisation of sub-grid scale processes}, + language = {en}, + institution = {ECMWF}, + author = {Tiedtke, M. and Geleyn, J.-F. and Hollingsworth, A. and Louis, J.-F.}, + month = jan, + year = {1979}, + note = {10}, + pages = {146}, +} + +@article{raisanen2004stochastic, + title={Stochastic generation of subgrid-scale cloudy columns for large-scale models}, + author={R{\"a}is{\"a}nen, Petri and Barker, Howard W and Khairoutdinov, Marat F and Li, Jiangnan and Randall, David A}, + journal={Quarterly Journal of the Royal Meteorological Society: A journal of the atmospheric sciences, applied meteorology and physical oceanography}, + volume={130}, + number={601}, + pages={2047--2067}, + year={2004}, + publisher={Wiley Online Library} +} diff --git a/docs/refs/elm.bib b/docs/refs/elm.bib index a1918ed18879..67e212d05fa0 100644 --- a/docs/refs/elm.bib +++ b/docs/refs/elm.bib @@ -117,3 +117,9 @@ @book{goudriaan1977crop publisher={Wageningen University and Research} } +@book{bonan2019climate, + title={Climate change and terrestrial ecosystem modeling}, + author={Bonan, Gordon}, + year={2019}, + publisher={Cambridge University Press} +} diff --git a/driver-mct/cime_config/buildnml b/driver-mct/cime_config/buildnml index 78619b4029fd..649fa8d2c8d7 100755 --- a/driver-mct/cime_config/buildnml +++ b/driver-mct/cime_config/buildnml @@ -48,6 +48,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['MULTI_DRIVER'] = '.true.' if case.get_value('MULTI_DRIVER') else '.false.' config['OS'] = case.get_value('OS') config['glc_nec'] = 0 if case.get_value('GLC_NEC') == 0 else case.get_value('GLC_NEC') + config['glc_nzoc'] = 0 if case.get_value('GLC_NZOC') == 0 else case.get_value('GLC_NZOC') config['single_column'] = 'true' if case.get_value('PTS_MODE') else 'false' config['timer_level'] = 'pos' if case.get_value('TIMER_LEVEL') >= 1 else 'neg' config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' diff --git a/driver-mct/cime_config/config_archive.xml b/driver-mct/cime_config/config_archive.xml index cd22504cbcd7..e5d1cea661ce 100644 --- a/driver-mct/cime_config/config_archive.xml +++ b/driver-mct/cime_config/config_archive.xml @@ -17,7 +17,7 @@ casename.cpl.ha2x1d.1976-01-01-00000.nc casename.cpl.ha2x1h.1976-01-01-00000.nc casename.cpl.hl2x1yr_glc.1976-01-01-00000.nc - rpointer.drv_0001 + rpointer.drv_0001 rpointer.drv casenamenot.cpl.r.1976-01-01-00000.nc diff --git a/driver-mct/cime_config/config_component_e3sm.xml b/driver-mct/cime_config/config_component_e3sm.xml index c16a493f0453..de3e4f078d37 100755 --- a/driver-mct/cime_config/config_component_e3sm.xml +++ b/driver-mct/cime_config/config_component_e3sm.xml @@ -389,7 +389,6 @@ 48 1 1 - 24 12 12 12 @@ -402,6 +401,9 @@ 1440 48 48 + 48 + 48 + 48 96 96 96 @@ -462,7 +464,6 @@ 1 1 1 - $ATM_NCPL 48 $ATM_NCPL $ATM_NCPL @@ -484,7 +485,6 @@ 1 1 1 - $ATM_NCPL $ATM_NCPL run_coupling @@ -510,7 +510,6 @@ 1 1 1 - 24 6 12 12 @@ -519,6 +518,9 @@ 48 48 48 + 48 + 48 + 48 48 48 96 @@ -826,7 +828,25 @@ run_glc env_run.xml Glacier model number of elevation classes, 0 implies no glacier land unit in clm - Used by both ELM and CISM (even if CISM is not running, and only SGLC is used). + Used by both ELM and MALI (even if MALI is not running, and only SGLC is used). + + + + integer + 0,4,30 + 0 + + 30 + 0 + 0 + 0 + 0 + + run_glc + env_run.xml + Glacier model number of z-ocean classes, 0 implies no OCN z-level coupling to GLC or + GLC is inactive. + Used by both OCN and GLC components. @@ -851,6 +871,35 @@ compsets. + + char + none,data_mpaso,data_mali,internal_mpaso,tf,coupler + none + + none + data_mpaso + data_mali + internal_mpaso + tf + coupler + + case_comp + env_case.xml + How OCN/GLC ice-shelf melt flux (ISMF) coupling is calculated: + 'none': ISMF is not represented in MPAS-O or MALI + 'data_mpaso': ISMF is represented as a data field in MPAS-O; + ISMF is not represented in MALI or MALI is inactive + 'data_mali': ISMF is represented as a data field in MALI; + ISMF is not represented in MPAS-O or MPAS-O is inactive + 'internal_mpaso': ISMF is calculated prognostically in MPAS-O; + ISMF is not represented in MALI or MALI is inactive + 'tf': MPAS-O passes 3d thermal forcing to MALI and MALI calculates ISMF + and passes it back to MPAS-O + 'coupler': ISMF is calculated in the coupler on the MALI + grid and at the MPAS-O coupling interval, and then passed to both + MPAS-O and MALI + + integer diff --git a/driver-mct/cime_config/namelist_definition_drv.xml b/driver-mct/cime_config/namelist_definition_drv.xml index 5a49a2afb59d..ea3c38efb3d1 100644 --- a/driver-mct/cime_config/namelist_definition_drv.xml +++ b/driver-mct/cime_config/namelist_definition_drv.xml @@ -198,13 +198,25 @@ seq_flds seq_cplflds_inparm - Number of cism elevation classes. Set by the xml variable GLC_NEC in env_run.xml + Number of GLC elevation classes. Set by the xml variable GLC_NEC in env_run.xml $GLC_NEC + + integer + seq_flds + seq_cplflds_inparm + + Number of GLC z-ocean classes. Set by the xml variable GLC_NZOC in env_run.xml + + + $GLC_NZOC + + + integer seq_flds diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index 72ed4e08abe2..efda9da57ea4 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -436,6 +436,7 @@ module cime_comp_mod logical :: ocn_c2_atm ! .true. => ocn to atm coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on + integer :: glc_nzoc ! number of z-levels for ocn/glc TF coupling logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on logical :: ocn_c2_rof ! .true. => ocn to rof coupling on @@ -1682,6 +1683,7 @@ subroutine cime_init() ocnrof_prognostic=ocnrof_prognostic, & ocn_c2_glcshelf=ocn_c2_glcshelf, & ocn_c2_glctf=ocn_c2_glctf, & + glc_nzoc=glc_nzoc, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & rofocn_prognostic=rofocn_prognostic, & @@ -1783,6 +1785,7 @@ subroutine cime_init() if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm if (ice_prognostic) ocn_c2_ice = .true. + if (glc_prognostic .and. (glc_nzoc > 0)) ocn_c2_glctf = .true. if (wav_prognostic) ocn_c2_wav = .true. if (rofocn_prognostic) ocn_c2_rof = .true. @@ -4833,7 +4836,7 @@ subroutine cime_run_calc_budgets2(in_cplrun) endif if (glc_present) then call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_g2x=.true.) - endif + endif if (do_bgc_budgets) then if (atm_present) then call seq_diagBGC_atm_mct(atm(ens1), fractions_ax(ens1), infodata, do_a2x=.true., do_x2a=.true.) diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index be9c3a1426ce..7aa58dcf5c90 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -195,9 +195,7 @@ module seq_diag_mct (/' area',' hfreeze',' hmelt',' hnetsw',' hlwdn', & ' hlwup',' hlatvap',' hlatfus',' hiroff',' hsen', & -! ' hpolar',' hh2otemp',' wfreeze',' wmelt',' wrain', & ' hpolar',' hh2otemp',' hgsmb',' wfreeze',' wmelt',' wrain', & -! ' wsnow',' wpolar',' wevap',' wrunoff',' wfrzrof', & ' wsnow',' wpolar',' wgsmb',' wevap',' wrunoff',' wfrzrof', & ' wirrig', & ' wfreeze_16O',' wmelt_16O',' wrain_16O',' wsnow_16O', & @@ -1340,8 +1338,6 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) real(r8) :: ca_g ! area of a grid cell logical,save :: first_time = .true. - integer,save :: smb_vector_length,calving_vector_length - !----- formats ----- character(*),parameter :: subName = '(seq_diag_glc_mct) ' @@ -1363,8 +1359,6 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) if (first_time) then - calving_vector_length = 0 - index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_g,'Fogg_rofl') index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_g,'Fogg_rofi') index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_g,'Figg_rofi') @@ -1409,8 +1403,6 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice - smb_vector_length = smb_vector_length +lSize - end if ! end do fields from coupler to glc (x2g_) first_time = .false. diff --git a/driver-mct/main/seq_nlmap_mod.F90 b/driver-mct/main/seq_nlmap_mod.F90 index c934fb5e38b5..c12b79a678bf 100644 --- a/driver-mct/main/seq_nlmap_mod.F90 +++ b/driver-mct/main/seq_nlmap_mod.F90 @@ -730,7 +730,7 @@ subroutine seq_nlmap_avNormArr(mapper, avp_i, avp_o, lnorm_in, a2s_cons) tmp = (gwts(k) - glbl_masses(k))/gwts(natt+k) if (abs(tmp) < 1e-15) then msg = '' - else if (abs(tmp) < 1e-13 .or. (a2s_cons .and. abs(tmp) < 1e-11)) then + else if (abs(tmp) < 1e-13 .or. (a2s_cons .and. abs(tmp) < 1e-8)) then ! Allow slightly more error for the a2s_cons case because ! it is sensitive to domain.lnd-caused inconsistency. msg = ' OK' diff --git a/driver-mct/shr/CMakeLists.txt b/driver-mct/shr/CMakeLists.txt index 08d47cd358ce..ebd39b5f4a6e 100644 --- a/driver-mct/shr/CMakeLists.txt +++ b/driver-mct/shr/CMakeLists.txt @@ -1,5 +1,6 @@ list(APPEND drv_sources glc_elevclass_mod.F90 + glc_zocnclass_mod.F90 seq_cdata_mod.F90 seq_comm_mct.F90 seq_infodata_mod.F90 diff --git a/driver-mct/shr/glc_zocnclass_mod.F90 b/driver-mct/shr/glc_zocnclass_mod.F90 new file mode 100644 index 000000000000..50bb4d100528 --- /dev/null +++ b/driver-mct/shr/glc_zocnclass_mod.F90 @@ -0,0 +1,343 @@ +module glc_zocnclass_mod + + !--------------------------------------------------------------------- + ! + ! Purpose: + ! + ! This module contains data and routines for operating on GLC ocean z-level classes. + +#include "shr_assert.h" + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod + use seq_comm_mct, only : logunit + use shr_log_mod, only : errMsg => shr_log_errMsg + + implicit none + save + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: glc_zocnclass_init ! initialize GLC z-ocean class data + public :: glc_zocnclass_clean ! deallocate memory allocated here + public :: glc_get_num_zocn_classes ! get the number of z-ocean classes + public :: glc_get_zlevels ! get an array of the z-ocean levels + public :: glc_get_zocnclass_bounds ! get the boundaries of all z-ocean classes + public :: glc_zocnclass_as_string ! returns a string corresponding to a given z-ocean class + public :: glc_all_zocnclass_strings ! returns an array of strings for all z-ocean classes + public :: glc_zocn_errcode_to_string ! convert an error code into a string describing the error + + interface glc_zocnclass_init + module procedure glc_zocnclass_init_default + module procedure glc_zocnclass_init_override + end interface glc_zocnclass_init + + + !-------------------------------------------------------------------------- + ! Public data + !-------------------------------------------------------------------------- + + ! Possible error code values + integer, parameter, public :: GLC_ZOCNCLASS_ERR_NONE = 0 ! err_code indicating no error + integer, parameter, public :: GLC_ZOCNCLASS_ERR_UNDEFINED = 1 ! err_code indicating z-ocean classes have not been defined + integer, parameter, public :: GLC_ZOCNCLASS_ERR_TOO_LOW = 2 ! err_code indicating z-level below lowest z-ocean class + integer, parameter, public :: GLC_ZOCNCLASS_ERR_TOO_HIGH = 3 ! err_code indicating z-level above highest z-ocean class + + ! String length for glc z-ocean classes represented as strings + integer, parameter, public :: GLC_ZOCNCLASS_STRLEN = 2 + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + ! number of elevation classes + integer :: glc_nzoc ! number of z-ocean classes + + ! z-level of each class. Units are meters above sea level, so values should be <0 + ! indexing goes from shallowest to deepest levels + real(r8), allocatable :: zocn_levels(:) + ! upper and lower z-level limit for each class (m) + ! first dimension: indexing goes from shallowest to deepest levels + ! second dimension: index 1 is upper limit, index 2 is lower limit + real(r8), allocatable :: zocn_bnds(:,:) + + +contains + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_init_default(my_glc_nzoc) + ! + ! !DESCRIPTION: + ! Initialize GLC z-ocean class data to default values, based on given glc_nzoc + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: my_glc_nzoc ! number of GLC z-ocean classes + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_zocnclass_init' + integer :: i + !----------------------------------------------------------------------- + + glc_nzoc = my_glc_nzoc + allocate(zocn_levels(glc_nzoc)) + + select case (glc_nzoc) + case(0) + ! do nothing + case(4) + zocn_levels = [-250._r8, -750._r8, -1250._r8, -1750._r8] + case(30) + zocn_levels = [ -30._r8, -90._r8, -150._r8, -210._r8, -270._r8, & + -330._r8, -390._r8, -450._r8, -510._r8, -570._r8, & + -630._r8, -690._r8, -750._r8, -810._r8, -870._r8, & + -930._r8, -990._r8, -1050._r8, -1110._r8, -1170._r8, & + -1230._r8, -1290._r8, -1350._r8, -1410._r8, -1470._r8, & + -1530._r8, -1590._r8, -1650._r8, -1710._r8, -1770._r8] + case default + write(logunit,*) subname,' ERROR: unknown glc_nzoc: ', glc_nzoc + call shr_sys_abort(subname//' ERROR: unknown glc_nzoc') + end select + + call glc_zocnclass_init_bnds() + + end subroutine glc_zocnclass_init_default + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_init_bnds() + integer :: i + + allocate(zocn_bnds(2,glc_nzoc)) + zocn_bnds(:,:) = 0._r8 + if (glc_nzoc >= 2) then + zocn_bnds(1,1) = 0._r8 + zocn_bnds(2,1) = 0.5_r8 * (zocn_levels(1) + zocn_levels(2)) + do i = 2, glc_nzoc - 1 + zocn_bnds(1,i) = 0.5_r8 * (zocn_levels(i-1) + zocn_levels(i)) + zocn_bnds(2,i) = 0.5_r8 * (zocn_levels(i) + zocn_levels(i+1)) + enddo + zocn_bnds(1,glc_nzoc) = 0.5_r8 * (zocn_levels(glc_nzoc-1) + zocn_levels(glc_nzoc)) + zocn_bnds(2,glc_nzoc) = zocn_levels(glc_nzoc) + (zocn_levels(glc_nzoc) - zocn_bnds(1,glc_nzoc)) + endif + end subroutine glc_zocnclass_init_bnds + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_init_override(my_glc_nzoc, my_zocn_levels) + ! + ! !DESCRIPTION: + ! Initialize GLC zocn class data to the given z-values + ! + ! The input, my_zocn_levels, should have my_glc_nzoc elements. + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: my_glc_nzoc ! number of GLC z-ocean classes + real(r8), intent(in) :: my_zocn_levels(:) ! z-ocean values (m) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_zocnlass_init_override' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(my_zocn_levels) == (/my_glc_nzoc/)), __FILE__, __LINE__) + + glc_nzoc = my_glc_nzoc + allocate(zocn_levels(glc_nzoc)) + zocn_levels = my_zocn_levels + allocate(zocn_bnds(2,glc_nzoc)) + + call glc_zocnclass_init_bnds() + + end subroutine glc_zocnclass_init_override + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_clean() + ! + ! !DESCRIPTION: + ! Deallocate memory allocated in this module + + character(len=*), parameter :: subname = 'glc_zocnclass_clean' + !----------------------------------------------------------------------- + + if (allocated(zocn_levels)) then + deallocate(zocn_levels) + end if + if (allocated(zocn_bnds)) then + deallocate(zocn_bnds) + end if + glc_nzoc = 0 + + end subroutine glc_zocnclass_clean + + !----------------------------------------------------------------------- + function glc_get_num_zocn_classes() result(num_zocn_classes) + ! + ! !DESCRIPTION: + ! Get the number of GLC z-ocean classes + ! + ! !ARGUMENTS: + integer :: num_zocn_classes ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_num_zocn_classes' + !----------------------------------------------------------------------- + + num_zocn_classes = glc_nzoc + + end function glc_get_num_zocn_classes + + !----------------------------------------------------------------------- + function glc_get_zlevels() result(zlevs) + ! + ! !DESCRIPTION: + ! Get all z-levels + ! + ! This returns an array of size (glc_nzoc) + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: zlevs(glc_nzoc) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_zlevels' + !----------------------------------------------------------------------- + + zlevs(:) = zocn_levels(:) + + end function glc_get_zlevels + + !----------------------------------------------------------------------- + function glc_get_zocnclass_bounds() result(zocnclass_bounds) + ! + ! !DESCRIPTION: + ! Get the boundaries of all z-ocean classes. + ! + ! This returns an array of size (glc_nzoc,2) + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: zocnclass_bounds(2,glc_nzoc) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_zocnclass_bounds' + !----------------------------------------------------------------------- + + zocnclass_bounds(:,:) = zocn_bnds(:,:) + + end function glc_get_zocnclass_bounds + + !----------------------------------------------------------------------- + function glc_zocnclass_as_string(zocn_class) result(zc_string) + ! + ! !DESCRIPTION: + ! Returns a string corresponding to a given elevation class. + ! + ! This string can be used as a suffix for fields in MCT attribute vectors. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=GLC_ZOCNCLASS_STRLEN) :: zc_string ! function result + integer, intent(in) :: zocn_class + ! + ! !LOCAL VARIABLES: + character(len=16) :: format_string + + character(len=*), parameter :: subname = 'glc_zocnclass_as_string' + !----------------------------------------------------------------------- + + ! e.g., for GLC_ZOCNCLASS_STRLEN = 2, format_string will be '(i2.2)' + write(format_string,'(a,i0,a,i0,a)') '(i', GLC_ZOCNCLASS_STRLEN, '.', GLC_ZOCNCLASS_STRLEN, ')' + + write(zc_string,trim(format_string)) zocn_class + end function glc_zocnclass_as_string + + !----------------------------------------------------------------------- + function glc_all_zocnclass_strings(include_zero) result(zc_strings) + ! + ! !DESCRIPTION: + ! Returns an array of strings corresponding to all z-ocean classes from 1 to glc_nzoc + ! + ! If include_zero is present and true, then includes z-ocean class 0 - so goes from + ! 0 to glc_nzoc + ! + ! These strings can be used as suffixes for fields in MCT attribute vectors. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=GLC_ZOCNCLASS_STRLEN), allocatable :: zc_strings(:) ! function result + logical, intent(in), optional :: include_zero ! if present and true, include elevation class 0 (default is false) + ! + ! !LOCAL VARIABLES: + logical :: l_include_zero ! local version of optional include_zero argument + integer :: lower_bound + integer :: i + + character(len=*), parameter :: subname = 'glc_all_zocnclass_strings' + !----------------------------------------------------------------------- + + if (present(include_zero)) then + l_include_zero = include_zero + else + l_include_zero = .false. + end if + + if (l_include_zero) then + lower_bound = 0 + else + lower_bound = 1 + end if + + allocate(zc_strings(lower_bound:glc_nzoc)) + do i = lower_bound, glc_nzoc + zc_strings(i) = glc_zocnclass_as_string(i) + end do + + end function glc_all_zocnclass_strings + + + !----------------------------------------------------------------------- + function glc_zocn_errcode_to_string(err_code) result(err_string) + ! + ! !DESCRIPTION: + ! + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=256) :: err_string ! function result + integer, intent(in) :: err_code ! error code (one of the GLC_ZOCNCLASS_ERR* values) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_errcode_to_string' + !----------------------------------------------------------------------- + + select case (err_code) + case (GLC_ZOCNCLASS_ERR_NONE) + err_string = '(no error)' + case (GLC_ZOCNCLASS_ERR_UNDEFINED) + err_string = 'Z-ocean classes have not yet been defined' + case (GLC_ZOCNCLASS_ERR_TOO_LOW) + err_string = 'Z-level below the lower bound of the lowest z-ocean class' + case (GLC_ZOCNCLASS_ERR_TOO_HIGH) + err_string = 'Z-level above the upper bound of the highest z-ocean class' + case default + err_string = 'UNKNOWN ERROR' + end select + + end function glc_zocn_errcode_to_string + + +end module glc_zocnclass_mod diff --git a/driver-mct/shr/seq_flds_mod.F90 b/driver-mct/shr/seq_flds_mod.F90 index 883391e9dde0..fd66b7f9af86 100644 --- a/driver-mct/shr/seq_flds_mod.F90 +++ b/driver-mct/shr/seq_flds_mod.F90 @@ -293,6 +293,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) use shr_string_mod, only : shr_string_listIntersect use shr_mpi_mod, only : shr_mpi_bcast use glc_elevclass_mod, only : glc_elevclass_init + use glc_zocnclass_mod, only : glc_zocnclass_init use seq_infodata_mod, only : seq_infodata_type, seq_infodata_getdata ! !INPUT/OUTPUT PARAMETERS: @@ -386,10 +387,11 @@ subroutine seq_flds_set(nmlfile, ID, infodata) logical :: flds_polar logical :: flds_tf integer :: glc_nec + integer :: glc_nzoc namelist /seq_cplflds_inparm/ & flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, flds_polar, flds_tf, & - glc_nec, ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & + glc_nec, glc_nzoc, ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & nan_check_component_fields, rof_heat, atm_flux_method, atm_gustiness, & rof2ocn_nutrients, lnd_rof_two_way, ocn_rof_two_way, rof_sed, & wav_ocn_coup @@ -426,6 +428,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) flds_polar = .false. flds_tf = .false. glc_nec = 0 + glc_nzoc = 0 ice_ncat = 1 seq_flds_i2o_per_cat = .false. nan_check_component_fields = .false. @@ -462,6 +465,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(flds_polar , mpicom) call shr_mpi_bcast(flds_tf , mpicom) call shr_mpi_bcast(glc_nec , mpicom) + call shr_mpi_bcast(glc_nzoc , mpicom) call shr_mpi_bcast(ice_ncat , mpicom) call shr_mpi_bcast(seq_flds_i2o_per_cat, mpicom) call shr_mpi_bcast(nan_check_component_fields, mpicom) @@ -475,6 +479,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(wav_ocn_coup, mpicom) call glc_elevclass_init(glc_nec) + call glc_zocnclass_init(glc_nzoc) !--------------------------------------------------------------------------- ! Read in namelists for user specified new fields @@ -2996,18 +3001,33 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_rhoeff' call metadata_set(attname, longname, stdname, units) - if (flds_tf) then + if ((flds_tf) .and. (glc_nzoc > 0)) then + ! glc fields with multiple ocn z classes: ocn->glc + ! + ! Note that these fields are sent in multiple elevation classes from ocn->cpl + ! and cpl->ocn (which differs from glc_nec variables) - name = 'So_tf2d' - call seq_flds_add(o2x_states,trim(name)) - call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_tf_states_from_ocn,trim(name)) - longname = 'ocean thermal forcing at predefined critical depth' - stdname = 'ocean_thermal_forcing_at_critical_depth' + name = 'So_tf3d' + longname = 'ocean thermal forcing at z-level' + stdname = 'ocean_thermal_forcing_at_z_level' units = 'C' attname = name - call metadata_set(attname, longname, stdname, units) - + call set_glc_zocnclass_field(name, attname, longname, stdname, units, o2x_states) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_states, & + additional_list = .true.) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_tf_states_from_ocn, & + additional_list = .true.) + + name = 'So_tf3d_mask' + longname = 'mask of valid ocean thermal forcing at z-level' + stdname = 'mask_ocean_thermal_forcing_at_z_level' + units = 'none' + attname = name + call set_glc_zocnclass_field(name, attname, longname, stdname, units, o2x_states) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_states, & + additional_list = .true.) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_tf_states_from_ocn, & + additional_list = .true.) end if name = 'Fogx_qicelo' @@ -4331,6 +4351,66 @@ end subroutine set_glc_elevclass_field !=============================================================================== + subroutine set_glc_zocnclass_field(name, attname, longname, stdname, units, fieldlist, & + additional_list) + + ! Sets a coupling field for all ocn z classes (1:glc_nzoc) + ! + ! Note that, if glc_nzoc = 0, then we don't create any coupling fields + ! + ! Puts the coupling fields in the given fieldlist, and also does the appropriate + ! metadata_set calls. + ! + ! additional_list should be .false. (or absent) the first time this is called for a + ! given set of coupling fields. However, if this same set of coupling fields is being + ! added to multiple field lists, then additional_list should be set to true for the + ! second and subsequent calls; in this case, the metadata_set calls are not done + ! (because they have already been done). + ! + ! name, attname and longname give the base name of the field; the ocn z class + ! index will be appended as a suffix + + ! !USES: + use glc_zocnclass_mod, only : glc_get_num_zocn_classes, glc_zocnclass_as_string + + ! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: name ! base field name to add to fieldlist + character(len=*), intent(in) :: attname ! base field name for metadata + character(len=*), intent(in) :: longname ! base long name for metadata + character(len=*), intent(in) :: stdname ! standard name for metadata + character(len=*), intent(in) :: units ! units for metadata + character(len=*), intent(inout) :: fieldlist ! field list into which the fields should be added + + logical, intent(in), optional :: additional_list ! whether this is an additional list for the same set of coupling fields (see above for details; defaults to false) + + !EOP + integer :: num + character(len= 16) :: cnum + logical :: l_additional_list ! local version of the optional additional_list argument + + l_additional_list = .false. + if (present(additional_list)) then + l_additional_list = additional_list + end if + + if (glc_get_num_zocn_classes() > 0) then + do num = 1, glc_get_num_zocn_classes() + cnum = glc_zocnclass_as_string(num) + + call seq_flds_add(fieldlist, trim(name) // trim(cnum)) + + if (.not. l_additional_list) then + call metadata_set(attname = trim(attname) // trim(cnum), & + longname = trim(longname) // ' of thermal forcing class ' // trim(cnum), & + stdname = stdname, & + units = units) + end if + end do + end if + end subroutine set_glc_zocnclass_field + + !=============================================================================== + subroutine seq_flds_esmf_metadata_get(shortname, longname, stdname, units) ! !USES: diff --git a/driver-mct/shr/seq_infodata_mod.F90 b/driver-mct/shr/seq_infodata_mod.F90 index 233cc922ffd6..4a572fb899b2 100644 --- a/driver-mct/shr/seq_infodata_mod.F90 +++ b/driver-mct/shr/seq_infodata_mod.F90 @@ -214,6 +214,7 @@ MODULE seq_infodata_mod logical :: glcice_present ! does glc have iceberg coupling on logical :: glc_prognostic ! does component model need input data from driver logical :: glc_coupled_fluxes ! does glc send fluxes to other components (only relevant if glc_present is .true.) + integer :: glc_nzoc ! number of z-levels for ocn/glc thermal forcing coupling logical :: wav_present ! does component model exist logical :: wav_prognostic ! does component model need input data from driver logical :: esp_present ! does component model exist @@ -779,6 +780,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) ! if glc_present is .false., so it's okay to just start out assuming it's .true. ! in all cases. infodata%glc_coupled_fluxes = .true. + infodata%glc_nzoc = 0 infodata%wav_prognostic = .false. infodata%iac_prognostic = .false. infodata%iceberg_prognostic = .false. @@ -1019,7 +1021,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ ice_present, ice_prognostic, & glc_present, glc_prognostic, & iac_present, iac_prognostic, & - glc_coupled_fluxes, & + glc_coupled_fluxes, glc_nzoc, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & @@ -1202,6 +1204,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: glcice_present logical, optional, intent(OUT) :: glc_prognostic logical, optional, intent(OUT) :: glc_coupled_fluxes + integer, optional, intent(OUT) :: glc_nzoc logical, optional, intent(OUT) :: wav_present logical, optional, intent(OUT) :: wav_prognostic logical, optional, intent(OUT) :: iac_present @@ -1391,6 +1394,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(glcice_present) ) glcice_present = infodata%glcice_present if ( present(glc_prognostic) ) glc_prognostic = infodata%glc_prognostic if ( present(glc_coupled_fluxes)) glc_coupled_fluxes = infodata%glc_coupled_fluxes + if ( present(glc_nzoc) ) glc_nzoc = infodata%glc_nzoc if ( present(wav_present) ) wav_present = infodata%wav_present if ( present(wav_prognostic) ) wav_prognostic = infodata%wav_prognostic if ( present(esp_present) ) esp_present = infodata%esp_present @@ -1579,7 +1583,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ ocn_c2_glcshelf, ocn_c2_glctf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & - glc_coupled_fluxes, & + glc_coupled_fluxes, glc_nzoc, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & @@ -1763,6 +1767,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: glcice_present logical, optional, intent(IN) :: glc_prognostic logical, optional, intent(IN) :: glc_coupled_fluxes + integer, optional, intent(IN) :: glc_nzoc logical, optional, intent(IN) :: wav_present logical, optional, intent(IN) :: wav_prognostic logical, optional, intent(IN) :: esp_present @@ -1951,6 +1956,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glcice_present) ) infodata%glcice_present = glcice_present if ( present(glc_prognostic) ) infodata%glc_prognostic = glc_prognostic if ( present(glc_coupled_fluxes)) infodata%glc_coupled_fluxes = glc_coupled_fluxes + if ( present(glc_nzoc) ) infodata%glc_nzoc = glc_nzoc if ( present(wav_present) ) infodata%wav_present = wav_present if ( present(wav_prognostic) ) infodata%wav_prognostic = wav_prognostic if ( present(iac_present) ) infodata%iac_present = iac_present @@ -2266,6 +2272,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glcice_present, mpicom) call shr_mpi_bcast(infodata%glc_prognostic, mpicom) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom) + call shr_mpi_bcast(infodata%glc_nzoc, mpicom) call shr_mpi_bcast(infodata%wav_present, mpicom) call shr_mpi_bcast(infodata%wav_prognostic, mpicom) call shr_mpi_bcast(infodata%esp_present, mpicom) @@ -2572,6 +2579,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%glcice_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%glc_nzoc, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_ny, mpicom, pebcast=cmppe) ! dead_comps is true if it's ever set to true @@ -2631,6 +2639,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%glcice_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%glc_nzoc, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%iac_present, mpicom, pebcast=cplpe) @@ -2992,6 +3001,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'glcice_present = ', infodata%glcice_present write(logunit,F0L) subname,'glc_prognostic = ', infodata%glc_prognostic write(logunit,F0L) subname,'glc_coupled_fluxes = ', infodata%glc_coupled_fluxes + write(logunit,F0L) subname,'glc_nzoc = ', infodata%glc_nzoc write(logunit,F0L) subname,'wav_present = ', infodata%wav_present write(logunit,F0L) subname,'wav_prognostic = ', infodata%wav_prognostic write(logunit,F0L) subname,'iac_present = ', infodata%iac_present diff --git a/driver-moab/cime_config/buildnml b/driver-moab/cime_config/buildnml index cfaa3c63f8bc..ce3ed839635d 100755 --- a/driver-moab/cime_config/buildnml +++ b/driver-moab/cime_config/buildnml @@ -41,12 +41,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['CPL_EPBAL'] = case.get_value('CPL_EPBAL') config['FLDS_WISO'] = case.get_value('FLDS_WISO') config['FLDS_POLAR'] = case.get_value('FLDS_POLAR') + config['FLDS_TF'] = case.get_value('FLDS_TF') config['BUDGETS'] = case.get_value('BUDGETS') config['MACH'] = case.get_value('MACH') config['MPILIB'] = case.get_value('MPILIB') config['MULTI_DRIVER'] = '.true.' if case.get_value('MULTI_DRIVER') else '.false.' config['OS'] = case.get_value('OS') config['glc_nec'] = 0 if case.get_value('GLC_NEC') == 0 else case.get_value('GLC_NEC') + config['glc_nzoc'] = 0 if case.get_value('GLC_NZOC') == 0 else case.get_value('GLC_NZOC') config['single_column'] = 'true' if case.get_value('PTS_MODE') else 'false' config['timer_level'] = 'pos' if case.get_value('TIMER_LEVEL') >= 1 else 'neg' config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' @@ -68,6 +70,20 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value('RUN_TYPE') == 'branch': config['run_type'] = 'branch' + # --------------------------------------------------- + # set wave coupling settings based on compset: + # --------------------------------------------------- + if case.get_value('COMP_WAV') == 'ww3': + config['WAVSPEC'] = case.get_value('WAV_SPEC') + if case.get_value('COMP_OCN') == 'mpaso': + config['WAV_OCN_COUP'] = 'twoway' + elif case.get_value('COMP_OCN') == 'docn': + config['WAV_OCN_COUP'] = 'oneway' + elif case.get_value('COMP_WAV') == 'dwav': + config['WAVSPEC'] = 'sp36x36' + else: + config['WAVSPEC'] = 'none' + #---------------------------------------------------- # Initialize namelist defaults #---------------------------------------------------- diff --git a/driver-moab/cime_config/config_archive.xml b/driver-moab/cime_config/config_archive.xml index cd22504cbcd7..e5d1cea661ce 100644 --- a/driver-moab/cime_config/config_archive.xml +++ b/driver-moab/cime_config/config_archive.xml @@ -17,7 +17,7 @@ casename.cpl.ha2x1d.1976-01-01-00000.nc casename.cpl.ha2x1h.1976-01-01-00000.nc casename.cpl.hl2x1yr_glc.1976-01-01-00000.nc - rpointer.drv_0001 + rpointer.drv_0001 rpointer.drv casenamenot.cpl.r.1976-01-01-00000.nc diff --git a/driver-moab/cime_config/config_component_e3sm.xml b/driver-moab/cime_config/config_component_e3sm.xml index cb49f99a2fd5..628892595365 100644 --- a/driver-moab/cime_config/config_component_e3sm.xml +++ b/driver-moab/cime_config/config_component_e3sm.xml @@ -847,6 +847,24 @@ Used by both ELM and CISM (even if CISM is not running, and only SGLC is used). + + integer + 0,4,30 + 0 + + 30 + 0 + 0 + 0 + 0 + + run_glc + env_run.xml + Glacier model number of z-ocean classes, 0 implies no OCN z-level coupling to GLC or + GLC is inactive. + Used by both OCN and GLC components. + + logical TRUE,FALSE diff --git a/driver-moab/cime_config/namelist_definition_drv.xml b/driver-moab/cime_config/namelist_definition_drv.xml index 2cb676573cb9..12117982b466 100644 --- a/driver-moab/cime_config/namelist_definition_drv.xml +++ b/driver-moab/cime_config/namelist_definition_drv.xml @@ -149,6 +149,18 @@ + + logical + seq_flds + seq_cplflds_inparm + + If set to .true. thermal forcing fields will be passed from the ocean to the coupler. + + + $FLDS_TF + + + logical seq_flds @@ -193,6 +205,18 @@ + + integer + seq_flds + seq_cplflds_inparm + + Number of GLC z-ocean classes. Set by the xml variable GLC_NZOC in env_run.xml + + + $GLC_NZOC + + + integer seq_flds @@ -290,6 +314,18 @@ .false. + + + char + seq_flds + seq_cplflds_inparm + One- or Two-way coupling between Wave and Ocn. + + none + oneway + twoway + + diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index ad0edae64edb..e95cddda8c22 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -452,6 +452,8 @@ module cime_comp_mod logical :: lnd_c2_glc ! .true. => lnd to glc coupling on logical :: ocn_c2_atm ! .true. => ocn to atm coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on + logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on + integer :: glc_nzoc ! number of z-levels for ocn/glc TF coupling logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on logical :: ocn_c2_rof ! .true. => ocn to rof coupling on @@ -569,7 +571,7 @@ module cime_comp_mod 'Sa_u:Sa_v' character(CL) :: hist_a2x3hr_flds = & - 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:& + 'Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:& &Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:& &Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:& &Sa_co2diag:Sa_co2prog' @@ -1705,6 +1707,8 @@ subroutine cime_init() ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & ocn_c2_glcshelf=ocn_c2_glcshelf, & + ocn_c2_glctf=ocn_c2_glctf, & + glc_nzoc=glc_nzoc, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & rofocn_prognostic=rofocn_prognostic, & @@ -1801,6 +1805,7 @@ subroutine cime_init() if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm if (ice_prognostic) ocn_c2_ice = .true. + if (glc_prognostic .and. (glc_nzoc > 0)) ocn_c2_glctf = .true. if (wav_prognostic) ocn_c2_wav = .true. if (rofocn_prognostic) ocn_c2_rof = .true. @@ -2539,7 +2544,7 @@ subroutine cime_init() call shr_sys_flush(logunit) end if call t_startf('CPL:seq_rest_read-moab') - call seq_rest_mb_read(rest_file, infodata, samegrid_al) + call seq_rest_mb_read(rest_file, infodata, samegrid_al, samegrid_lr) call t_stopf('CPL:seq_rest_read-moab') #ifdef MOABDEBUG call write_moab_state(.false.) @@ -3529,7 +3534,7 @@ subroutine cime_run() call shr_sys_flush(logunit) end if call t_startf('CPL:seq_rest_read-moab') - call seq_rest_mb_read(drv_resume_file, infodata, samegrid_al) + call seq_rest_mb_read(drv_resume_file, infodata, samegrid_al, samegrid_lr) call t_stopf('CPL:seq_rest_read-moab') end if ! Clear the resume file so we don't try to read it again @@ -5388,7 +5393,7 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) call t_startf('CPL:seq_rest_mb_write') call seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & - trim(cpl_inst_tag), samegrid_al, drv_moab_resume_file) + trim(cpl_inst_tag), samegrid_al, samegrid_lr, drv_moab_resume_file) call t_stopf('CPL:seq_rest_mb_write') if (iamroot_CPLID) then diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index c250634cad6c..8d1bd2081e23 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -470,6 +470,7 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, use iso_c_binding ! character(1024) :: domain_file ! file containing domain info (set my input) use seq_comm_mct, only: mboxid ! iMOAB id for MPAS ocean migrated mesh to coupler pes + use seq_comm_mct, only: mblxid ! iMOAB id for lnd migrated mesh to coupler pes use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only: mbrxid ! iMOAB id for rof migrated mesh to coupler pes #endif @@ -551,18 +552,6 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, ! project now aream on ocean (from atm) #endif call seq_map_map(mapper_Fa2o, av_s=dom_s%data, av_d=dom_d%data, fldlist='aream') - -#ifdef HAVE_MOAB -#ifdef MOABDEBUG - ierr = iMOAB_WriteMesh(mboxid, trim('recMeshOcnWithArea.h5m'//C_NULL_CHAR), & - trim(';PARALLEL=WRITE_PART'//C_NULL_CHAR)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean mesh coupler ' - call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') - endif -#endif -#endif - else gsmap_s => component_get_gsmap_cx(ocn(1)) ! gsmap_ox @@ -644,6 +633,40 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, endif endif +#ifdef MOABDEBUG + if(mbaxid >=0 ) then + ierr = iMOAB_WriteMesh(mbaxid, trim('cplAtmWithAream.h5m'//C_NULL_CHAR), & + trim(';PARALLEL=WRITE_PART'//C_NULL_CHAR)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing atm mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing atm mesh coupler ') + endif + endif + if(mblxid >=0 ) then + ierr = iMOAB_WriteMesh(mblxid, trim('cplLndWithAream.h5m'//C_NULL_CHAR), & + trim(';PARALLEL=WRITE_PART'//C_NULL_CHAR)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing lnd mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing lnd mesh coupler ') + endif + endif + if(mboxid >=0 ) then + ierr = iMOAB_WriteMesh(mboxid, trim('cplOcnWithAream.h5m'//C_NULL_CHAR), & + trim(';PARALLEL=WRITE_PART'//C_NULL_CHAR)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocn mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh coupler ') + endif + endif + if(mbrxid >=0 ) then + ierr = iMOAB_WriteMesh(mbrxid, trim('cplRofWithAream.h5m'//C_NULL_CHAR), & + trim(';PARALLEL=WRITE_PART'//C_NULL_CHAR)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing rof mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing rof mesh coupler ') + endif + endif +#endif end subroutine component_init_aream @@ -734,18 +757,22 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe integer :: mpi_tag character(*), parameter :: subname = '(component_init_areacor_moab)' character(CXX) :: tagname + character(CXX) :: comment integer :: tagtype, numco, tagindex, lsize, i, j, arrsize, ierr, nfields real (kind=r8) , allocatable :: areas (:,:), factors(:,:), vals(:,:) ! 2 tags values, area, aream, - real (kind=r8) :: rarea, raream, rmask, fact + real (kind=r8) :: rarea, raream, rmask, fact, rmin1, rmax1, rmin, rmax integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) type(mct_list) :: temp_list ! used to count number of fields + integer :: mpicom + logical :: iamroot + character(len=*),parameter :: F0R = "(2A,2g23.15,A )" !--------------------------------------------------------------- if (comp(1)%iamin_cplcompid) then tagname='aream'//C_NULL_CHAR ! bring on the comp side the aream from maps ! (it is either computed by mapping routine or read from mapping files) - call component_exch_moab(comp(1), mbcxid, mbccid, 1, tagname) + call component_exch_moab(comp(1), mbcxid, mbccid, 1, tagname, context_exch='aream') ! For only component pes if (comp(1)%iamin_compid) then @@ -795,6 +822,23 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe call shr_sys_abort(subname//' cannot set correction area factors ') endif +! print the computed values for area factors + rmin1 = minval(factors(:,1)) + rmax1 = maxval(factors(:,1)) + mpicom = comp(1)%mpicom_compid + iamroot= comp(1)%iamroot_compid + call shr_mpi_min(rmin1,rmin,mpicom) + call shr_mpi_max(rmax1,rmax,mpicom) + comment = 'areafact_'//trim(comp(1)%name) + if (iamroot) write(logunit,F0R) trim(subname),' : min/max mdl2drv ',rmin,rmax,trim(comment) + + rmin1 = minval(factors(:,2)) + rmax1 = maxval(factors(:,2)) + call shr_mpi_min(rmin1,rmin,mpicom) + call shr_mpi_max(rmax1,rmax,mpicom) + if (iamroot) write(logunit,F0R) trim(subname),' : min/max drv2mdl ',rmin,rmax,trim(comment) + if (iamroot) call shr_sys_flush(logunit) + ! Area correct component initialization output fields ! need to multiply fluxes (correct them) with mdl2drv (factors(i,1)) ! so get all fluxes (tags) multiply with factor(i,1), according to mask @@ -836,7 +880,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe endif ! send data to coupler exchange ? everything, not only fluxes ? - call component_exch_moab(comp(1), mbccid, mbcxid, 0, seq_flds_c2x_fields) + call component_exch_moab(comp(1), mbccid, mbcxid, 0, seq_flds_c2x_fields, context_exch='areacor') endif end subroutine component_init_areacor_moab diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index ebb3ad8f58e3..e42acf207d38 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -421,6 +421,7 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en use shr_mpi_mod, only: shr_mpi_sum use shr_kind_mod, only: CXX => shr_kind_CXX + use shr_kind_mod , only: IN=>SHR_KIND_IN use seq_comm_mct , only : CPLID, seq_comm_iamroot use seq_comm_mct, only: seq_comm_setptrs use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & @@ -431,20 +432,22 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en type(component_type), intent(in) :: comp integer , intent(in) :: appId, ent_type type(mct_aVect) , intent(in), pointer :: attrVect + type(mct_gsmap), pointer :: gsmap character(*) , intent(in) :: mct_field character(*) , intent(in) :: tagname + integer(IN), pointer :: dof(:) real(r8) , intent(out) :: difference logical , intent(in) :: first_time real(r8) :: differenceg ! global, reduced diff - type(mct_ggrid), pointer :: dom - integer :: kgg, mbSize, nloc, index_avfield + !type(mct_ggrid), pointer :: dom + integer :: kgg, mbSize, nloc, index_avfield, my_task ! moab integer :: tagtype, numco, tagindex, ierr character(CXX) :: tagname_mct - integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + !integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids real(r8) , allocatable :: values(:), mct_values(:) integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) @@ -457,11 +460,15 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en call seq_comm_setptrs(CPLID, mpicom=mpicom) nloc = mct_avect_lsize(attrVect) - allocate(GlobalIds(nloc)) + !allocate(GlobalIds(nloc)) allocate(values(nloc)) - dom => component_get_dom_cx(comp) - kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) - GlobalIds = dom%data%iAttr(kgg,:) + !dom => component_get_dom_cx(comp) + !kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) + !GlobalIds = dom%data%iAttr(kgg,:) + gsmap => component_get_gsmap_cx(comp) ! gsmap_x + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap, my_task, dof) index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) values(:) = attrVect%rAttr(index_avfield,:) @@ -476,7 +483,7 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en if (ierr > 0 ) & call shr_sys_abort(subname//'Error: fail to define new tag for mct') endif - ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname_mct, nloc , ent_type, values, GlobalIds ) + ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname_mct, nloc , ent_type, values, dof ) if (ierr > 0 ) & call shr_sys_abort(subname//'Error: fail to set new tags') @@ -511,7 +518,8 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en print * , subname, trim(comp%ntype), ' on cpl, difference on tag ', trim(tagname), ' = ', difference !call shr_sys_abort(subname//'differences between mct and moab values') endif - deallocate(GlobalIds) + !deallocate(GlobalIds) + deallocate (dof) deallocate(values) deallocate(mct_values) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 8975a9e9e62f..04557558ea1c 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -60,6 +60,7 @@ module cplcomp_exchange_mod private :: seq_mctext_gsmapCreate private :: seq_mctext_avCreate + private :: copy_aream_from_area !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- @@ -981,7 +982,34 @@ logical function seq_mctext_gsmapIdentical(gsmap1,gsmap2) end function seq_mctext_gsmapIdentical +subroutine copy_aream_from_area(mbappid) + + ! maybe we will move this from here + use iMOAB, only: iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage, iMOAB_GetMeshInfo + + integer , intent(in) :: mbappid + character(CXX) :: tagname + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + real(r8), allocatable :: tagValues(:) ! used for setting aream tags for atm domain read case + integer :: arrSize ! for the size of tagValues + integer :: ierr, ent_type + + ! copy aream from area + if (mbappid >= 0) then ! coupler atm procs + ierr = iMOAB_GetMeshInfo ( mbappid, nvert, nvise, nbl, nsurf, nvisBC ) + arrSize = nvise(1) ! cells + allocate(tagValues(arrSize)) + tagname = 'area'//C_NULL_CHAR + ent_type = 1 ! cells + ierr = iMOAB_GetDoubleTagStorage( mbappid, tagname, arrsize , ent_type, tagValues ) + tagname = 'aream'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage( mbappid, tagname, arrsize , ent_type, tagValues ) + deallocate(tagValues) + endif + + return !======================================================================= + end subroutine copy_aream_from_area subroutine cplcomp_moab_Init(infodata,comp) @@ -999,6 +1027,7 @@ subroutine cplcomp_moab_Init(infodata,comp) ! type(seq_infodata_type) , intent(in) :: infodata type(component_type), intent(inout) :: comp + ! ! Local Variables ! @@ -1015,7 +1044,7 @@ subroutine cplcomp_moab_Init(infodata,comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes integer :: ierr, context_id - character*200 :: appname, outfile, wopts, ropts + character*200 :: appname, outfile, wopts, ropts, infile character(CL) :: rtm_mesh, rof_domain character(CL) :: lnd_domain character(CL) :: ocn_domain @@ -1028,6 +1057,8 @@ subroutine cplcomp_moab_Init(infodata,comp) ! and atm spectral on coupler character(CXX) :: tagname integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + real(r8), allocatable :: tagValues(:) ! used for setting aream tags for atm domain read case + integer :: arrSize ! for the size of tagValues ! type(mct_list) :: temp_list ! integer :: nfields, arrsize ! real(R8), allocatable, target :: values(:) @@ -1112,15 +1143,17 @@ subroutine cplcomp_moab_Init(infodata,comp) endif else ! data atm ! we need to read the atm mesh on coupler, from domain file - ierr = iMOAB_LoadMesh(mbaxid, trim(atm_mesh)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;REPARTITION;NO_CULLING", 0) + infile = trim(atm_mesh)//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;REPARTITION;NO_CULLING'//C_NULL_CHAR + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' loading atm domain mesh from file '//trim(atm_mesh) & + , ' with options ' // trim(ropts) + endif + ierr = iMOAB_LoadMesh(mbaxid, infile, ropts, 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load atm domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load atm domain mesh on coupler ') endif - if (seq_comm_iamroot(CPLID)) then - write(logunit,'(A)') subname//' load atm domain mesh from file '//trim(atm_mesh) - endif ! right now, turn atm_pg_active to true atm_pg_active = .true. ! FIXME TODO ! need to add global id tag to the app, it will be used in restart @@ -1202,8 +1235,9 @@ subroutine cplcomp_moab_Init(infodata,comp) ! also, frac, area, masks has to come from atm mphaid, not from domain file reader ! this is hard to digest :( tagname = 'lat:lon:area:frac:mask'//C_NULL_CHAR - call component_exch_moab(comp, mphaid, mbaxid, 0, tagname) - + call component_exch_moab(comp, mphaid, mbaxid, 0, tagname, context_exch='dom') + ! copy aream from area in case atm_mesh + call copy_aream_from_area(mbaxid) endif ! coupler pes #ifdef MOABDEBUG @@ -1284,11 +1318,13 @@ subroutine cplcomp_moab_Init(infodata,comp) endif else ! we need to read the ocean mesh on coupler, from domain file + infile = trim(ocn_domain)//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION'//C_NULL_CHAR if (seq_comm_iamroot(CPLID)) then - write(logunit,'(A)') subname//' loading ocn domain mesh from file '//trim(ocn_domain) + write(logunit,'(A)') subname//' loading ocn domain mesh from file '//trim(infile) & + , ' with options ' // trim(ropts) endif - ierr = iMOAB_LoadMesh(mboxid, trim(ocn_domain)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION", 0) + ierr = iMOAB_LoadMesh(mboxid, infile, ropts, 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load ocean domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load ocean domain mesh on coupler ') @@ -1364,7 +1400,7 @@ subroutine cplcomp_moab_Init(infodata,comp) ! also, frac, area, masks has to come from ocean mpoid, not from domain file reader ! this is hard to digest :( tagname = 'area:frac:mask'//C_NULL_CHAR - call component_exch_moab(comp, mpoid, mboxid, 0, tagname) + call component_exch_moab(comp, mpoid, mboxid, 0, tagname, context_exch='afm') endif ! start copy @@ -1398,15 +1434,17 @@ subroutine cplcomp_moab_Init(infodata,comp) endif else ! we need to read the ocean mesh on coupler, from domain file - ierr = iMOAB_LoadMesh(mbofxid, trim(ocn_domain)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION", 0) + infile = trim(ocn_domain)//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION'//C_NULL_CHAR + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' load ocn domain mesh from file for second ocn instance '//trim(ocn_domain) & + , ' with options '//trim(ropts) + endif + ierr = iMOAB_LoadMesh(mbofxid, infile, ropts, 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load second ocean domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load second ocean domain mesh on coupler ') endif - if (seq_comm_iamroot(CPLID)) then - write(logunit,'(A)') subname//' load ocn domain mesh from file for second ocn instance '//trim(ocn_domain) - endif ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1441,6 +1479,7 @@ subroutine cplcomp_moab_Init(infodata,comp) endif ! end copy #ifdef MOABDEBUG + if (mbofxid >= 0) then outfile = 'recMeshOcnF.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ! write out the mesh file to disk @@ -1449,6 +1488,7 @@ subroutine cplcomp_moab_Init(infodata,comp) write(logunit,*) subname,' error in writing ocean mesh coupler ' call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') endif + endif #endif endif ! end ocean @@ -1475,7 +1515,7 @@ subroutine cplcomp_moab_Init(infodata,comp) outfile = trim(lnd_domain)//C_NULL_CHAR nghlay = 0 ! no ghost layers if (seq_comm_iamroot(CPLID) ) then - write(logunit, *) "load land domain file from file: ", trim(lnd_domain), & + write(logunit, *) "loading land domain file from file: ", trim(lnd_domain), & " with options: ", trim(ropts) endif ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) @@ -1483,9 +1523,6 @@ subroutine cplcomp_moab_Init(infodata,comp) write(logunit,*) subname,' error in reading land coupler mesh from ', trim(lnd_domain) call shr_sys_abort(subname//' ERROR in reading land coupler mesh') endif - if (seq_comm_iamroot(CPLID)) then - write(logunit,'(A)') subname//' load lnd domain mesh from file '//trim(lnd_domain) - endif ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1540,7 +1577,7 @@ subroutine cplcomp_moab_Init(infodata,comp) endif tagname = 'lat:lon:area:frac:mask'//C_NULL_CHAR - call component_exch_moab(comp, mlnid, mblxid, 0, tagname) + call component_exch_moab(comp, mlnid, mblxid, 0, tagname, context_exch='dom') #ifdef MOABDEBUG outfile = 'recMeshLand.h5m'//C_NULL_CHAR @@ -1603,15 +1640,17 @@ subroutine cplcomp_moab_Init(infodata,comp) endif else ! we need to read the mesh ice (domain file) - ierr = iMOAB_LoadMesh(mbixid, trim(ice_domain)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION", 0) + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION'//C_NULL_CHAR + infile = trim(ice_domain)//C_NULL_CHAR + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' loading ice domain mesh from file '//infile & + , ' with options '//trim(ropts) + endif + ierr = iMOAB_LoadMesh(mbixid, infile, ropts, 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load ice domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load ice domain mesh on coupler ') endif - if (seq_comm_iamroot(CPLID)) then - write(logunit,'(A)') subname//' load ice domain mesh from file '//trim(ice_domain) - endif ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1715,7 +1754,7 @@ subroutine cplcomp_moab_Init(infodata,comp) appname = "COUPLE_MROF"//C_NULL_CHAR ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) - ! load mesh from scrip file passed from river model + ! load mesh from scrip file passed from river model, if domain file is not available call seq_infodata_GetData(infodata,rof_mesh=rtm_mesh,rof_domain=rof_domain) if ( trim(rof_domain) == 'none' ) then outfile = trim(rtm_mesh)//C_NULL_CHAR @@ -1725,14 +1764,14 @@ subroutine cplcomp_moab_Init(infodata,comp) ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;REPARTITION'//C_NULL_CHAR endif nghlay = 0 ! no ghost layers - ierr = iMOAB_LoadMesh(mbrxid, outfile, ropts, nghlay) if (seq_comm_iamroot(CPLID)) then - write(logunit,'(A)') subname//' load rof from file '//trim(outfile) + write(logunit,'(A)') subname//' loading rof from file '//trim(outfile) & + , ' with options ', trim(ropts) endif + ierr = iMOAB_LoadMesh(mbrxid, outfile, ropts, nghlay) if ( ierr .ne. 0 ) then call shr_sys_abort( subname//' ERROR: cannot read rof mesh on coupler' ) end if - ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1785,23 +1824,19 @@ subroutine cplcomp_moab_Init(infodata,comp) tagname = 'area:lon:lat:frac:mask'//C_NULL_CHAR call component_exch_moab(comp, mrofid, mbrxid, 0, tagname) - - ! if (mrofid .ge. 0) then ! we are on component rof pes - ! context_id = id_join - ! ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in freeing buffers ' - ! call shr_sys_abort(subname//' ERROR in freeing buffers ') - ! endif - ! endif + ! copy aream from area in all cases + ! initialize aream from area; it may have different values in the end, or reset again + call copy_aream_from_area(mbrxid) #ifdef MOABDEBUG - outfile = 'recMeshRof.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing rof mesh on coupler ' - call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') + if (mbrxid >= 0) then + outfile = 'recMeshRof.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing rof mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') + endif endif #endif endif ! end for rof coupler set up @@ -1811,7 +1846,7 @@ end subroutine cplcomp_moab_Init ! can exchange data between mesh in component and mesh on coupler. Either way. ! used in first hop of 2-hop - subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) + subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields, context_exch ) use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers use seq_comm_mct, only : num_moab_exports ! for debugging @@ -1825,6 +1860,7 @@ subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) ! direction 0 is from component to coupler; 1 is from coupler to component integer, intent(in) :: mbAPPid1, mbAppid2, direction character(CXX) , intent(in) :: fields + character(len=*) , intent(in), optional :: context_exch character(*), parameter :: subname = '(component_exch_moab)' integer :: id_join, source_id, target_id, ierr @@ -1854,8 +1890,25 @@ subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) if (comp%oneletterid == 'a' .and. direction .eq. 1 ) then target_id = target_id + 200 endif - if (mbAPPid1 .ge. 0) then ! send - + if (mbAPPid1 .ge. 0) then ! we are on the sending pes +#ifdef MOABDEBUG + if (direction .eq. 0 ) then + dir = 'c2x' + else + dir = 'x2c' + endif + write(lnum,"(I0.2)") num_moab_exports + if (present(context_exch)) then + outfile = comp%ntype//'_src_'//trim(context_exch)//'_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR + else + outfile = comp%ntype//'_src_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR + endif + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbAPPid1, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot write file '// outfile) + endif +#endif ! basically, use the initial partitioning ierr = iMOAB_SendElementTag(mbAPPid1, tagName, mpicom_join, target_id) if (ierr .ne. 0) then @@ -1884,14 +1937,18 @@ subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) else dir = 'x2c' endif + write(lnum,"(I0.2)") num_moab_exports if (seq_comm_iamroot(CPLID) ) then - write(logunit,'(A)') subname//' '//comp%ntype//' called in direction '//trim(dir)//' for fields '//trim(tagname) + write(logunit,'(A)') subname//' '//comp%ntype//' at moab count '//trim(lnum)//' called in direction '//trim(dir)//' for fields '//trim(tagname) endif if (mbAPPid2 .ge. 0 ) then ! we are on receiving pes, for sure ! number_proj = number_proj+1 ! count the number of projections - write(lnum,"(I0.2)") num_moab_exports - outfile = comp%ntype//'_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR + if (present(context_exch)) then + outfile = comp%ntype//'_'//trim(context_exch)//'_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR + else + outfile = comp%ntype//'_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR + endif wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mbAPPid2, trim(outfile), trim(wopts)) if (ierr .ne. 0) then diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 6e0d0ffef57d..7ea2560ab8df 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -127,7 +127,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & iMOAB_WriteMesh , iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_DefineTagStorage, iMOAB_ComputeCoverageMesh + iMOAB_DefineTagStorage, iMOAB_MigrateMapMesh !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and mappers @@ -275,6 +275,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_So2a%src_context = ocn(1)%cplcompid mapper_So2a%weight_identifier = wgtIdo2a mapper_So2a%mbname = 'mapper_So2a' + mapper_So2a%intx_context = idintx ! Since we are projecting fields from OCN to ATM-PHY grid, we need to define ! OCN o2x fields to ATM-PHY grid (or ATM-DYN (spectral) ) on coupler side @@ -294,14 +295,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if (.not. samegrid_ao) then ! most cases - ! compute the OCN coverage mesh here on coupler pes - ! OCN mesh was redistributed to cover target (ATM) partition - ierr = iMOAB_ComputeCoverageMesh( mboxid, mbaxid, mbintxoa ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source OCN coverage mesh for ATM' - call shr_sys_abort(subname//' ERROR in computing OCN-ATM coverage') - endif - if (compute_maps_online_o2a) then if (iamroot_CPLID) then write(logunit,*) '....Computing weights' @@ -316,36 +309,29 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif #ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 3) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_oa_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing OCN-ATM intersection file ' - call shr_sys_abort(subname//' ERROR in writing OCN-ATM intersection file ') + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 3) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_oa_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing OCN-ATM intersection file ' + call shr_sys_abort(subname//' ERROR in writing OCN-ATM intersection file ') + endif endif - endif ! endif for MOABDEBUG #endif - endif ! if .not.loadmapsfromdisk - - ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the - ! ocean for the intx ocean-atm context (coverage) - type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway - type2 = 3; - ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - ocn(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, ocn-atm' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocn-atm') - endif - - ! now take care of the mapper - mapper_So2a%intx_context = idintx - - if (compute_maps_online_o2a) then + ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the + ! ocean for the intx ocean-atm context (coverage) + type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + ocn(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ocn-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocn-atm') + endif if (atm_pg_active) then dm2 = "fv"//C_NULL_CHAR @@ -383,10 +369,19 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif else type1 = 3 ! this is type of grid, maybe should be saved on imoab app ? - call moab_map_init_rcfile( mboxid, mbaxid, mbintxoa, type1, & 'seq_maps.rc', 'ocn2atm_smapname:', 'ocn2atm_smaptype:',samegrid_ao, & wgtIdo2a, 'mapper_So2a MOAB init', esmf_map_flag) + ! need to call migrate map mesh, which will compute the cov mesh and + ! comm graph too for coverage mesh + context_id = idintx ! intx id + ierr = iMOAB_MigrateMapMesh (mboxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, ocn(1)%cplcompid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating ocn mesh for map ocn c2 atm ' + call shr_sys_abort(subname//' ERROR in migrating ocn mesh for map ocn c2 atm ') + endif + endif else ! samegrid_ao = TRUE @@ -543,7 +538,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','ice2atm_smapname:','ice2atm_smaptype:',samegrid_ao, & 'mapper_Si2a initialization',esmf_map_flag, no_match) ! similar to ocn-atm mapping, do ice 2 atm mapping / set up - #ifdef HAVE_MOAB ! Call moab intx only if ATM and ICE are init in moab coupler if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then @@ -551,7 +545,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) ' ' write(logunit,F00) 'Initializing MOAB mapper_Si2a' endif - appname = "ICE_ATM_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between ice and atm mesh idintx = 100*ice(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it @@ -560,15 +553,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in registering ice atm intx' call shr_sys_abort(subname//' ERROR in registering ice atm intx') endif - - ! compute the ATM coverage mesh here on coupler pes - ! ATM mesh was redistributed to cover target (OCN) partition - ierr = iMOAB_ComputeCoverageMesh( mbixid, mbaxid, mbintxia ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source ICE coverage mesh for ATM' - call shr_sys_abort(subname//' ERROR in computing ICE-ATM coverage') - endif - + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) if (compute_maps_online_i2a) then ierr = iMOAB_ComputeMeshIntersectionOnSphere ( mbixid, mbaxid, mbintxia ) if (ierr .ne. 0) then @@ -578,19 +563,29 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between ice and atm with id:', idintx endif - endif - - ! we also need to compute the comm graph for the second hop, from the ice on coupler to the - ! ice for the intx ice-atm context (coverage) - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) - - type1 = 3; ! fv for ice and atm; fv-cgll does not work anyway - type2 = 3; - ierr = iMOAB_ComputeCommGraph( mbixid, mbintxia, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - ice(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') + ! we also need to compute the comm graph for the second hop, from the ice on coupler to the + ! ice for the intx ice-atm context (coverage) +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 3 ) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ia_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxia, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file ice-atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ice-atm ') + endif + endif +#endif + type1 = 3; ! fv for ice and atm; fv-cgll does not work anyway + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mbixid, mbintxia, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + ice(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') + endif endif ! now take care of the mapper mapper_Si2a%src_mbid = mbixid @@ -600,7 +595,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Si2a%intx_context = idintx mapper_Si2a%weight_identifier = wgtIdi2a mapper_Si2a%mbname = 'mapper_Si2a' - if (compute_maps_online_i2a) then volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; if (atm_pg_active) then @@ -643,22 +637,17 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call moab_map_init_rcfile(mbixid, mbaxid, mbintxia, type1, & 'seq_maps.rc', 'ice2atm_smapname:', 'ice2atm_smaptype:', samegrid_ao, & wgtIdi2a, 'mapper_Si2a MOAB init', esmf_map_flag) - endif - -#ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 3 .and. compute_maps_online_i2a) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_ia_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxia, outfile, wopts) ! write local intx file + context_id = idintx ! intx id + ierr = iMOAB_MigrateMapMesh (mbixid, mbintxia, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, ice(1)%cplcompid, context_id) if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file ice-atm ' - call shr_sys_abort(subname//' ERROR in writing intx file ice-atm ') + write(logunit,*) subname,' error in migrating ocn mesh for map ocn c2 atm ' + call shr_sys_abort(subname//' ERROR in migrating ocn mesh for map ocn c2 atm ') endif + endif -! endif for MOABDEBUG -#endif + + endif ! if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then ! endif for HAVE_MOAB #endif @@ -750,15 +739,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fl2a%mbname = 'mapper_Fl2a' if (.not. samegrid_al) then ! tri grid case - - ! compute the LND coverage mesh here on coupler pes - ! LND mesh was redistributed to cover target (ATM) partition - ierr = iMOAB_ComputeCoverageMesh( mblxid, mbaxid, mbintxla ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source LND coverage mesh for ATM' - call shr_sys_abort(subname//' ERROR in computing LND-ATM coverage') - endif - + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) if (compute_maps_online_l2a) then if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between LND and ATM with id:', idintx @@ -768,37 +749,30 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in computing intersection between LND and ATM' call shr_sys_abort(subname//' ERROR in computing intersection between LND and ATM') endif - endif -#ifdef MOABDEBUG - ! write intx only if true intx file: - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5 .and. compute_maps_online_l2a) then ! write only a few intx files - write(lnum,"(I0.2)")rank ! - outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file + ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the + ! lnd for the intx lnd-atm context (coverage) + type1 = 3; ! fv for lnd and atm; fv-cgll does not work anyway + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxla, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, idintx) if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file land atm ' - call shr_sys_abort(subname//' ERROR in writing intx file ') + write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') + endif +#ifdef MOABDEBUG + ! write intx only if true intx file: + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5 .and. compute_maps_online_l2a) then ! write only a few intx files + write(lnum,"(I0.2)")rank ! + outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file land atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif endif - endif #endif - - ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the - ! lnd for the intx lnd-atm context (coverage) - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) - - type1 = 3; ! fv for lnd and atm; fv-cgll does not work anyway - type2 = 3; - ierr = iMOAB_ComputeCommGraph( mblxid, mbintxla, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - lnd(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') - endif - - if (compute_maps_online_l2a) then - ! need to compute weigths volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; if (atm_pg_active) then @@ -839,6 +813,15 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call moab_map_init_rcfile(mblxid, mbaxid, mbintxla, type1, & 'seq_maps.rc', 'lnd2atm_fmapname:', 'lnd2atm_fmaptype:', samegrid_al, & wgtIdl2a, 'mapper_Fl2a MOAB initialization', esmf_map_flag) + + context_id = idintx ! intx id + ierr = iMOAB_MigrateMapMesh (mblxid, mbintxla, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, lnd(1)%cplcompid, context_id) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating lnd mesh for map lnd c2 atm ' + call shr_sys_abort(subname//' ERROR in migrating lnd mesh for map lnd c2 atm ') + endif endif else ! the same mesh , atm and lnd use the same dofs, but restricted diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index d179456e72b9..e8a5d8faed6d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -36,8 +36,8 @@ module prep_lnd_mod #ifdef HAVE_MOAB use iMOAB , only: iMOAB_ComputeCommGraph, iMOAB_ComputeMeshIntersectionOnSphere, & iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication, & - iMOAB_WriteMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, iMOAB_ComputeCoverageMesh, & - iMOAB_SetMapGhostLayers + iMOAB_WriteMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, & + iMOAB_SetMapGhostLayers, iMOAB_MigrateMapMesh use seq_comm_mct, only : num_moab_exports #endif @@ -110,6 +110,10 @@ module prep_lnd_mod ! other fields (besides frac_field and topo_field) that are mapped from glc to lnd, ! separated by elevation class character(CXX) :: glc2lnd_ec_extra_fields + +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum +#endif !================================================================================================ contains @@ -148,7 +152,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln #ifdef HAVE_MOAB ! MOAB stuff integer :: ierr, idintx, rank - character*32 :: appname, outfile, wopts, lnum + character*32 :: appname character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdr2l, wgtIda2l_conservative, wgtIda2l_bilinear integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap integer :: fNoBubble, monotonicity @@ -254,12 +258,12 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in registering rof lnd intx' call shr_sys_abort(subname//' ERROR in registering rof lnd intx') endif + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) if (samegrid_lr) then ! the same mesh , lnd and rof use the same dofs, but restricted ! we do not compute intersection, so we will have to just send data from lnd to rof and viceversa, by GLOBAL_ID matching ! so we compute just a comm graph, between lnd and rof dofs, on the coupler; target is rof ! land is full mesh - call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! full mesh for lrofarnd now type2 = 3; ! fv for target land ierr = iMOAB_ComputeCommGraph( mbrxid, mblxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & @@ -281,15 +285,6 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln mapper_Fr2l%src_context = rof(1)%cplcompid mapper_Fr2l%intx_context = lnd(1)%cplcompid else - - ! compute the ROF coverage mesh here on coupler pes - ! ROF mesh was redistributed to cover target (LND) partition - ierr = iMOAB_ComputeCoverageMesh( mbrxid, mblxid, mbintxrl ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source ROF coverage mesh for LND' - call shr_sys_abort(subname//' ERROR in computing ROF-LND coverage') - endif - if (compute_maps_online_r2l) then ierr = iMOAB_ComputeMeshIntersectionOnSphere( mbrxid, mblxid, mbintxrl ) if (ierr .ne. 0) then @@ -300,30 +295,29 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) 'iMOAB intersection between rof and lnd with id:', idintx end if #ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_rl_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxrl, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx rl file ' - call shr_sys_abort(subname//' ERROR in writing intx rl file ') - endif - endif + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_rl_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxrl, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx rl file ' + call shr_sys_abort(subname//' ERROR in writing intx rl file ') + endif + endif #endif - endif + ! we also need to compute the comm graph for the second hop, from the rof on coupler to the + ! rof for the intx rof-lnd context (coverage) - ! we also need to compute the comm graph for the second hop, from the rof on coupler to the - ! rof for the intx rof-lnd context (coverage) - call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) - type1 = 3 ! land is FV now on coupler side - type2 = 3; - ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxrl, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - rof(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') + type1 = 3 ! land is FV now on coupler side + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxrl, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + rof(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') + endif endif ! now take care of the mapper if ( mapper_Fr2l%src_mbid .gt. -1 ) then @@ -375,10 +369,17 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif else type1 = 3 ! this is type of grid, maybe should be saved on imoab app ? - call moab_map_init_rcfile( mbrxid, mblxid, mbintxrl, type1, & 'seq_maps.rc', 'rof2lnd_fmapname:', 'rof2lnd_fmaptype:',samegrid_lr, & wgtIdr2l, 'mapper_Fr2l MOAB initialization', esmf_map_flag) + ! need to call migrate map mesh, which will compute the cov mesh and + ! comm graph too for coverage mesh + ierr = iMOAB_MigrateMapMesh (mbrxid, mbintxrl, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, rof(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating rof mesh for map rof c2 lnd ' + call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 lnd') + endif endif endif @@ -471,27 +472,18 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) if (.not. samegrid_al) then ! tri grid case - ! for bilinear maps, we need to have a layer of ghosts on source - nghlay = 1 ! number of ghost layers - nghlay_tgt = 0 - ierr = iMOAB_SetMapGhostLayers( mbintxal, nghlay, nghlay_tgt ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting the number of ghost layers' - call shr_sys_abort(subname//' error in setting the number of ghost layers') - endif - - ! compute the ATM coverage mesh here on coupler pes - ! ATM mesh was redistributed to cover target (LND) partition - ierr = iMOAB_ComputeCoverageMesh( mbaxid, mblxid, mbintxal ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source ATM coverage mesh for LND' - call shr_sys_abort(subname//' ERROR in computing ATM-LND coverage') - endif - if (compute_maps_online_a2l) then if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx endif + ! for bilinear maps, we need to have a layer of ghosts on source + nghlay = 1 ! number of ghost layers + nghlay_tgt = 0 + ierr = iMOAB_SetMapGhostLayers( mbintxal, nghlay, nghlay_tgt ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting the number of ghost layers' + call shr_sys_abort(subname//' error in setting the number of ghost layers') + endif ierr = iMOAB_ComputeMeshIntersectionOnSphere( mbaxid, mblxid, mbintxal ) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing atm lnd intx' @@ -511,24 +503,25 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif endif #endif - endif - ! we also need to compute the comm graph for the second hop, from the atm on coupler to the - ! lnd for the intx atm-lnd context (coverage) - ! - if (atm_pg_active) then - type1 = 3; ! fv for atm; cgll does not work anyway - else - type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) - endif - type2 = 3; ! land is fv in this case (separate grid) + ! we also need to compute the comm graph for the second hop, from the atm on coupler to the + ! lnd for the intx atm-lnd context (coverage) + ! + if (atm_pg_active) then + type1 = 3; ! fv for atm; cgll does not work anyway + else + type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) + endif + type2 = 3; ! land is fv in this case (separate grid) - ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxal, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - atm(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, atm-lnd' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-lnd') + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxal, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, atm-lnd' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-lnd') + endif endif + if (compute_maps_online_a2l) then volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; if (atm_pg_active) then @@ -584,11 +577,22 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln 'seq_maps.rc', 'atm2lnd_smapname:', 'atm2lnd_smaptype:',samegrid_al, & wgtIda2l_bilinear, 'mapper_Sa2l MOAB initialization', esmf_map_flag) + ! TODO make sure it is good enough + ! we are using the same coverage for 2 maps , one bilinear, one conservative ! read as the second one the f map, this one has the aream for land correct, so it should be fine ! the area_b for the bilinear map above is 0 ! which caused grief call moab_map_init_rcfile( mbaxid, mblxid, mbintxal, type1, & 'seq_maps.rc', 'atm2lnd_fmapname:', 'atm2lnd_fmaptype:',samegrid_al, & wgtIda2l_conservative, 'mapper_Fa2l MOAB initialization', esmf_map_flag) + ! we need to do only one map migrate, should over both maps!! + ! we have one coverage for both maps! + ierr = iMOAB_MigrateMapMesh (mbaxid, mbintxal, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, atm(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating atm mesh for map atm c2 lnd ' + call shr_sys_abort(subname//' ERROR in migrating atm mesh for map rof c2 lnd') + endif + endif else @@ -770,7 +774,6 @@ subroutine prep_lnd_mrg_moab (infodata) type(mct_aVect_sharedindices),save :: g2x_sharedindices #ifdef MOABDEBUG integer :: ierr - character*32 :: outfile, wopts, lnum #endif #ifdef MOABCOMP character(CXX) :: tagname, mct_field @@ -984,6 +987,9 @@ subroutine prep_lnd_calc_r2x_lx(timer) integer :: eri type(mct_aVect) , pointer :: r2x_rx character(*), parameter :: subname = '(prep_lnd_calc_r2x_lx)' +#ifdef MOABDEBUG + integer :: ierr +#endif !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -997,6 +1003,14 @@ subroutine prep_lnd_calc_r2x_lx(timer) ! equivalent. call seq_map_map(mapper_Fr2l, r2x_rx, r2x_lx(eri), & fldlist=seq_flds_r2x_fluxes, norm=.true.) +#ifdef MOABDEBUG + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'LndAftRofProj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + endif +#endif enddo call t_drvstopf (trim(timer)) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 3f6e0f4bb291..c83b8124d22f 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -13,8 +13,6 @@ module prep_ocn_mod use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes -! use seq_comm_mct, only: mbrmapro ! iMOAB id for map read from rof2ocn map file -! use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof migrated to couple pes use seq_comm_mct, only: mbintxro ! iMOAB id for map read from rof2ocn map file use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 @@ -209,7 +207,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, & - iMOAB_WriteMappingWeightsToFile, iMOAB_SetMapGhostLayers, iMOAB_ComputeCoverageMesh + iMOAB_WriteMappingWeightsToFile, iMOAB_SetMapGhostLayers !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -265,7 +263,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc integer :: rmapid, rmapid2 ! external id to identify the moab app ; 2 is for rof in ocean context (coverage) integer :: type_grid ! - integer :: context_id, direction + integer :: context_id character*32 :: prefix_output ! for writing a coverage file for debugging integer :: rank_on_cpl ! just for debugging ! these are just to zero out r2x fields on ocean @@ -439,7 +437,9 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Fa2o%src_context = atm(1)%cplcompid mapper_Fa2o%weight_identifier = wgtIda2o_conservative mapper_Fa2o%mbname = 'mapper_Fa2o' - + ! now take care of the mapper + mapper_Fa2o%intx_context = idintx + !! updated mapper_Fa2o -- ! we also need to compute the comm graph for the second hop, from the atm on coupler to the ! atm for the intx atm-ocn context (coverage) call seq_comm_getinfo(CPLID, mpigrp=mpigrp_CPLID) @@ -447,24 +447,15 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! next, let us compute the ATM and OCN data transfer if (.not. samegrid_ao) then ! not a data OCN model - ! for bilinear maps, we need to have a layer of ghosts on source - nghlay = 1 ! number of ghost layers - nghlay_tgt = 0 - ierr = iMOAB_SetMapGhostLayers( mbintxao, nghlay, nghlay_tgt ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting the number of ghost layers' - call shr_sys_abort(subname//' error in setting the number of ghost layers') - endif - - ! compute the ATM coverage mesh here on coupler pes - ! ATM mesh was redistributed to cover target (OCN) partition - ierr = iMOAB_ComputeCoverageMesh( mbaxid, mboxid, mbintxao ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source ATM coverage mesh for OCN' - call shr_sys_abort(subname//' ERROR in computing ATM-OCN coverage') - endif - if (compute_maps_online_a2o) then + ! for bilinear maps, we need to have a layer of ghosts on source + nghlay = 1 ! number of ghost layers + nghlay_tgt = 0 + ierr = iMOAB_SetMapGhostLayers( mbintxao, nghlay, nghlay_tgt ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting the number of ghost layers' + call shr_sys_abort(subname//' error in setting the number of ghost layers') + endif ! first compute the overlap mesh between mbaxid (ATM) and mboxid (OCN) on coupler PEs ierr = iMOAB_ComputeMeshIntersectionOnSphere( mbaxid, mboxid, mbintxao ) if (ierr .ne. 0) then @@ -474,12 +465,32 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc if (iamroot_CPLID) then write(logunit,*) 'iMOAB mesh intersection completed between ATM and OCN with id:', idintx end if + if (atm_pg_active) then + type1 = 3; ! FV for ATM; CGLL does not work correctly in parallel at the moment + else + type1 = 1 ! This projection works (CGLL to FV), but reverse does not (FV - CGLL) + endif + type2 = 3; ! FV mesh on coupler OCN + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ATM-OCN' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ATM-OCN') + endif +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5 .and. compute_maps_online_a2o) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ao_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxao, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif + endif +#endif end if - - ! now take care of the mapper - mapper_Fa2o%intx_context = idintx - !! updated mapper_Fa2o -- - ! To project fields from ATM to OCN grid, we need to define ! ATM a2x fields to OCN grid on coupler side tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR @@ -490,7 +501,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on OCN cpl' call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on OCN cpl') endif - if (compute_maps_online_a2o) then volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; if (atm_pg_active) then @@ -554,34 +564,18 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call moab_map_init_rcfile(mbaxid, mboxid, mbintxao, type1, & 'seq_maps.rc', 'atm2ocn_smapname:', 'atm2ocn_smaptype:',samegrid_ao, & wgtIda2o_bilinear, 'mapper_Sa2o moab initialization', esmf_map_flag) - endif - if (atm_pg_active) then - type1 = 3; ! FV for ATM; CGLL does not work correctly in parallel at the moment - else - type1 = 1 ! This projection works (CGLL to FV), but reverse does not (FV - CGLL) - endif - type2 = 3; ! FV mesh on coupler OCN - ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - atm(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, ATM-OCN' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ATM-OCN') - endif + context_id = idintx + ! again, one coverage set and coverage graph for 2 different maps + ierr = iMOAB_MigrateMapMesh (mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, atm(1)%cplcompid, context_id) -#ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5 .and. compute_maps_online_a2o) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_ao_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxao, outfile, wopts) ! write local intx file if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file ' - call shr_sys_abort(subname//' ERROR in writing intx file ') + write(logunit,*) subname,' error in migrating atm mesh for map atm c2 ocn ' + call shr_sys_abort(subname//' ERROR in migrating atm mesh for map atm c2 ocn ') endif + endif -#endif else ! if (samegrid_ao) ! ATM and OCN components use the same mesh and DoF numbering (OCN is a subset of ATM); @@ -748,27 +742,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in registering rof 2 ocn moab map ' call shr_sys_abort(subname//' ERROR in registering rof 2 ocn moab map ') endif - ! integer, public :: mboxid ! iMOAB id for mpas ocean already migrated mesh to coupler pes - ! this is a special rof mesh redistribution, for the ocean context - ! it will be used to project from rof to ocean - ! the mesh will be migrated, to be able to do the second hop - ! appname = "ROF_OCOU"//C_NULL_CHAR - ! ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side - ! rmapid2 = 100*rof(1)%cplcompid ! this is a special case, because we also have a regular coupler instance mbrxid - ! ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, rmapid2, mbrxoid) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in registering rof on coupler in ocean context ' - ! call shr_sys_abort(subname//' ERROR in registering rof on coupler in ocean context ') - ! endif - ! this code was moved from prep_rof_ocn_moab, because we will do everything on coupler side, not - ! needed to be on joint comm anymore for the second hop - - ! need to compute coverage of rof over ocean, and comm graph for sending from rof to rof over ocean - ierr = iMOAB_ComputeCoverageMesh( mbrxid, mboxid, mbintxro ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in compute coverage mesh rof for ocean' - call shr_sys_abort(subname//' ERROR in compute coverage mesh rof for ocean ') - endif if (iamroot_CPLID) then write(logunit,*) ' ' write(logunit,F00) 'Initializing MOAB mapper_Rr2o_liq' @@ -779,44 +752,20 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & wgtIdr2o_conservative, 'mapper_Rr2o_liq moab initialization',esmf_map_flag) - ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxro, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type_grid, & - type_grid, rof(1)%cplcompid, rmapid ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in compute graph rof - rof cov for ocean' - call shr_sys_abort(subname//' ERROR in compute graph rof - rof cov for ocean ') - endif - ! it read on the coupler side, from file, the scrip mosart, that has a full mesh; - ! also migrate rof mesh on coupler pes, in ocean context, mbrxoid (this will be like coverage mesh, - ! it will cover ocean target per process) - ! map between rof 2 ocn is in mbrmapro ; - ! after this, the sending of tags for second hop (ocn context) will use the new par comm graph, - ! that has more precise info, that got created - - ! type1 = 3 ! fv mesh nowadays - ! direction = 1 ! - ! context_id = ocn(1)%cplcompid - ! this creates a par comm graph between mbrxid and mbrxoid, with ids rof(1)%cplcompid, context ocn(1)%cplcompid + type1 = 3 ! fv mesh nowadays + context_id = rmapid ! ocn(1)%cplcompid + ! this creates a par comm graph between mbrxid and mbintxro, with ids rof(1)%cplcompid, rmapid (rmapid is 100*src+tgt) ! this will be used in send/receive mappers - ! ierr = iMOAB_MigrateMapMesh (mbrxid, mbrmapro, mbrxoid, mpicom_CPLID, mpigrp_CPLID, & - ! mpigrp_CPLID, type1, rof(1)%cplcompid, context_id, direction) + ierr = iMOAB_MigrateMapMesh (mbrxid, mbintxro, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, rof(1)%cplcompid, context_id) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' - ! call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') - ! endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' + call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') + endif ! if (iamroot_CPLID) then ! write(logunit,*) subname,' migrated mesh for map rof 2 ocn ' ! endif - if (mbrxid .ge. 0) then ! we are on coupler side pes - tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = 1 ! only 1 component DoF per node - ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB' - call shr_sys_abort(subname//' ERROR in defining MOAB tags ') - endif - endif if (mboxid .ge. 0) then ! we are on coupler side pes, for ocean mesh tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR @@ -854,19 +803,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif deallocate (tmparray) - ! now we have to populate the map with the right moab attributes, so that it does the right projection -#ifdef MOABDEBUG - if (mbrxid.ge.0) then ! we are on coupler PEs - call mpi_comm_rank(mpicom_CPLID, rank_on_cpl , ierr) - if (rank_on_cpl .lt. 4) then - prefix_output = "rof_cov"//CHAR(0) - ierr = iMOAB_WriteLocalMesh(mbrxid, prefix_output) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing coverage mesh rof 2 ocn ' - endif - endif - endif -#endif ! now take care of the mapper for MOAB mapper_Rr2o_liq if ( mapper_Rr2o_liq%src_mbid .gt. -1 ) then if (iamroot_CPLID) then @@ -875,7 +811,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif endif mapper_Rr2o_liq%src_mbid = mbrxid - mapper_Rr2o_liq%tgt_mbid = mboxid ! this is special, it will really need this coverage type mesh + mapper_Rr2o_liq%tgt_mbid = mboxid ! this is similar to a regular intx scenario mapper_Rr2o_liq%intx_mbid = mbintxro mapper_Rr2o_liq%src_context = rof(1)%cplcompid !mapper_Rr2o_liq%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh @@ -902,14 +838,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,F00) 'Initializing MOAB mapper_Rr2o_ice same as mapper_Rr2o_liq' end if mapper_Rr2o_ice%src_mbid = mbrxid - mapper_Rr2o_ice%tgt_mbid = mboxid ! special + mapper_Rr2o_ice%tgt_mbid = mboxid mapper_Rr2o_ice%intx_mbid = mbintxro mapper_Rr2o_ice%src_context = rof(1)%cplcompid - !mapper_Rr2o_ice%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh mapper_Rr2o_ice%intx_context = rmapid ! read map is the same context as intersection now mapper_Rr2o_ice%weight_identifier = wgtIdr2o_conservative mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' - ! mapper_Rr2o_ice%read_map = .true. #endif if (flood_present) then if (iamroot_CPLID) then @@ -926,10 +860,9 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,F00) 'Initializing MOAB mapper_Fr2o' end if mapper_Fr2o%src_mbid = mbrxid - mapper_Fr2o%tgt_mbid = mboxid ! special + mapper_Fr2o%tgt_mbid = mboxid mapper_Fr2o%intx_mbid = mbintxro mapper_Fr2o%src_context = rof(1)%cplcompid - !mapper_Fr2o%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh mapper_Fr2o%intx_context = rmapid ! read map is the same context as intersection now mapper_Fr2o%weight_identifier = wgtIdr2o_conservative mapper_Fr2o%mbname = 'mapper_Fr2o' @@ -2943,7 +2876,14 @@ subroutine prep_ocn_calc_r2x_ox(timer) type(mct_avect), pointer :: r2x_rx character(*), parameter :: subname = '(prep_ocn_calc_r2x_ox)' !--------------------------------------------------------------- - +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCpl_Bef_r2x_ox_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do eri = 1,num_inst_rof r2x_rx => component_get_c2x_cx(rof(eri)) @@ -2957,6 +2897,14 @@ subroutine prep_ocn_calc_r2x_ox(timer) endif enddo call t_drvstopf (trim(timer)) +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCpl_r2x_ox_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif end subroutine prep_ocn_calc_r2x_ox diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 007ff419d7a4..3dc96cd294a6 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -166,7 +166,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, & - iMOAB_ComputeScalarProjectionWeights, iMOAB_GetMeshInfo, iMOAB_ComputeCoverageMesh + iMOAB_ComputeScalarProjectionWeights, iMOAB_GetMeshInfo, iMOAB_MigrateMapMesh !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -372,15 +372,6 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) mapper_Fl2r%src_context = lnd(1)%cplcompid mapper_Fl2r%intx_context = rof(1)%cplcompid else - - ! compute the LND coverage mesh here on coupler pes - ! LND mesh was redistributed to cover target (ROF) partition - ierr = iMOAB_ComputeCoverageMesh( mblxid, mbrxid, mbintxlr ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source LND coverage mesh for ROF' - call shr_sys_abort(subname//' ERROR in computing LND-ROF coverage') - endif - ! if we are not loading maps from disk, compute the intersection mesh between ! LND and ROF meshes if (compute_maps_online_l2r) then @@ -393,30 +384,29 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) write(logunit,*) 'iMOAB intersection between LND and ROF with id:', idintx end if #ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 3 .and. compute_maps_online_l2r) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_lr_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxlr, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing LND-ROF intersection mesh file ' - call shr_sys_abort(subname//' ERROR in writing LND-ROF intersection mesh file ') + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 3 .and. compute_maps_online_l2r) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_lr_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxlr, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing LND-ROF intersection mesh file ' + call shr_sys_abort(subname//' ERROR in writing LND-ROF intersection mesh file ') + endif endif - endif #endif + ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the + ! lnd for the intx LND-ROF context (coverage) + type1 = 3 ! land is FV now on coupler side + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxlr, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, LND-ROF' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, LND-ROF') + endif end if - - ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the - ! lnd for the intx LND-ROF context (coverage) - type1 = 3 ! land is FV now on coupler side - type2 = 3; - ierr = iMOAB_ComputeCommGraph( mblxid, mbintxlr, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - lnd(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, LND-ROF' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, LND-ROF') - endif ! now take care of the mapper if ( mapper_Fl2r%src_mbid .gt. -1 ) then if (iamroot_CPLID) then @@ -469,6 +459,15 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call moab_map_init_rcfile( mblxid, mbrxid, mbintxlr, type1, & 'seq_maps.rc', 'lnd2rof_fmapname:', 'lnd2rof_fmaptype:',samegrid_lr, & wgtIdl2r, 'mapper_Fl2r MOAB initialization', esmf_map_flag) + + ! this creates a par comm graph between mblxid and mbintxlr, with ids lnd(1)%cplcompid + ierr = iMOAB_MigrateMapMesh (mblxid, mbintxlr, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, lnd(1)%cplcompid, idintx) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating lnd mesh for map lnd c2 rof ' + call shr_sys_abort(subname//' ERROR in migrating lnd mesh for map lnd c2 rof ') + endif end if end if ! if ((mblxid .ge. 0) .and. (mbrxid .ge. 0)) endif ! samegrid_lr @@ -563,14 +562,6 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call shr_sys_abort(subname//' ERROR in registering ATM-ROF mesh intersection context') endif - ! compute the OCN coverage mesh here on coupler pes - ! ATM mesh was redistributed to cover target (ROF) partition - ierr = iMOAB_ComputeCoverageMesh( mbaxid, mbrxid, mbintxar ) - if (ierr .ne. 0) then - write(logunit,*) subname,' cannot compute source ATM coverage mesh for ROF' - call shr_sys_abort(subname//' ERROR in computing ATM-ROF coverage') - endif - ! if we are not loading maps from disk, compute the intersection mesh between ! ATM and ROF meshes if (compute_maps_online_a2r) then @@ -595,23 +586,22 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) endif endif #endif + ! we also need to compute the comm graph for the second hop, from the atm on coupler to the + ! atm for the intersection of ATM-ROF context (coverage) + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) + if (atm_pg_active) then + type1 = 3; ! FV for both rof and atm; FV-CGLL does not work anyway + else + type1 = 1 ! this does not work anyway in this direction + endif + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxar, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ATM-ROF' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ATM-ROF') + endif end if - - ! we also need to compute the comm graph for the second hop, from the atm on coupler to the - ! atm for the intersection of ATM-ROF context (coverage) - call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) - if (atm_pg_active) then - type1 = 3; ! FV for both rof and atm; FV-CGLL does not work anyway - else - type1 = 1 ! this does not work anyway in this direction - endif - type2 = 3; - ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxar, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - atm(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, ATM-ROF' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ATM-ROF') - endif ! now take care of the mapper if ( mapper_Fa2r%src_mbid .gt. -1 ) then if (iamroot_CPLID) then @@ -677,10 +667,17 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) else type1 = 3 ! this is type of grid, maybe should be saved on imoab app ? - call moab_map_init_rcfile( mbaxid, mbrxid, mbintxar, type1, & 'seq_maps.rc', 'atm2rof_fmapname:', 'atm2rof_fmaptype:',samegrid_ar, & wgtIda2r, 'mapper_Fa2r MOAB initialization', esmf_map_flag) + ! this creates a par comm graph between mblxid and mbintxlr, with ids lnd(1)%cplcompid + ierr = iMOAB_MigrateMapMesh (mbaxid, mbintxar, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, atm(1)%cplcompid, idintx) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating atm mesh for map atm c2 rof ' + call shr_sys_abort(subname//' ERROR in migrating atm mesh for map atm c2 rof ') + endif end if end if ! if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 018d128b5376..f5f7ff1b07e1 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -191,6 +191,7 @@ module seq_flux_mct integer :: index_xao_So_ssq integer :: index_xao_So_duu10n integer :: index_xao_So_u10 + integer :: index_xao_So_u10withgusts integer :: index_xao_So_fswpen integer :: index_xao_So_warm_diurn integer :: index_xao_So_salt_diurn @@ -1510,6 +1511,7 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) index_xao_So_re = mct_aVect_indexRA(xao,'So_re') index_xao_So_ssq = mct_aVect_indexRA(xao,'So_ssq') index_xao_So_u10 = mct_aVect_indexRA(xao,'So_u10') + index_xao_So_u10withgusts = mct_aVect_indexRA(xao,'So_u10withgusts') index_xao_So_duu10n = mct_aVect_indexRA(xao,'So_duu10n') index_xao_Faox_taux = mct_aVect_indexRA(xao,'Faox_taux') index_xao_Faox_tauy = mct_aVect_indexRA(xao,'Faox_tauy') @@ -1787,6 +1789,7 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) xao%rAttr(index_xao_Faox_lwup,n) = lwup(n) xao%rAttr(index_xao_So_duu10n,n) = duu10n(n) xao%rAttr(index_xao_So_u10 ,n) = sqrt(duu10n(n)) + xao%rAttr(index_xao_So_u10withgusts,n) = sqrt(duu10n(n)) xao%rAttr(index_xao_So_warm_diurn ,n) = warm(n) xao%rAttr(index_xao_So_salt_diurn ,n) = salt(n) xao%rAttr(index_xao_So_speed_diurn ,n) = speed(n) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 031845a102ef..ba892ce63c33 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -140,7 +140,7 @@ module seq_frac_mct ! !USES: - use shr_kind_mod , only: R8 => SHR_KIND_R8 + use shr_kind_mod , only: R8 => SHR_KIND_R8, IN=>SHR_KIND_IN use shr_sys_mod use shr_const_mod @@ -287,6 +287,10 @@ subroutine seq_frac_init( infodata, & !----- local ----- type(mct_ggrid), pointer :: dom_a + type(mct_gsmap), pointer :: gsmap_a ! see if we can get from here the global ids (missing from dom_a) + type(mct_gsmap), pointer :: gsmap_l + type(mct_gsmap), pointer :: gsmap_r + type(mct_gsmap), pointer :: gsmap_i ! ofrac on ice error type(mct_ggrid), pointer :: dom_i type(mct_ggrid), pointer :: dom_l type(mct_ggrid), pointer :: dom_o @@ -326,11 +330,13 @@ subroutine seq_frac_init( infodata, & character*32 :: wgtIdef real(r8), allocatable :: tagValues(:) ! used for setting some default tags integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + integer(IN), pointer :: dof(:) ! integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) integer kgg ! index in global number attribute, used for global id in MOAB integer idintx ! used for context for intx atm - ocn integer id_join ! used for example for atm%cplcompid integer :: mpicom ! we are on coupler PES here + integer :: my_task ! character(30) :: outfile, wopts @@ -361,6 +367,7 @@ subroutine seq_frac_init( infodata, & dom_w => component_get_dom_cx(wav) dom_z => component_get_dom_cx(iac) + mpicom = seq_comm_mpicom(CPLID) debug_old = seq_frac_debug seq_frac_debug = 2 @@ -469,17 +476,21 @@ subroutine seq_frac_init( infodata, & tagname = 'lfrin'//C_NULL_CHAR ! 'lfrin' allocate(tagValues(lSize) ) tagValues = dom_l%data%rAttr(kf,:) - kgg = mct_aVect_indexIA(dom_l%data ,"GlobGridNum" ,perrWith=subName) - allocate(GlobalIds(lSize)) - GlobalIds = dom_l%data%iAttr(kgg,:) - + !kgg = mct_aVect_indexIA(dom_l%data ,"GlobGridNum" ,perrWith=subName) + !allocate(GlobalIds(lSize)) + !GlobalIds = dom_l%data%iAttr(kgg,:) + gsmap_l => component_get_gsmap_cx(lnd) ! gsmap_lx + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap_l, my_task, dof) ! ent_type should be 3, FV - ierr = iMOAB_SetDoubleTagStorageWithGid ( mblxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mblxid, tagname, lSize , ent_type, tagValues, dof ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting lfrin on lnd ' call shr_sys_abort(subname//' ERROR in setting lfrin on lnd') endif - deallocate(GlobalIds) + !deallocate(GlobalIds) + deallocate(dof) deallocate(tagValues) endif @@ -526,16 +537,21 @@ subroutine seq_frac_init( infodata, & tagname = 'rfrac'//C_NULL_CHAR ! 'rfrac' allocate(tagValues(lSize) ) tagValues = dom_r%data%rAttr(kf,:) - kgg = mct_aVect_indexIA(dom_r%data ,"GlobGridNum" ,perrWith=subName) - allocate(GlobalIds(lSize)) - GlobalIds = dom_r%data%iAttr(kgg,:) + !kgg = mct_aVect_indexIA(dom_r%data ,"GlobGridNum" ,perrWith=subName) + !allocate(GlobalIds(lSize)) + !GlobalIds = dom_r%data%iAttr(kgg,:) + gsmap_r => component_get_gsmap_cx(rof) ! gsmap_rx + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap_r, my_task, dof) ! again, we are setting on the river instance that is also used for ocean coupling - ierr = iMOAB_SetDoubleTagStorageWithGid ( mbrxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbrxid, tagname, lSize , ent_type, tagValues, dof ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting rfrac on rof ' call shr_sys_abort(subname//' ERROR in setting rfrac on rof ') endif - deallocate(GlobalIds) + !deallocate(GlobalIds) + deallocate(dof) deallocate(tagValues) endif @@ -590,23 +606,49 @@ subroutine seq_frac_init( infodata, & tagname = 'ofrac'//C_NULL_CHAR ! 'ofrac' allocate(tagValues(lSize) ) tagValues = dom_i%data%rAttr(kf,:) - kgg = mct_aVect_indexIA(dom_i%data ,"GlobGridNum" ,perrWith=subName) - allocate(GlobalIds(lSize)) - GlobalIds = dom_i%data%iAttr(kgg,:) - - ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, GlobalIds ) + !kgg = mct_aVect_indexIA(dom_i%data ,"GlobGridNum" ,perrWith=subName) + !allocate(GlobalIds(lSize)) + !GlobalIds = dom_i%data%iAttr(kgg,:) + gsmap_i => component_get_gsmap_cx(ice) ! gsmap_ix + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap_i, my_task, dof) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, dof ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting ofrac on ice ' call shr_sys_abort(subname//' ERROR in setting ofrac on ice ') endif - deallocate(GlobalIds) + !deallocate(GlobalIds) deallocate(tagValues) + deallocate(dof) +#ifdef MOABDEBUG + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + if (mbixid .ge. 0 ) then + outfile = 'iceCplInit1Fr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif +#endif endif if (atm_present) then mapper_i2a => prep_atm_get_mapper_Fi2a() call seq_map_map(mapper_i2a,fractions_i,fractions_a,fldlist='ofrac',norm=.false.) endif +#ifdef MOABDEBUG + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + if (mbaxid .ge. 0 ) then + outfile = 'atmCplInit1Fr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif +#endif end if ! end of ice_present @@ -674,6 +716,17 @@ subroutine seq_frac_init( infodata, & deallocate(tagValues) mapper_o2a => prep_atm_get_mapper_Fo2a() call seq_map_map(mapper_o2a, fractions_o, fractions_a, fldlist='ofrac',norm=.false.) +#ifdef MOABDEBUG + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + if (mbaxid .ge. 0 ) then + outfile = 'atmCplInit2Fr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif +#endif endif if (atm_present) then @@ -715,16 +768,21 @@ subroutine seq_frac_init( infodata, & tagname = 'lfrac'//C_NULL_CHAR ! 'lfrac allocate(tagValues(lSize) ) tagValues = fractions_a%rAttr(kl,:) - kgg = mct_aVect_indexIA(dom_a%data ,"GlobGridNum" ,perrWith=subName) - allocate(GlobalIds(lSize)) - GlobalIds = dom_a%data%iAttr(kgg,:) + !kgg = mct_aVect_indexIA(dom_a%data ,"GlobGridNum" ,perrWith=subName) + !allocate(GlobalIds(lSize)) + !GlobalIds = dom_a%data%iAttr(kgg,:) ! set on atmosphere instance - ierr = iMOAB_SetDoubleTagStorageWithGid ( mbaxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + gsmap_a => component_get_gsmap_cx(atm) ! gsmap_ax + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap_a, my_task, dof) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbaxid, tagname, lSize , ent_type, tagValues, dof ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting lfrac on atm ' call shr_sys_abort(subname//' ERROR in setting lfrac on atm ') endif - deallocate(GlobalIds) + !deallocate(GlobalIds) + deallocate(dof) deallocate(tagValues) endif else if (lnd_present) then @@ -737,6 +795,38 @@ subroutine seq_frac_init( infodata, & if (atm_frac_correct) fractions_a%rAttr(kl,n) = 1.0_r8 endif enddo + ! case --res r05_r05 --compset RMOSGPCC is coming here + ! there are no active ice or ocn comps + ! ist is almost like above, except the ofrac is modified too + if (mbaxid .ge. 0 ) then ! // + tagname = 'lfrac'//C_NULL_CHAR ! 'lfrac + allocate(tagValues(lSize) ) + tagValues = fractions_a%rAttr(kl,:) + kgg = mct_aVect_indexIA(dom_a%data ,"GlobGridNum" ,perrWith=subName) + !allocate(GlobalIds(lSize)) + ! GlobalIds = dom_a%data%iAttr(kgg,:) + gsmap_a => component_get_gsmap_cx(atm) ! gsmap_ax + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap_a, my_task, dof) + ! set on atmosphere instance + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbaxid, tagname, lSize , ent_type, tagValues, dof ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting lfrac on atm ' + call shr_sys_abort(subname//' ERROR in setting lfrac on atm ') + endif + ! unlike above, set ofrac too + tagname = 'ofrac'//C_NULL_CHAR ! 'ofrac + tagValues = fractions_a%rAttr(ko,:) + ! set on atmosphere instance, ofrac value + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbaxid, tagname, lSize , ent_type, tagValues, dof ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on atm ' + call shr_sys_abort(subname//' ERROR in setting ofrac on atm ') + endif + deallocate(dof) + deallocate(tagValues) + endif endif endif @@ -753,6 +843,24 @@ subroutine seq_frac_init( infodata, & kk = mct_aVect_indexRA(fractions_l,"lfrin",perrWith=subName) kl = mct_aVect_indexRA(fractions_l,"lfrac",perrWith=subName) fractions_l%rAttr(kl,:) = fractions_l%rAttr(kk,:) + ! still need to do MOAB case, basically copy the value of lfrin to lfrac, on land + ! fractions / on land moab instance; otherwise would stay at 0 :) + ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ) + arrSize = nvise(1) ! there is one tag that we need to copy + allocate(tagValues(arrSize) ) + tagname = 'lfrin'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting lfrin on lnd ' + call shr_sys_abort(subname//' ERROR in getting lfrin on lnd ') + endif + tagname = 'lfrac'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mbixid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting lfrac on lnd ' + call shr_sys_abort(subname//' ERROR in setting lfrac on lnd ') + endif + deallocate(tagValues) end if end if if (lnd_present .and. rof_present) then @@ -849,22 +957,25 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ !----- local ----- type(mct_aVect), pointer :: i2x_i type(mct_ggrid), pointer :: dom_i - type(mct_ggrid), pointer :: dom_o ! introduced just to update ocean moab fractions + !type(mct_ggrid), pointer :: dom_o ! introduced just to update ocean moab fractions + type(mct_gsmap), pointer :: gsmap_i ! ofrac on ice error logical :: atm_present ! true => atm is present logical :: ice_present ! true => ice is present logical :: ocn_present ! true => ocn is present integer :: n integer :: ki, kl, ko, kf real(r8),allocatable :: fcorr(:) + integer(IN), pointer, save :: dof(:) ! logical, save :: first_time = .true. ! moab integer :: ierr, kgg integer , save :: lSize, ent_type + integer mpicom, my_task character(CXX) :: tagname real(r8), allocatable, save :: tagValues(:) ! used for setting some tags real(r8), allocatable, save :: tagValuesOfrac(:) ! used for setting some tags - integer , allocatable, save :: GlobalIds(:) ! used for setting values associated with ids + !integer , allocatable, save :: GlobalIds(:) ! used for setting values associated with ids #ifdef MOABDEBUG character(len=100) :: outfile, wopts, lnum #endif @@ -891,8 +1002,9 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ dom_i => component_get_dom_cx(ice) i2x_i => component_get_c2x_cx(ice) + mpicom = seq_comm_mpicom(CPLID) - dom_o => component_get_dom_cx(ocn) ! + !dom_o => component_get_dom_cx(ocn) ! if (ice_present) then call mct_aVect_copy(i2x_i, fractions_i, "Si_ifrac", "ifrac") @@ -908,9 +1020,13 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ if (first_time) then ! allocate some local arrays lSize = mct_aVect_lSize(dom_i%data) allocate(tagValues(lSize) ) - allocate(GlobalIds(lSize) ) - kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) - GlobalIds = dom_i%data%iAttr(kgg,:) + !allocate(GlobalIds(lSize) ) + !kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) + !GlobalIds = dom_i%data%iAttr(kgg,:) + gsmap_i => component_get_gsmap_cx(ice) ! gsmap_ix + call mpi_comm_rank(mpicom,my_task,ierr) + ! Determine global gridpoint number attribute, GlobGridNum, automatically in ggrid + call mct_gsMap_orderedPoints(gsmap_i, my_task, dof) allocate (tagValuesOfrac(local_size_mb_ocn)) ent_type = 1 ! cells for mpas sea ice first_time = .false. @@ -923,7 +1039,7 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ ! fraclist_i = 'afrac:ifrac:ofrac' ! tagValues = fractions_i%rAttr(ki,:) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, GlobalIds ) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, dof ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting ifrac on ice moab instance ' call shr_sys_abort(subname//' ERROR in setting ifrac on ice moab instance ') @@ -931,7 +1047,7 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ tagname = 'ofrac'//C_NULL_CHAR tagValues = fractions_i%rAttr(ko,:) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, GlobalIds ) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, dof ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting ofrac on ice moab instance ' call shr_sys_abort(subname//' ERROR in setting ofrac on ice moab instance ') diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 55a974cd0f09..5be18429f7f0 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -235,7 +235,7 @@ subroutine moab_map_init_rcfile( mbsrc, mbtgt, mbintx, discretization_type, & call shr_sys_abort(subname//' ERROR in loading map file') endif if (seq_comm_iamroot(CPLID)) then - write(logunit,'(2A,I6,4A)') subname,'Result: iMOAB map app ID, maptype, mapfile = ', & + write(logunit,'(2A,I12,4A)') subname,'Result: iMOAB map app ID, maptype, mapfile = ', & mbintx,' ',trim(maptype),' ',trim(mapfile), ', identifier: ', trim(sol_identifier) call shr_sys_flush(logunit) endif @@ -328,6 +328,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, use iMOAB, only: iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_GetIntTagStorage, iMOAB_ApplyScalarProjectionWeights, & iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers + use seq_comm_mct, only : num_moab_exports implicit none !----------------------------------------------------- @@ -438,7 +439,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & - nfields, ' fldlist_moab=', trim(fldlist_moab) + nfields, ' fldlist_moab=', trim(fldlist_moab), ' moab step ', num_moab_exports call shr_sys_flush(logunit) endif #endif @@ -496,7 +497,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper rearrange or copy ', mapper%mbname, ' send/recv tags ', trim(fldlist_moab), & - ' mbpresent=', mbpresent, ' mbnorm=', mbnorm + ' mbpresent=', mbpresent, ' mbnorm=', mbnorm, ' moab step:', num_moab_exports call shr_sys_flush(logunit) endif #endif @@ -550,7 +551,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' set norm8wt 1 on source with app id: ', mapper%src_mbid + write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' set norm8wt 1 on source with app id: ', & + mapper%src_mbid, ' moab step:', num_moab_exports call shr_sys_flush(logunit) endif #endif @@ -584,7 +586,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB projection mapper: ', mapper%mbname, ' normalize nfields=', & - nfields, ' arrsize_src on root:', arrsize_src, ' shape(targtags_ini)=', shape(targtags_ini) + nfields, ' arrsize_src on root:', arrsize_src, ' shape(targtags_ini)=', shape(targtags_ini), & + ' moab step:', num_moab_exports call shr_sys_flush(logunit) endif #endif @@ -613,7 +616,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper receiving tags with intx and intx_mbid: ', & - mapper%mbname, trim(fldlist_moab) + mapper%mbname, trim(fldlist_moab), ' moab step:', num_moab_exports endif #endif ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) @@ -634,7 +637,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB projection mapper: ',trim(mapper%mbname), ' between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + write(logunit, *) subname,' iMOAB projection mapper: ',trim(mapper%mbname), ' between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab), & + ' moab step:', num_moab_exports call shr_sys_flush(logunit) endif #endif diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index dafd4d056686..5454918d7d01 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -362,7 +362,7 @@ subroutine seq_rest_read(rest_file, infodata, & end subroutine seq_rest_read -subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) +subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al, samegrid_lr) use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances use iMOAB, only: iMOAB_GetGlobalInfo @@ -373,6 +373,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) character(*) , intent(in) :: rest_file ! restart file path/name type(seq_infodata_type), intent(in) :: infodata logical , intent(in) :: samegrid_al ! needed for land nx + logical , intent(in) :: samegrid_lr ! needed for land nx, too integer(IN) :: n,n1,n2,n3 real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file @@ -454,7 +455,12 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm call seq_io_read(moab_rest_file, mblxid, 'fractions_lx', & 'afrac:lfrac:lfrin', nx=nx_lnd) - else + else if(samegrid_lr) then + ! nx for land will be from global nb rof + ierr = iMOAB_GetGlobalInfo(mbrxid, dummy, nx_lnd) ! max id for land will come from rof + call seq_io_read(moab_rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin', nx=nx_lnd) + else ! is this ever true ? call seq_io_read(moab_rest_file, mblxid, 'fractions_lx', & 'afrac:lfrac:lfrin') endif @@ -471,7 +477,13 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) call seq_io_read(moab_rest_file, mblxid, 'l2racc_lx', & trim(tagname), & matrix = p_l2racc_lm, nx=nx_lnd) - else + else if(samegrid_lr) then + ! nx for land will be from global nb rof + ierr = iMOAB_GetGlobalInfo(mbrxid, dummy, nx_lnd) ! max id for land will come from rof + call seq_io_read(moab_rest_file, mblxid, 'l2racc_lx', & + trim(tagname), & + matrix = p_l2racc_lm, nx=nx_lnd) + else call seq_io_read(moab_rest_file, mblxid, 'l2racc_lx', & trim(tagname), & matrix = p_l2racc_lm ) @@ -942,7 +954,7 @@ end subroutine seq_rest_write subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & - tag, samegrid_al, rest_file) + tag, samegrid_al, samegrid_lr, rest_file) use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances use iMOAB, only: iMOAB_GetGlobalInfo @@ -965,6 +977,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & character(len=*) , intent(in) :: tag logical , intent(in) :: samegrid_al ! needed for land nx + logical , intent(in) :: samegrid_lr ! needed for land nx too, for trigrid case character(len=CL) , intent(out) :: rest_file ! Restart filename @@ -1175,6 +1188,12 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, mblxid, 'fractions_lx', & 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' whead=whead, wdata=wdata, nx=nx_lnd) + else if(samegrid_lr) then + ! nx for land will be from global nb atmosphere + ierr = iMOAB_GetGlobalInfo(mbrxid, dummy, nx_lnd) ! max id for land will come from rof + call seq_io_write(rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + whead=whead, wdata=wdata, nx=nx_lnd) else call seq_io_write(rest_file, mblxid, 'fractions_lx', & 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' @@ -1197,6 +1216,12 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, mblxid, 'l2racc_lx', & trim(tagname), & whead=whead, wdata=wdata, matrix = p_l2racc_lm, nx=nx_lnd) + else if(samegrid_lr) then + ! nx for land will be from global nb atmosphere + ierr = iMOAB_GetGlobalInfo(mbrxid, dummy, nx_lnd) ! max id for land will come from rof + call seq_io_write(rest_file, mblxid, 'l2racc_lx', & + trim(tagname), & + whead=whead, wdata=wdata, matrix = p_l2racc_lm, nx=nx_lnd) else call seq_io_write(rest_file, mblxid, 'l2racc_lx', & trim(tagname), & diff --git a/driver-moab/shr/CMakeLists.txt b/driver-moab/shr/CMakeLists.txt index 08d47cd358ce..ebd39b5f4a6e 100644 --- a/driver-moab/shr/CMakeLists.txt +++ b/driver-moab/shr/CMakeLists.txt @@ -1,5 +1,6 @@ list(APPEND drv_sources glc_elevclass_mod.F90 + glc_zocnclass_mod.F90 seq_cdata_mod.F90 seq_comm_mct.F90 seq_infodata_mod.F90 diff --git a/driver-moab/shr/glc_zocnclass_mod.F90 b/driver-moab/shr/glc_zocnclass_mod.F90 new file mode 100644 index 000000000000..50bb4d100528 --- /dev/null +++ b/driver-moab/shr/glc_zocnclass_mod.F90 @@ -0,0 +1,343 @@ +module glc_zocnclass_mod + + !--------------------------------------------------------------------- + ! + ! Purpose: + ! + ! This module contains data and routines for operating on GLC ocean z-level classes. + +#include "shr_assert.h" + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod + use seq_comm_mct, only : logunit + use shr_log_mod, only : errMsg => shr_log_errMsg + + implicit none + save + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: glc_zocnclass_init ! initialize GLC z-ocean class data + public :: glc_zocnclass_clean ! deallocate memory allocated here + public :: glc_get_num_zocn_classes ! get the number of z-ocean classes + public :: glc_get_zlevels ! get an array of the z-ocean levels + public :: glc_get_zocnclass_bounds ! get the boundaries of all z-ocean classes + public :: glc_zocnclass_as_string ! returns a string corresponding to a given z-ocean class + public :: glc_all_zocnclass_strings ! returns an array of strings for all z-ocean classes + public :: glc_zocn_errcode_to_string ! convert an error code into a string describing the error + + interface glc_zocnclass_init + module procedure glc_zocnclass_init_default + module procedure glc_zocnclass_init_override + end interface glc_zocnclass_init + + + !-------------------------------------------------------------------------- + ! Public data + !-------------------------------------------------------------------------- + + ! Possible error code values + integer, parameter, public :: GLC_ZOCNCLASS_ERR_NONE = 0 ! err_code indicating no error + integer, parameter, public :: GLC_ZOCNCLASS_ERR_UNDEFINED = 1 ! err_code indicating z-ocean classes have not been defined + integer, parameter, public :: GLC_ZOCNCLASS_ERR_TOO_LOW = 2 ! err_code indicating z-level below lowest z-ocean class + integer, parameter, public :: GLC_ZOCNCLASS_ERR_TOO_HIGH = 3 ! err_code indicating z-level above highest z-ocean class + + ! String length for glc z-ocean classes represented as strings + integer, parameter, public :: GLC_ZOCNCLASS_STRLEN = 2 + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + ! number of elevation classes + integer :: glc_nzoc ! number of z-ocean classes + + ! z-level of each class. Units are meters above sea level, so values should be <0 + ! indexing goes from shallowest to deepest levels + real(r8), allocatable :: zocn_levels(:) + ! upper and lower z-level limit for each class (m) + ! first dimension: indexing goes from shallowest to deepest levels + ! second dimension: index 1 is upper limit, index 2 is lower limit + real(r8), allocatable :: zocn_bnds(:,:) + + +contains + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_init_default(my_glc_nzoc) + ! + ! !DESCRIPTION: + ! Initialize GLC z-ocean class data to default values, based on given glc_nzoc + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: my_glc_nzoc ! number of GLC z-ocean classes + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_zocnclass_init' + integer :: i + !----------------------------------------------------------------------- + + glc_nzoc = my_glc_nzoc + allocate(zocn_levels(glc_nzoc)) + + select case (glc_nzoc) + case(0) + ! do nothing + case(4) + zocn_levels = [-250._r8, -750._r8, -1250._r8, -1750._r8] + case(30) + zocn_levels = [ -30._r8, -90._r8, -150._r8, -210._r8, -270._r8, & + -330._r8, -390._r8, -450._r8, -510._r8, -570._r8, & + -630._r8, -690._r8, -750._r8, -810._r8, -870._r8, & + -930._r8, -990._r8, -1050._r8, -1110._r8, -1170._r8, & + -1230._r8, -1290._r8, -1350._r8, -1410._r8, -1470._r8, & + -1530._r8, -1590._r8, -1650._r8, -1710._r8, -1770._r8] + case default + write(logunit,*) subname,' ERROR: unknown glc_nzoc: ', glc_nzoc + call shr_sys_abort(subname//' ERROR: unknown glc_nzoc') + end select + + call glc_zocnclass_init_bnds() + + end subroutine glc_zocnclass_init_default + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_init_bnds() + integer :: i + + allocate(zocn_bnds(2,glc_nzoc)) + zocn_bnds(:,:) = 0._r8 + if (glc_nzoc >= 2) then + zocn_bnds(1,1) = 0._r8 + zocn_bnds(2,1) = 0.5_r8 * (zocn_levels(1) + zocn_levels(2)) + do i = 2, glc_nzoc - 1 + zocn_bnds(1,i) = 0.5_r8 * (zocn_levels(i-1) + zocn_levels(i)) + zocn_bnds(2,i) = 0.5_r8 * (zocn_levels(i) + zocn_levels(i+1)) + enddo + zocn_bnds(1,glc_nzoc) = 0.5_r8 * (zocn_levels(glc_nzoc-1) + zocn_levels(glc_nzoc)) + zocn_bnds(2,glc_nzoc) = zocn_levels(glc_nzoc) + (zocn_levels(glc_nzoc) - zocn_bnds(1,glc_nzoc)) + endif + end subroutine glc_zocnclass_init_bnds + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_init_override(my_glc_nzoc, my_zocn_levels) + ! + ! !DESCRIPTION: + ! Initialize GLC zocn class data to the given z-values + ! + ! The input, my_zocn_levels, should have my_glc_nzoc elements. + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: my_glc_nzoc ! number of GLC z-ocean classes + real(r8), intent(in) :: my_zocn_levels(:) ! z-ocean values (m) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_zocnlass_init_override' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(my_zocn_levels) == (/my_glc_nzoc/)), __FILE__, __LINE__) + + glc_nzoc = my_glc_nzoc + allocate(zocn_levels(glc_nzoc)) + zocn_levels = my_zocn_levels + allocate(zocn_bnds(2,glc_nzoc)) + + call glc_zocnclass_init_bnds() + + end subroutine glc_zocnclass_init_override + + !----------------------------------------------------------------------- + subroutine glc_zocnclass_clean() + ! + ! !DESCRIPTION: + ! Deallocate memory allocated in this module + + character(len=*), parameter :: subname = 'glc_zocnclass_clean' + !----------------------------------------------------------------------- + + if (allocated(zocn_levels)) then + deallocate(zocn_levels) + end if + if (allocated(zocn_bnds)) then + deallocate(zocn_bnds) + end if + glc_nzoc = 0 + + end subroutine glc_zocnclass_clean + + !----------------------------------------------------------------------- + function glc_get_num_zocn_classes() result(num_zocn_classes) + ! + ! !DESCRIPTION: + ! Get the number of GLC z-ocean classes + ! + ! !ARGUMENTS: + integer :: num_zocn_classes ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_num_zocn_classes' + !----------------------------------------------------------------------- + + num_zocn_classes = glc_nzoc + + end function glc_get_num_zocn_classes + + !----------------------------------------------------------------------- + function glc_get_zlevels() result(zlevs) + ! + ! !DESCRIPTION: + ! Get all z-levels + ! + ! This returns an array of size (glc_nzoc) + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: zlevs(glc_nzoc) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_zlevels' + !----------------------------------------------------------------------- + + zlevs(:) = zocn_levels(:) + + end function glc_get_zlevels + + !----------------------------------------------------------------------- + function glc_get_zocnclass_bounds() result(zocnclass_bounds) + ! + ! !DESCRIPTION: + ! Get the boundaries of all z-ocean classes. + ! + ! This returns an array of size (glc_nzoc,2) + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: zocnclass_bounds(2,glc_nzoc) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_zocnclass_bounds' + !----------------------------------------------------------------------- + + zocnclass_bounds(:,:) = zocn_bnds(:,:) + + end function glc_get_zocnclass_bounds + + !----------------------------------------------------------------------- + function glc_zocnclass_as_string(zocn_class) result(zc_string) + ! + ! !DESCRIPTION: + ! Returns a string corresponding to a given elevation class. + ! + ! This string can be used as a suffix for fields in MCT attribute vectors. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=GLC_ZOCNCLASS_STRLEN) :: zc_string ! function result + integer, intent(in) :: zocn_class + ! + ! !LOCAL VARIABLES: + character(len=16) :: format_string + + character(len=*), parameter :: subname = 'glc_zocnclass_as_string' + !----------------------------------------------------------------------- + + ! e.g., for GLC_ZOCNCLASS_STRLEN = 2, format_string will be '(i2.2)' + write(format_string,'(a,i0,a,i0,a)') '(i', GLC_ZOCNCLASS_STRLEN, '.', GLC_ZOCNCLASS_STRLEN, ')' + + write(zc_string,trim(format_string)) zocn_class + end function glc_zocnclass_as_string + + !----------------------------------------------------------------------- + function glc_all_zocnclass_strings(include_zero) result(zc_strings) + ! + ! !DESCRIPTION: + ! Returns an array of strings corresponding to all z-ocean classes from 1 to glc_nzoc + ! + ! If include_zero is present and true, then includes z-ocean class 0 - so goes from + ! 0 to glc_nzoc + ! + ! These strings can be used as suffixes for fields in MCT attribute vectors. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=GLC_ZOCNCLASS_STRLEN), allocatable :: zc_strings(:) ! function result + logical, intent(in), optional :: include_zero ! if present and true, include elevation class 0 (default is false) + ! + ! !LOCAL VARIABLES: + logical :: l_include_zero ! local version of optional include_zero argument + integer :: lower_bound + integer :: i + + character(len=*), parameter :: subname = 'glc_all_zocnclass_strings' + !----------------------------------------------------------------------- + + if (present(include_zero)) then + l_include_zero = include_zero + else + l_include_zero = .false. + end if + + if (l_include_zero) then + lower_bound = 0 + else + lower_bound = 1 + end if + + allocate(zc_strings(lower_bound:glc_nzoc)) + do i = lower_bound, glc_nzoc + zc_strings(i) = glc_zocnclass_as_string(i) + end do + + end function glc_all_zocnclass_strings + + + !----------------------------------------------------------------------- + function glc_zocn_errcode_to_string(err_code) result(err_string) + ! + ! !DESCRIPTION: + ! + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=256) :: err_string ! function result + integer, intent(in) :: err_code ! error code (one of the GLC_ZOCNCLASS_ERR* values) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_errcode_to_string' + !----------------------------------------------------------------------- + + select case (err_code) + case (GLC_ZOCNCLASS_ERR_NONE) + err_string = '(no error)' + case (GLC_ZOCNCLASS_ERR_UNDEFINED) + err_string = 'Z-ocean classes have not yet been defined' + case (GLC_ZOCNCLASS_ERR_TOO_LOW) + err_string = 'Z-level below the lower bound of the lowest z-ocean class' + case (GLC_ZOCNCLASS_ERR_TOO_HIGH) + err_string = 'Z-level above the upper bound of the highest z-ocean class' + case default + err_string = 'UNKNOWN ERROR' + end select + + end function glc_zocn_errcode_to_string + + +end module glc_zocnclass_mod diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 4d151e61ebca..d434ff3937f8 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -238,9 +238,6 @@ module seq_comm_mct integer, public :: mbintxia ! iMOAB id for intx mesh between ice and atmosphere integer, public :: mrofid ! iMOAB id of moab rof app integer, public :: mbrxid ! iMOAB id of moab rof read from file on coupler pes -! integer, public :: mbrmapro ! iMOAB id for read map between river and ocean; it exists on coupler PEs -! ! similar to intx id, oa, la; -! integer, public :: mbrxoid ! iMOAB id for rof migrated to coupler for ocean context (r2o mapping) integer, public :: mbintxro ! iMOAB id for read map between river and ocean; it exists on coupler PEs logical, public :: mbrof_data = .false. ! made true if no rtm mesh, which means data rof ? integer, public :: mbintxar ! iMOAB id for intx mesh between atm and river @@ -678,8 +675,6 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbintxia = -1 ! iMOAB id for ice intx with atm on coupler pes mrofid = -1 ! iMOAB id of moab rof app mbrxid = -1 ! iMOAB id of moab rof migrated to coupler - ! mbrmapro = -1 ! iMOAB id of moab instance of map read from rof2ocn map file - ! mbrxoid = -1 ! iMOAB id of moab instance rof to coupler in ocean context mbintxro = -1 ! iMOAB id of moab instance of map read from rof2ocn map file mbintxar = -1 ! iMOAB id for intx mesh between atm and river mbintxlr = -1 ! iMOAB id for intx mesh between land and river diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index bc432558851d..73126149597f 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -309,6 +309,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) use shr_string_mod, only : shr_string_listIntersect use shr_mpi_mod, only : shr_mpi_bcast use glc_elevclass_mod, only : glc_elevclass_init + use glc_zocnclass_mod, only : glc_zocnclass_init use seq_infodata_mod, only : seq_infodata_type, seq_infodata_getdata ! !INPUT/OUTPUT PARAMETERS: @@ -404,10 +405,11 @@ subroutine seq_flds_set(nmlfile, ID, infodata) logical :: flds_polar logical :: flds_tf integer :: glc_nec + integer :: glc_nzoc namelist /seq_cplflds_inparm/ & flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, flds_polar, flds_tf, & - glc_nec, ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & + glc_nec, glc_nzoc, ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & nan_check_component_fields, rof_heat, atm_flux_method, atm_gustiness, & rof2ocn_nutrients, lnd_rof_two_way, ocn_rof_two_way, rof_sed, & wav_ocn_coup @@ -447,6 +449,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) flds_polar = .false. flds_tf = .false. glc_nec = 0 + glc_nzoc = 0 ice_ncat = 1 seq_flds_i2o_per_cat = .false. nan_check_component_fields = .false. @@ -483,6 +486,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(flds_polar , mpicom) call shr_mpi_bcast(flds_tf , mpicom) call shr_mpi_bcast(glc_nec , mpicom) + call shr_mpi_bcast(glc_nzoc , mpicom) call shr_mpi_bcast(ice_ncat , mpicom) call shr_mpi_bcast(seq_flds_i2o_per_cat, mpicom) call shr_mpi_bcast(nan_check_component_fields, mpicom) @@ -496,6 +500,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(wav_ocn_coup, mpicom) call glc_elevclass_init(glc_nec) + call glc_zocnclass_init(glc_nzoc) !--------------------------------------------------------------------------- ! Read in namelists for user specified new fields @@ -3014,18 +3019,33 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_rhoeff' call metadata_set(attname, longname, stdname, units) - if (flds_tf) then + if ((flds_tf) .and. (glc_nzoc > 0)) then + ! glc fields with multiple ocn z classes: ocn->glc + ! + ! Note that these fields are sent in multiple elevation classes from ocn->cpl + ! and cpl->ocn (which differs from glc_nec variables) - name = 'So_tf2d' - call seq_flds_add(o2x_states,trim(name)) - call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_tf_states_from_ocn,trim(name)) - longname = 'ocean thermal forcing at predefined critical depth' - stdname = 'ocean_thermal_forcing_at_critical_depth' + name = 'So_tf3d' + longname = 'ocean thermal forcing at z-level' + stdname = 'ocean_thermal_forcing_at_z_level' units = 'C' attname = name - call metadata_set(attname, longname, stdname, units) - + call set_glc_zocnclass_field(name, attname, longname, stdname, units, o2x_states) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_states, & + additional_list = .true.) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_tf_states_from_ocn, & + additional_list = .true.) + + name = 'So_tf3d_mask' + longname = 'mask of valid ocean thermal forcing at z-level' + stdname = 'mask_ocean_thermal_forcing_at_z_level' + units = 'none' + attname = name + call set_glc_zocnclass_field(name, attname, longname, stdname, units, o2x_states) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_states, & + additional_list = .true.) + call set_glc_zocnclass_field(name, attname, longname, stdname, units, x2g_tf_states_from_ocn, & + additional_list = .true.) end if name = 'Fogx_qicelo' @@ -4393,6 +4413,66 @@ end subroutine set_glc_elevclass_field !=============================================================================== + subroutine set_glc_zocnclass_field(name, attname, longname, stdname, units, fieldlist, & + additional_list) + + ! Sets a coupling field for all ocn z classes (1:glc_nzoc) + ! + ! Note that, if glc_nzoc = 0, then we don't create any coupling fields + ! + ! Puts the coupling fields in the given fieldlist, and also does the appropriate + ! metadata_set calls. + ! + ! additional_list should be .false. (or absent) the first time this is called for a + ! given set of coupling fields. However, if this same set of coupling fields is being + ! added to multiple field lists, then additional_list should be set to true for the + ! second and subsequent calls; in this case, the metadata_set calls are not done + ! (because they have already been done). + ! + ! name, attname and longname give the base name of the field; the ocn z class + ! index will be appended as a suffix + + ! !USES: + use glc_zocnclass_mod, only : glc_get_num_zocn_classes, glc_zocnclass_as_string + + ! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: name ! base field name to add to fieldlist + character(len=*), intent(in) :: attname ! base field name for metadata + character(len=*), intent(in) :: longname ! base long name for metadata + character(len=*), intent(in) :: stdname ! standard name for metadata + character(len=*), intent(in) :: units ! units for metadata + character(len=*), intent(inout) :: fieldlist ! field list into which the fields should be added + + logical, intent(in), optional :: additional_list ! whether this is an additional list for the same set of coupling fields (see above for details; defaults to false) + + !EOP + integer :: num + character(len= 16) :: cnum + logical :: l_additional_list ! local version of the optional additional_list argument + + l_additional_list = .false. + if (present(additional_list)) then + l_additional_list = additional_list + end if + + if (glc_get_num_zocn_classes() > 0) then + do num = 1, glc_get_num_zocn_classes() + cnum = glc_zocnclass_as_string(num) + + call seq_flds_add(fieldlist, trim(name) // trim(cnum)) + + if (.not. l_additional_list) then + call metadata_set(attname = trim(attname) // trim(cnum), & + longname = trim(longname) // ' of thermal forcing class ' // trim(cnum), & + stdname = stdname, & + units = units) + end if + end do + end if + end subroutine set_glc_zocnclass_field + + !=============================================================================== + subroutine seq_flds_esmf_metadata_get(shortname, longname, stdname, units) ! !USES: diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index a602ad9b53d3..f8d1f2cb909a 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -209,6 +209,7 @@ MODULE seq_infodata_mod logical :: glcice_present ! does glc have iceberg coupling on logical :: glc_prognostic ! does component model need input data from driver logical :: glc_coupled_fluxes ! does glc send fluxes to other components (only relevant if glc_present is .true.) + integer :: glc_nzoc ! number of z-levels for ocn/glc thermal forcing coupling logical :: wav_present ! does component model exist logical :: wav_prognostic ! does component model need input data from driver logical :: esp_present ! does component model exist @@ -777,6 +778,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) ! if glc_present is .false., so it's okay to just start out assuming it's .true. ! in all cases. infodata%glc_coupled_fluxes = .true. + infodata%glc_nzoc = 0 infodata%wav_prognostic = .false. infodata%iac_prognostic = .false. infodata%iceberg_prognostic = .false. @@ -1024,7 +1026,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ ice_present, ice_prognostic, & glc_present, glc_prognostic, & iac_present, iac_prognostic, & - glc_coupled_fluxes, & + glc_coupled_fluxes, glc_nzoc, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & @@ -1205,6 +1207,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: glcice_present logical, optional, intent(OUT) :: glc_prognostic logical, optional, intent(OUT) :: glc_coupled_fluxes + integer, optional, intent(OUT) :: glc_nzoc logical, optional, intent(OUT) :: wav_present logical, optional, intent(OUT) :: wav_prognostic logical, optional, intent(OUT) :: iac_present @@ -1399,6 +1402,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(glcice_present) ) glcice_present = infodata%glcice_present if ( present(glc_prognostic) ) glc_prognostic = infodata%glc_prognostic if ( present(glc_coupled_fluxes)) glc_coupled_fluxes = infodata%glc_coupled_fluxes + if ( present(glc_nzoc) ) glc_nzoc = infodata%glc_nzoc if ( present(wav_present) ) wav_present = infodata%wav_present if ( present(wav_prognostic) ) wav_prognostic = infodata%wav_prognostic if ( present(esp_present) ) esp_present = infodata%esp_present @@ -1593,7 +1597,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ ocn_c2_glcshelf, ocn_c2_glctf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & - glc_coupled_fluxes, & + glc_coupled_fluxes, glc_nzoc, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & @@ -1776,6 +1780,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: glcice_present logical, optional, intent(IN) :: glc_prognostic logical, optional, intent(IN) :: glc_coupled_fluxes + integer, optional, intent(IN) :: glc_nzoc logical, optional, intent(IN) :: wav_present logical, optional, intent(IN) :: wav_prognostic logical, optional, intent(IN) :: esp_present @@ -1969,6 +1974,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glcice_present) ) infodata%glcice_present = glcice_present if ( present(glc_prognostic) ) infodata%glc_prognostic = glc_prognostic if ( present(glc_coupled_fluxes)) infodata%glc_coupled_fluxes = glc_coupled_fluxes + if ( present(glc_nzoc) ) infodata%glc_nzoc = glc_nzoc if ( present(wav_present) ) infodata%wav_present = wav_present if ( present(wav_prognostic) ) infodata%wav_prognostic = wav_prognostic if ( present(iac_present) ) infodata%iac_present = iac_present @@ -2285,6 +2291,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glcice_present, mpicom) call shr_mpi_bcast(infodata%glc_prognostic, mpicom) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom) + call shr_mpi_bcast(infodata%glc_nzoc, mpicom) call shr_mpi_bcast(infodata%wav_present, mpicom) call shr_mpi_bcast(infodata%wav_prognostic, mpicom) call shr_mpi_bcast(infodata%esp_present, mpicom) @@ -2602,6 +2609,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%glcice_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%glc_nzoc, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%glc_ny, mpicom, pebcast=cmppe) ! dead_comps is true if it's ever set to true @@ -2661,6 +2669,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%glcice_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%glc_nzoc, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%iac_present, mpicom, pebcast=cplpe) @@ -3015,6 +3024,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'glcice_present = ', infodata%glcice_present write(logunit,F0L) subname,'glc_prognostic = ', infodata%glc_prognostic write(logunit,F0L) subname,'glc_coupled_fluxes = ', infodata%glc_coupled_fluxes + write(logunit,F0L) subname,'glc_nzoc = ', infodata%glc_nzoc write(logunit,F0L) subname,'wav_present = ', infodata%wav_present write(logunit,F0L) subname,'wav_prognostic = ', infodata%wav_prognostic write(logunit,F0L) subname,'iac_present = ', infodata%iac_present diff --git a/externals/YAKL b/externals/YAKL index e3757faedffd..d9d33d802377 160000 --- a/externals/YAKL +++ b/externals/YAKL @@ -1 +1 @@ -Subproject commit e3757faedffd41c6ae68cf4dbd1324e628a48ddd +Subproject commit d9d33d8023772ee203f043c68857b565a0e8f50b diff --git a/externals/mam4xx b/externals/mam4xx index 9764ddb46079..b189481e4ad6 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit 9764ddb4607935105fa3d751e93f2a137463b8db +Subproject commit b189481e4ad66e4c5f91278ccfe7555abb903c39 diff --git a/externals/scorpio b/externals/scorpio index e260abe9c4c3..69246b4d007d 160000 --- a/externals/scorpio +++ b/externals/scorpio @@ -1 +1 @@ -Subproject commit e260abe9c4c31813c8a23d1e74046f7e9b36f8f7 +Subproject commit 69246b4d007d72ab3dd4f65c8260dd6526ad6063 diff --git a/mkdocs.yaml b/mkdocs.yaml index fc1508f4c397..e2a806af550f 100644 --- a/mkdocs.yaml +++ b/mkdocs.yaml @@ -62,6 +62,7 @@ markdown_extensions: - pymdownx.arithmatex: generic: true - md_in_html + - attr_list - tables - pymdownx.emoji: emoji_index: !!python/name:material.extensions.emoji.twemoji diff --git a/share/build/buildlib.spio b/share/build/buildlib.spio index 064fa751e4ae..aec59c6edf9f 100755 --- a/share/build/buildlib.spio +++ b/share/build/buildlib.spio @@ -145,10 +145,8 @@ def buildlib(bldroot, installpath, case): # elif which_h5dump is not None: # os.environ["HDF5"] = os.path.dirname(os.path.dirname(which_h5dump)) - # Before E3SM upgrades scorpio submodule to 1.5.0 or higher, keep WITH_HDF5 - # CMake option OFF by default. - # if "HDF5_ROOT" in os.environ: - # cmake_opts += "-DWITH_HDF5:BOOL=ON " + if "HDF5_ROOT" in os.environ: + cmake_opts += "-DWITH_HDF5:BOOL=ON " # Same deal with libz and szip if "ZLIB_ROOT" in os.environ: