diff --git a/.testing/Makefile b/.testing/Makefile index f032631123..66247a252a 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -84,8 +84,9 @@ SOURCE = $(wildcard $(BASE)/src/*/*.F90 $(BASE)/src/*/*/*.F90 $(BASE)/config_src #--- # Rules -.PHONY: all +.PHONY: all build.regressions all: $(foreach b,$(BUILDS),$(BUILD)/$(b)/MOM6) +build.regressions: $(foreach b,symmetric target,$(BUILD)/$(b)/MOM6) # Executable BUILD_TARGETS = MOM6 Makefile path_names @@ -179,7 +180,6 @@ test: $(foreach t,$(TESTS),test.$(t)) # NOTE: We remove tc3 (OBC) from grid test since it cannot run asymmetric grids .PHONY: $(foreach t,$(TESTS),test.$(t)) -test.regressions: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) test.grids: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(c).grid $(c).grid.diag) test.layouts: $(foreach c,$(CONFIGS),$(c).layout $(c).layout.diag) test.restarts: $(foreach c,$(CONFIGS),$(c).restart) @@ -188,6 +188,9 @@ test.openmps: $(foreach c,$(CONFIGS),$(c).openmp $(c).openmp.diag) test.nans: $(foreach c,$(CONFIGS),$(c).nan $(c).nan.diag) test.dims: $(foreach c,$(CONFIGS),$(foreach d,t l h z,$(c).dim.$(d) $(c).dim.$(d).diag)) +test.regressions: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) + ! ls -1 results/*/*.reg + define CMP_RULE .PRECIOUS: $(foreach b,$(2),results/%/ocean.stats.$(b)) %.$(1): $(foreach b,$(2),results/%/ocean.stats.$(b)) @@ -198,7 +201,6 @@ define CMP_RULE cmp $$^ || diff $$^ endef -$(eval $(call CMP_RULE,regression,symmetric target)) $(eval $(call CMP_RULE,grid,symmetric asymmetric)) $(eval $(call CMP_RULE,layout,symmetric layout)) $(eval $(call CMP_RULE,repro,symmetric repro)) @@ -206,14 +208,23 @@ $(eval $(call CMP_RULE,openmp,symmetric openmp)) $(eval $(call CMP_RULE,nan,symmetric nan)) $(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) +# Custom comparison rules + +.PRECIOUS: $(foreach b,symmetric restart target,results/%/ocean.stats.$(b)) + # Restart tests only compare the final stat record -.PRECIOUS: $(foreach b,symmetric restart,results/%/ocean.stats.$(b)) %.restart: $(foreach b,symmetric restart,results/%/ocean.stats.$(b)) cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) \ || diff $^ # TODO: chksum_diag parsing of restart files +# All regression tests must be completed when considering answer changes +%.regression: $(foreach b,symmetric target,results/%/ocean.stats.$(b)) + cmp $^ || (diff $^ > $<.reg || true) + +%.regression.diag: $(foreach b,symmetric target,results/%/chksum_diag.$(b)) + cmp $^ || (diff $^ > $<.reg || true) #--- # Test run output files diff --git a/.travis.yml b/.travis.yml index 41d9d9b348..2cefbd8771 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,31 +17,46 @@ addons: packages: - tcsh pkg-config netcdf-bin libnetcdf-dev libnetcdff-dev openmpi-bin libopenmpi-dev gfortran - doxygen graphviz flex bison cmake + - python-numpy python-netcdf4 jobs: include: - - env: JOB="Code style compliance" + - env: JOB="Code compliance" script: + # Whitespace - ./.testing/trailer.py -e TEOS10 -l 120 src config_src - - env: JOB="Doxygen" - script: + # API Documentation - cd docs && doxygen Doxyfile_nortd - grep -v "config_src/solo_driver/coupler_types.F90" doxygen.log | tee doxy_errors - test ! -s doxy_errors - - env: JOB="Compile and run" + + - env: + - JOB="Configuration testing" + - DO_REGRESSION_TESTS=false + - MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk script: + - cd .testing - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' - - TRAVIS_IS_PR=$( [ ${TRAVIS_PULL_REQUEST} = "false" ] || echo "true" ) + - make all + - echo -en 'travis_fold:end:script.1\\r' + - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' + - make test + - echo -en 'travis_fold:end:script.2\\r' + + # NOTE: Code coverage upload is here to reduce load imbalance + - if: type = pull_request + env: + - JOB="Regression testing" + - DO_REGRESSION_TESTS=true + - REPORT_COVERAGE=true + - MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk + - MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} + - MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} + script: - cd .testing - - make \ - MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ - MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ - MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ - DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ - REPORT_COVERAGE=true + - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' + - make build.regressions - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' - - make test \ - DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ - REPORT_COVERAGE=true + - make test.regressions - echo -en 'travis_fold:end:script.2\\r' diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 4102bba491..08a09dbe23 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -66,7 +66,7 @@ module MOM_surface_forcing_gfdl logical :: use_temperature !< If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress [nondim]. - real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: area_surf = -1.0 !< Total ocean surface area [m2] real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] @@ -85,18 +85,18 @@ module MOM_surface_forcing_gfdl !! type without any further adjustments to drive the ocean dynamics. !! The actual net mass source may differ due to corrections. - real :: gust_const !< Constant unresolved background gustiness for ustar [Pa] + real :: gust_const !< Constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL() !< Turbulent kinetic energy introduced to the bottom boundary layer - !! by drag on the tidal flows [W m-2]. + !! by drag on the tidal flows [R Z3 T-3 ~> W m-2]. real, pointer, dimension(:,:) :: & gust => NULL() !< A spatially varying unresolved background gustiness that - !! contributes to ustar [Pa]. gust is used when read_gust_2d is true. + !! contributes to ustar [R L Z T-1 ~> Pa]. gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & - ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity [m s-1] + ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional) - real :: utide !< Constant tidal velocity to use if read_tideamp is false [m s-1]. + real :: utide !< Constant tidal velocity to use if read_tideamp is false [Z T-1 ~> m s-1]. logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface @@ -113,7 +113,7 @@ module MOM_surface_forcing_gfdl !! salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea !! surface temperature to a specified value. - real :: Flux_const !< Piston velocity for surface restoring [m s-1] + real :: Flux_const !< Piston velocity for surface restoring [Z T-1 ~> m s-1] logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux logical :: adjust_net_srestore_to_zero !< Adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< Adjust srestore w/o moving zero contour @@ -242,7 +242,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc real :: delta_sss ! temporary storage for sss diff from restoring value [ppt] real :: delta_sst ! temporary storage for sst diff from restoring value [degC] - real :: C_p ! heat capacity of seawater [J degC-1 kg-1] + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. + real :: rhoXcp ! Reference density times heat capacity times unit scaling + ! factors [J T s-1 Z-1 m-2 degC-1 ~> J m-3 degC-1] real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) @@ -255,7 +258,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 - C_p = fluxes%C_p + kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s + if (CS%restore_temp) rhoXcp = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * CS%Rho0 * fluxes%C_p open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -298,7 +302,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo ; enddo if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -353,16 +357,18 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & - (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 + (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! R Z T-1 ~> kg Salt m-2 s-1 enddo ; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl, & + unit_scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*US%R_to_kg_m3*US%Z_to_m*US%s_to_T * & + G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - kg_m2_s_conversion * fluxes%saltFluxGlobalAdj endif endif fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic @@ -378,13 +384,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc enddo ; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl, & + unit_scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je) * & + US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - kg_m2_s_conversion*fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) enddo ; enddo endif endif @@ -398,7 +406,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & - (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + rhoXcp * delta_sst * CS%Flux_const ! W m-2 enddo ; enddo endif @@ -408,31 +416,31 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie if (associated(IOB%lprec)) then - fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lprec(i,j) = kg_m2_s_conversion * IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) endif if (associated(IOB%fprec)) then - fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%fprec(i,j) = kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) endif if (associated(IOB%q_flux)) then - fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%evap(i,j) = - kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) endif if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = kg_m2_s_conversion * IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) endif if (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%frunoff(i,j) = kg_m2_s_conversion * IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) endif @@ -456,13 +464,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc endif if (associated(IOB%runoff_hflx)) then - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_lrunoff(i,j) = kg_m2_s_conversion * IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) endif if (associated(IOB%calving_hflx)) then - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) endif @@ -543,8 +551,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( -IOB%salt_flux(i-i0,j-j0) ) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - kg_m2_s_conversion*IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( -kg_m2_s_conversion*IOB%salt_flux(i-i0,j-j0) ) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) enddo ; enddo @@ -565,7 +573,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc sign_for_net_FW_bug = 1. if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & + net_FW(i,j) = US%R_to_kg_m3*US%Z_to_m*US%s_to_T* & + (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice @@ -583,13 +592,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + fluxes%vprec(i,j) = fluxes%vprec(i,j) + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * & (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - kg_m2_s_conversion * fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) enddo ; enddo endif @@ -611,7 +620,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (CS%allow_flux_adjustments) then ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, fluxes) + call apply_flux_adjustments(G, US, CS, Time, fluxes) endif ! Allow for user-written code to alter fluxes after all the above @@ -836,7 +845,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (CS%allow_flux_adjustments) then ! Apply adjustments to forces - call apply_force_adjustments(G, CS, Time, forces) + call apply_force_adjustments(G, US, CS, Time, forces) endif !### ! Allow for user-written code to alter fluxes after all the above @@ -862,9 +871,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid [Pa]. + optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid [R Z L T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid [Pa]. + optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid [R Z L T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(inout) :: ustar !< The surface friction velocity [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), & @@ -873,17 +882,19 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses [Pa] at h points - real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses [Pa] at h points + real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses [R Z L T-2 ~> Pa] at h points + real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses [R Z L T-2 ~> Pa] at h points real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses [Pa] at u points - real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses [Pa] at v points + real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses [R Z L T-2 ~> Pa] at v points real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses [Pa] at q points - real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [Pa] at q points + real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [R Z L T-2 ~> Pa] at q points - real :: gustiness ! unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 ! Inverse of the mean density rescaled to [Z2 s2 m T-2 kg-1 ~> m3 kg-1] - real :: taux2, tauy2 ! squared wind stresses [Pa2] - real :: tau_mag ! magnitude of the wind stress [Pa] + real :: gustiness ! unresolved gustiness that contributes to ustar [R Z L T-2 ~> Pa] + real :: Irho0 ! Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1] + real :: taux2, tauy2 ! squared wind stresses [R2 Z2 L2 T-4 ~> Pa2] + real :: tau_mag ! magnitude of the wind stress [R Z L T-2 ~> Pa] + real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress units [R Z L T-2 Pa-1 ~> 1] + real :: stress_conversion ! A unit conversion factor from Pa times any stress multiplier [R Z L T-2 Pa-1 ~> 1] logical :: do_ustar, do_gustless integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) @@ -895,7 +906,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) - Irho0 = (US%m_to_Z*US%T_to_s)**2 / CS%Rho0 + IRho0 = US%L_to_Z / CS%Rho0 + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + stress_conversion = Pa_conversion * CS%wind_stress_multiplier do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) @@ -916,8 +929,8 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, taux_in_B(:,:) = 0.0 ; tauy_in_B(:,:) = 0.0 if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then do J=js,je ; do I=is,ie - taux_in_B(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - tauy_in_B(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + taux_in_B(I,J) = IOB%u_flux(i-i0,j-j0) * stress_conversion + tauy_in_B(I,J) = IOB%v_flux(i-i0,j-j0) * stress_conversion enddo ; enddo endif @@ -942,8 +955,8 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, taux_in_A(:,:) = 0.0 ; tauy_in_A(:,:) = 0.0 if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then do j=js,je ; do i=is,ie - taux_in_A(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - tauy_in_A(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + taux_in_A(i,j) = IOB%u_flux(i-i0,j-j0) * stress_conversion + tauy_in_A(i,j) = IOB%v_flux(i-i0,j-j0) * stress_conversion enddo ; enddo endif @@ -971,8 +984,8 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, taux_in_C(:,:) = 0.0 ; tauy_in_C(:,:) = 0.0 if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then do j=js,je ; do i=is,ie - taux_in_C(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - tauy_in_C(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + taux_in_C(I,j) = IOB%u_flux(i-i0,j-j0) * stress_conversion + tauy_in_C(i,J) = IOB%v_flux(i-i0,j-j0) * stress_conversion enddo ; enddo endif @@ -1006,15 +1019,15 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & gustiness = CS%gust(i,j) endif - ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + ustar(i,j) = sqrt(gustiness*IRho0 + IRho0*Pa_conversion*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (CS%answers_2018) then if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + gustless_ustar(i,j) = sqrt(Pa_conversion*US%L_to_Z*IOB%stress_mag(i-i0,j-j0) / CS%Rho0) enddo ; enddo ; endif else if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) + gustless_ustar(i,j) = sqrt(IRho0 * Pa_conversion*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif endif elseif (wind_stagger == BGRID_NE) then @@ -1029,11 +1042,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag) if (CS%answers_2018) then - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0) else - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(IRho0 * tau_mag) endif enddo ; enddo elseif (wind_stagger == AGRID) then @@ -1041,11 +1054,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag) if (CS%answers_2018) then - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0) else - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(IRho0 * tau_mag) endif enddo ; enddo else ! C-grid wind stresses. @@ -1062,11 +1075,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d) gustiness = CS%gust(i,j) - if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag) if (CS%answers_2018) then - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0) else - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(IRho0 * tau_mag) endif enddo ; enddo endif ! endif for wind friction velocity fields @@ -1081,8 +1094,9 @@ end subroutine extract_IOB_stresses !! - hflx_adj (Heat flux into the ocean [W m-2]) !! - sflx_adj (Salt flux into the ocean [kg salt m-2 s-1]) !! - prcme_adj (Fresh water flux into the ocean [kg m-2 s-1]) -subroutine apply_flux_adjustments(G, CS, Time, fluxes) +subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure type(forcing), intent(inout) :: fluxes !< Surface fluxes structure @@ -1107,7 +1121,8 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + & + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) @@ -1115,7 +1130,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) end subroutine apply_flux_adjustments @@ -1125,21 +1140,24 @@ end subroutine apply_flux_adjustments !! Available adjustments are: !! - taux_adj (Zonal wind stress delta, positive to the east [Pa]) !! - tauy_adj (Meridional wind stress delta, positive to the north [Pa]) -subroutine apply_force_adjustments(G, CS, Time, forces) +subroutine apply_force_adjustments(G, US, CS, Time, forces) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points [Pa] - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points [Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points [R Z L T-2 ~> Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points [R Z L T-2 ~> Pa] integer :: isc, iec, jsc, jec, i, j real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] logical :: overrode_x, overrode_y isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged @@ -1160,8 +1178,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) if (rDlon > 0.) rDlon = 1. / rDlon cosA = dLonDx * rDlon sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) + zonal_tau = Pa_conversion * tempx_at_h(i,j) + merid_tau = Pa_conversion * tempy_at_h(i,j) tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau enddo ; enddo @@ -1210,7 +1228,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) !! structure for this module ! Local variables - real :: utide ! The RMS tidal velocity [m s-1]. + real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags logical :: default_2018_answers @@ -1254,7 +1272,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & @@ -1333,8 +1351,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & "A file in which to find the surface salinity to use for restoring.", & default="salt_restore.nc") @@ -1381,8 +1399,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & "A file in which to find the surface temperature to use for restoring.", & default="temp_restore.nc") @@ -1421,7 +1439,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) else call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) endif call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) @@ -1429,7 +1447,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1) + call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1, scale=US%m_to_Z*US%T_to_s) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) @@ -1437,7 +1455,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) enddo ; enddo else do j=jsd,jed; do i=isd,ied - utide=CS%utide + utide = CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo @@ -1450,8 +1468,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) + "The background gustiness in the winds.", & + units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & "The file in which the wind gustiness is found in "//& @@ -1459,7 +1477,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa + call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, & + scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index c5d10c7aaf..9982754053 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -520,7 +520,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) #ifdef _USE_GENERIC_TRACER @@ -541,7 +541,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) @@ -554,7 +554,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! The net mass forcing is not currently used in the MOM6 dynamics solvers, so this is may be unnecessary. if (do_dyn .and. associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & - call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) + call get_net_mass_forcing(OS%fluxes, OS%grid, OS%US, OS%forces%net_mass_src) if (OS%use_waves .and. do_thermo) then ! For now, the waves are only updated on the thermodynamics steps, because that is where @@ -654,7 +654,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (OS%fluxes%fluxes_used .and. do_thermo) then call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%diag, OS%forcing_CSp%handles) + OS%grid, OS%US, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) endif diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index ad2352d460..b2e26b0c66 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -97,13 +97,13 @@ module MOM_surface_forcing real :: south_lat ! southern latitude of the domain real :: len_lat ! domain length in latitude - real :: Rho0 ! Boussinesq reference density [kg m-3] + real :: Rho0 ! Boussinesq reference density [R ~> kg m-3] real :: G_Earth ! gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - real :: Flux_const ! piston velocity for surface restoring [m s-1] + real :: Flux_const ! piston velocity for surface restoring [Z T-1 ~> m s-1] - real :: gust_const ! constant unresolved background gustiness for ustar [Pa] + real :: gust_const ! constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d ! if true, use 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() ! spatially varying unresolved background gustiness [Pa] + real, pointer :: gust(:,:) => NULL() ! spatially varying unresolved background gustiness [R L Z T-1 ~> Pa] ! gust is used when read_gust_2d is true. real, pointer :: T_Restore(:,:) => NULL() ! temperature to damp (restore) the SST to [degC] @@ -275,7 +275,7 @@ subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, U if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & (.not.CS%adiabatic)) then - call set_net_mass_forcing(fluxes, forces, G) + call set_net_mass_forcing(fluxes, forces, G, US) endif CS%first_call_set_forcing = .false. @@ -352,11 +352,11 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)/CS%Rho0) + forces%ustar(i,j) = sqrt(US%L_to_Z*CS%gust(i,j)/CS%Rho0) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const/CS%Rho0) + forces%ustar(i,j) = sqrt(US%L_to_Z*CS%gust_const/CS%Rho0) enddo ; enddo ; endif endif @@ -389,8 +389,8 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) PI = 4.0*atan(1.0) do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.1*(1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / & - CS%len_lat)) + forces%taux(I,j) = 0.1*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie @@ -426,7 +426,8 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) PI = 4.0*atan(1.0) do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) =-0.2*cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) + forces%taux(I,j) = -0.2*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie @@ -464,9 +465,9 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) do j=jsd,jed ; do I=IsdB,IedB y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat - forces%taux(I,j) = CS%gyres_taux_const + & + forces%taux(I,j) = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * (CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & - + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) + + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) )) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -475,9 +476,9 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & - forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & - forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_S * (CS%gust_const/CS%Rho0 + & + sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + forces%tauy(i,j)*forces%tauy(i,j) + & + forces%taux(i-1,j)*forces%taux(i-1,j) + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0) ) enddo ; enddo call callTree_leave("wind_forcing_gyres") @@ -502,6 +503,8 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) character(len=200) :: filename ! The name of the input file. real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [Pa]. + real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress + ! units [R Z L T-2 Pa-1 ~> 1] integer :: days, seconds call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") @@ -510,6 +513,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z call get_time(day,seconds,days) time_lev = days - 365*floor(real(days) / 365.0) +1 @@ -524,7 +528,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & temp_x(:,:), temp_y(:,:), G%Domain, stagger=AGRID, & - timelevel=time_lev) + timelevel=time_lev, scale=Pa_conversion) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=js,je ; do I=Isq,Ieq @@ -536,19 +540,20 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & - temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) + forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust(i,j) + & + sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j)) ) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & - temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + & + sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j)) / CS%Rho0) ) enddo ; enddo endif case ("C") call MOM_read_vector(filename,CS%stress_x_var, CS%stress_y_var, & forces%taux(:,:), forces%tauy(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, & + scale=Pa_conversion) if (CS%wind_scale /= 1.0) then do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = CS%wind_scale * forces%taux(I,j) @@ -561,15 +566,15 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & - forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & - forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) + forces%ustar(i,j) = sqrt( (CS%gust(i,j) + & + sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & + (forces%taux(i-1,j)**2 + forces%taux(i,j)**2)))) * US%L_to_Z / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & - forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & - forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + & + sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & + (forces%taux(i-1,j)**2 + forces%taux(i,j)**2))) / CS%Rho0) ) enddo ; enddo endif case default @@ -624,7 +629,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call buoyancy_forcing_allocate(fluxes, G, CS) if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p - Irho0 = 1.0/CS%Rho0 + Irho0 = 1.0/(US%R_to_kg_m3*CS%Rho0) ! Read the file containing the buoyancy forcing. call get_time(day,seconds,days) @@ -665,7 +670,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) temp(:,:), G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie fluxes%latent(i,j) = -hlv*temp(i,j) - fluxes%evap(i,j) = -temp(i,j) + fluxes%evap(i,j) = -US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo @@ -683,20 +688,20 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%snow_file), "snow", & - fluxes%fprec(:,:), G%Domain, timelevel=time_lev) + fluxes%fprec(:,:), G%Domain, timelevel=time_lev, scale=US%kg_m3_to_R*US%m_to_Z*US%T_to_s) call MOM_read_data(trim(CS%inputdir)//trim(CS%precip_file), "precip", & - fluxes%lprec(:,:), G%Domain, timelevel=time_lev) + fluxes%lprec(:,:), G%Domain, timelevel=time_lev, scale=US%kg_m3_to_R*US%m_to_Z*US%T_to_s) do j=js,je ; do i=is,ie fluxes%lprec(i,j) = fluxes%lprec(i,j) - fluxes%fprec(i,j) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_w", & - temp(:,:), G%Domain, timelevel=time_lev_monthly) + temp(:,:), G%Domain, timelevel=time_lev_monthly, scale=US%kg_m3_to_R*US%m_to_Z*US%T_to_s) do j=js,je ; do i=is,ie fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_s", & - temp(:,:), G%Domain, timelevel=time_lev_monthly) + temp(:,:), G%Domain, timelevel=time_lev_monthly, scale=US%kg_m3_to_R*US%m_to_Z*US%T_to_s) do j=js,je ; do i=is,ie fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo @@ -726,10 +731,11 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) - fluxes%heat_content_lrunoff(i,j) = fluxes%C_p*fluxes%lrunoff(i,j)*sfc_state%SST(i,j) + fluxes%heat_content_lrunoff(i,j) = fluxes%C_p * & + fluxes%lrunoff(i,j)*sfc_state%SST(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent_evap_diag(i,j) * G%mask2dT(i,j) - fluxes%latent_fprec_diag(i,j) = -fluxes%fprec(i,j)*hlf - fluxes%latent_frunoff_diag(i,j) = -fluxes%frunoff(i,j)*hlf + fluxes%latent_fprec_diag(i,j) = -US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%fprec(i,j)*hlf + fluxes%latent_frunoff_diag(i,j) = -US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%frunoff(i,j)*hlf enddo ; enddo endif ! time_lev /= CS%buoy_last_lev_read @@ -739,7 +745,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%heat_restore(i,j) = G%mask2dT(i,j) * & - ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) + ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const) fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & (CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) @@ -752,7 +758,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) + (CS%G_Earth * CS%Flux_const/(US%R_to_kg_m3*CS%Rho0)) else fluxes%buoy(i,j) = 0.0 endif @@ -871,8 +877,8 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) T_restore = CS%T_south + (CS%T_north-CS%T_south)*y S_restore = CS%S_south + (CS%S_north-CS%S_south)*y if (G%mask2dT(i,j) > 0) then - fluxes%heat_restore(i,j) = G%mask2dT(i,j) * & - ((T_Restore - sfc_state%SST(i,j)) * ((CS%Rho0 * fluxes%C_p) * CS%Flux_const)) + fluxes%heat_restore(i,j) = G%mask2dT(i,j) * US%Z_to_m*US%s_to_T * & + ((T_Restore - sfc_state%SST(i,j)) * (((US%R_to_kg_m3*CS%Rho0) * fluxes%C_p) * CS%Flux_const)) fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & (S_Restore - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + S_Restore)) @@ -886,8 +892,8 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) "RESTOREBUOY to linear not written yet.") !do j=js,je ; do i=is,ie ! if (G%mask2dT(i,j) > 0) then - ! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - ! (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) + ! fluxes%buoy(i,j) = US%kg_m3_to_R*(CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & + ! (CS%G_Earth * CS%Flux_const / CS%Rho0) ! else ! fluxes%buoy(i,j) = 0.0 ! endif @@ -1075,7 +1081,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& "toward some specified surface state with a rate "//& @@ -1084,8 +1090,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 if (trim(CS%buoy_config) == "linear") then @@ -1112,8 +1118,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) + "The background gustiness in the winds.", & + units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1123,8 +1129,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) ; CS%gust(:,:) = 0.0 filename = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(filename,'gustiness',CS%gust,G%domain, & - timelevel=1) ! units should be Pa + call MOM_read_data(filename,'gustiness',CS%gust,G%domain, timelevel=1, & + scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 1652db2ceb..57accf2ef5 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -78,12 +78,11 @@ module user_surface_forcing logical :: use_temperature ! If true, temperature and salinity are used as ! state variables. logical :: restorebuoy ! If true, use restoring surface buoyancy forcing. - real :: Rho0 ! The density used in the Boussinesq - ! approximation [kg m-3]. + real :: Rho0 ! The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. - real :: Flux_const ! The restoring rate at the surface [m s-1]. + real :: Flux_const ! The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const ! A constant unresolved background gustiness - ! that contributes to ustar [Pa]. + ! that contributes to ustar [R Z L T-1 ~> Pa]. type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the ! timing of diagnostic output. @@ -91,7 +90,7 @@ module user_surface_forcing contains -!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy, in [Pa]. +!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy, in [R Z L T-2 ~> Pa]. !! These are the stresses in the direction of the model grid (i.e. the same !! direction as the u- and v- velocities). subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) @@ -104,7 +103,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy [Pa]. +! This subroutine sets the surface wind stresses, forces%taux and forces%tauy [R Z L T-2 ~> Pa]. ! In addition, this subroutine can be used to set the surface friction velocity, ! forces%ustar [Z T-1 ~> m s-1], which is needed with a bulk mixed layer. @@ -130,7 +129,8 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 ! Change this to the desired expression. + ! Change this to the desired expression. + forces%taux(I,j) = G%mask2dCu(I,j) * 0.0*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z enddo ; enddo do J=js-1,Jeq ; do i=is,ie forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. @@ -139,9 +139,9 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Set the surface friction velocity [Z s-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + & + sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0)) enddo ; enddo ; endif end subroutine USER_wind_forcing @@ -173,7 +173,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! (fprec, lrunoff and frunoff) left as arrays full of zeros. ! Evap is usually negative and precip is usually positive. All heat fluxes ! are in W m-2 and positive for heat going into the ocean. All fresh water -! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. +! fluxes are in [R Z T-1 ~> kg m-2 s-1] and positive for water moving into the ocean. real :: Temp_restore ! The temperature that is being restored toward [C]. real :: Salin_restore ! The salinity that is being restored toward [ppt] @@ -181,7 +181,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -249,18 +249,17 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & "Temperature and salinity restoring used without modification." ) - rhoXcp = CS%Rho0 * fluxes%C_p + rhoXcp = US%R_to_kg_m3*CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in ppt or PSU) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 - fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & + fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const)) * & (Temp_restore - sfc_state%SST(i,j)) fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & - ((Salin_restore - sfc_state%SSS(i,j)) / & - (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) + ((Salin_restore - sfc_state%SSS(i,j)) / (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) enddo ; enddo else ! When modifying the code, comment out this error message. It is here @@ -269,14 +268,14 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & - (density_restore - sfc_state%sfc_density(i,j)) + US%kg_m3_to_R*(density_restore - sfc_state%sfc_density(i,j)) enddo ; enddo endif endif ! end RESTOREBUOY @@ -319,10 +318,10 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%R_to_kg_m3) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) + "The background gustiness in the winds.", & + units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& @@ -332,8 +331,8 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 endif diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index e6c3556d59..240766a8d2 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -528,10 +528,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (OS%icebergs_alter_ocean) then if (do_dyn) & - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + call iceberg_forces(OS%grid, OS%US, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif @@ -582,7 +582,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%US, OS%GV%Rho0) - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid, OS%US) if (OS%use_waves) then call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) @@ -676,7 +676,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%diag, OS%forcing_CSp%handles) + OS%grid, OS%US, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) endif diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index 2bed34580e..b487787a2e 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -63,7 +63,7 @@ module MOM_surface_forcing_mct logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). - real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: area_surf = -1.0 !< total ocean surface area [m2] real :: latent_heat_fusion !< latent heat of fusion [J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [J kg-1] @@ -78,19 +78,19 @@ module MOM_surface_forcing_mct !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar [Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the - !! bottom boundary layer by drag on the tidal flows [W m-2] + !! bottom boundary layer by drag on the tidal flows [R Z3 T-3 ~> W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar [Pa]. + !! gustiness that contributes to ustar [R L Z T-1 ~> Pa]. !! gust is used when read_gust_2d is true. - ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) real :: utide !< constant tidal velocity to use if read_tideamp - !! is false [m s-1] + !! is false [Z T-1 ~> m s-1] logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface @@ -240,6 +240,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & real :: delta_sss !< temporary storage for sss diff from restoring value real :: delta_sst !< temporary storage for sst diff from restoring value + real :: kg_m2_s_conversion !< A combination of unit conversion factors for rescaling + !! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. real :: C_p !< heat capacity of seawater ( J/(K kg) ) real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. @@ -253,6 +255,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 + kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s C_p = fluxes%C_p open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 @@ -301,7 +304,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -355,17 +358,19 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) - fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & - (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 + fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*US%m_to_Z*US%T_to_s*CS%Flux_const)* & + (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! R Z T-1 ~> kg Salt m-2 s-1 enddo; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl, & + unit_scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*US%R_to_kg_m3*US%Z_to_m*US%s_to_T * & + G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - kg_m2_s_conversion * fluxes%saltFluxGlobalAdj endif endif fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic @@ -375,19 +380,21 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & delta_sss = sfc_state%SSS(i,j) - data_restore(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* & - (CS%Rho0*CS%Flux_const) * & + (US%m_to_Z*US%T_to_s * CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif enddo; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl, & + unit_scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je) * & + US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - kg_m2_s_conversion*fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) enddo; enddo endif endif @@ -401,7 +408,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & - (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + (US%R_to_kg_m3*CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 enddo; enddo endif @@ -410,28 +417,28 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie ! liquid precipitation (rain) if (associated(IOB%lprec)) & - fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lprec(i,j) = kg_m2_s_conversion * IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) ! frozen precipitation (snow) if (associated(IOB%fprec)) & - fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%fprec(i,j) = kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) ! evaporation if (associated(IOB%q_flux)) & - fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%evap(i,j) = kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) ! liquid runoff flux if (associated(IOB%rofl_flux)) then - fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = kg_m2_s_conversion * IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) else if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = kg_m2_s_conversion * IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) end if ! ice runoff flux if (associated(IOB%rofi_flux)) then - fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%frunoff(i,j) = kg_m2_s_conversion * IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) else if (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%frunoff(i,j) = kg_m2_s_conversion * IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) end if if (associated(IOB%ustar_berg)) & @@ -451,7 +458,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) ! longwave radiation, sum up and down (W/m2) if (associated(IOB%lw_flux)) & @@ -467,7 +474,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! water flux due to sea ice and snow melt [kg/m2/s] if (associated(IOB%seaice_melt)) & - fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) ! latent heat flux (W/m^2) fluxes%latent(i,j) = 0.0 @@ -523,8 +530,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + IOB%salt_flux(i-i0,j-j0)) - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( IOB%salt_flux(i-i0,j-j0) ) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + kg_m2_s_conversion*IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( kg_m2_s_conversion*IOB%salt_flux(i-i0,j-j0) ) enddo ; enddo endif @@ -533,7 +540,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sign_for_net_FW_bug = 1. if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & + net_FW(i,j) = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * & + (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) @@ -543,13 +551,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + fluxes%vprec(i,j) = fluxes%vprec(i,j) + kg_m2_s_conversion * & (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - kg_m2_s_conversion * fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) enddo; enddo endif endif @@ -560,7 +568,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (CS%allow_flux_adjustments) then ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, fluxes) + call apply_flux_adjustments(G, US, CS, Time, fluxes) endif ! Allow for user-written code to alter fluxes after all the above @@ -588,18 +596,20 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & !< Zonal wind stresses at q points [Pa] - tauy_at_q !< Meridional wind stresses at q points [Pa] + taux_at_q, & !< Zonal wind stresses at q points [R Z L T-2 ~> Pa] + tauy_at_q !< Meridional wind stresses at q points [R Z L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & !< Ice rigidity at tracer points [m3 s-1] - taux_at_h, & !< Zonal wind stresses at h points [Pa] - tauy_at_h !< Meridional wind stresses at h points [Pa] - - real :: gustiness !< unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 !< inverse of the mean density in [m3 kg-1] - real :: taux2, tauy2 !< squared wind stresses [Pa2] - real :: tau_mag !< magnitude of the wind stress [Pa] + taux_at_h, & !< Zonal wind stresses at h points [R Z L T-2 ~> Pa] + tauy_at_h !< Meridional wind stresses at h points [R Z L T-2 ~> Pa] + + real :: gustiness !< unresolved gustiness that contributes to ustar [R Z L T-2 ~> Pa] + real :: Irho0 !< inverse of the mean density in [Z L-1 R-1 ~> m3 kg-1] + real :: taux2, tauy2 !< squared wind stresses [R2 Z2 L2 T-4 ~> Pa2] + real :: tau_mag !< magnitude of the wind stress [R Z L T-2 ~> Pa] + real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress units [R Z L T-2 Pa-1 ~> 1] + real :: stress_conversion ! A unit conversion factor from Pa times any stress multiplier [R Z L T-2 Pa-1 ~> 1] real :: I_GEarth !< 1.0 / G%G_Earth [s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice !< mass of sea ice at a face [kg m-2] @@ -622,7 +632,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) !i0 = is - isc_bnd ; j0 = js - jsc_bnd i0 = 0; j0 = 0 - Irho0 = 1.0/CS%Rho0 + Irho0 = US%L_to_Z / CS%Rho0 + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + stress_conversion = Pa_conversion * CS%wind_stress_multiplier ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. @@ -704,14 +716,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) if (wind_stagger == BGRID_NE) then - if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * stress_conversion + if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * stress_conversion elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * stress_conversion + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * stress_conversion else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * stress_conversion + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * stress_conversion endif enddo ; enddo @@ -753,7 +765,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo; enddo elseif (wind_stagger == AGRID) then @@ -778,7 +790,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo; enddo @@ -799,9 +811,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo; enddo @@ -846,7 +858,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%allow_flux_adjustments) then ! Apply adjustments to forces - call apply_force_adjustments(G, CS, Time, forces) + call apply_force_adjustments(G, US, CS, Time, forces) endif !### ! Allow for user-written code to alter fluxes after all the above @@ -861,8 +873,9 @@ end subroutine convert_IOB_to_forces !! - hflx_adj (Heat flux into the ocean, in W m-2) !! - sflx_adj (Salt flux into the ocean, in kg salt m-2 s-1) !! - prcme_adj (Fresh water flux into the ocean, in kg m-2 s-1) -subroutine apply_flux_adjustments(G, CS, Time, fluxes) +subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure type(forcing), intent(inout) :: fluxes !< Surface fluxes structure @@ -887,7 +900,8 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + & + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) @@ -895,7 +909,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) @@ -906,21 +920,24 @@ end subroutine apply_flux_adjustments !! Available adjustments are: !! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) !! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) -subroutine apply_force_adjustments(G, CS, Time, forces) +subroutine apply_force_adjustments(G, US, CS, Time, forces) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [Pa] - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [R Z L T-2 ~> Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [R Z L T-2 ~> Pa] integer :: isc, iec, jsc, jec, i, j real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] logical :: overrode_x, overrode_y isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged @@ -941,8 +958,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) if (rDlon > 0.) rDlon = 1. / rDlon cosA = dLonDx * rDlon sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) + zonal_tau = Pa_conversion * tempx_at_h(i,j) + merid_tau = Pa_conversion * tempy_at_h(i,j) tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau enddo ; enddo @@ -995,7 +1012,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, !! restoring will be applied in this model. ! Local variables - real :: utide ! The RMS tidal velocity, in m s-1. + real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags type(time_type) :: Time_frc @@ -1038,7 +1055,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & @@ -1192,7 +1209,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) endif call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) @@ -1200,7 +1217,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1) + call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1, scale=US%m_to_Z*US%T_to_s) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) @@ -1208,7 +1225,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, enddo ; enddo else do j=jsd,jed; do i=isd,ied - utide=CS%utide + utide = CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo @@ -1232,7 +1249,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa + call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1, & + scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif ! See whether sufficiently thick sea ice should be treated as rigid. diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 6f155e13d6..1e13b8e536 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -533,7 +533,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + call iceberg_fluxes(OS%grid, OS%US, OS%fluxes, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif @@ -564,7 +564,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) if (do_thermo) & - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif @@ -578,7 +578,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #endif endif call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%US, OS%GV%Rho0) - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid, OS%US) if (OS%use_waves) then call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) @@ -671,7 +671,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%diag, OS%forcing_CSp%handles) + OS%grid, US%US, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) endif diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index ba6760ffa4..955e608ac4 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -64,7 +64,7 @@ module MOM_surface_forcing_nuopc logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - real :: Rho0 !< Boussinesq reference density [kg/m^3] + real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: area_surf = -1.0 !< total ocean surface area [m^2] real :: latent_heat_fusion !< latent heat of fusion [J/kg] real :: latent_heat_vapor !< latent heat of vaporization [J/kg] @@ -80,19 +80,19 @@ module MOM_surface_forcing_nuopc !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar [Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the - !! bottom boundary layer by drag on the tidal flows [W m-2] + !! bottom boundary layer by drag on the tidal flows [R Z3 T-3 ~> W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar [Pa]. + !! gustiness that contributes to ustar [R L Z T-1 ~> Pa]. !! gust is used when read_gust_2d is true. - ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m s-1] + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) real :: utide !< constant tidal velocity to use if read_tideamp - !! is false [m s-1] + !! is false [Z T-1 ~> m s-1] logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts @@ -244,6 +244,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & !! is present, or false (no restoring) otherwise. real :: delta_sss !< temporary storage for sss diff from restoring value real :: delta_sst !< temporary storage for sst diff from restoring value + real :: kg_m2_s_conversion !< A combination of unit conversion factors for rescaling + !! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. real :: C_p !< heat capacity of seawater ( J/(K kg) ) real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. @@ -258,6 +260,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 + kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s C_p = fluxes%C_p open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 @@ -306,7 +309,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo ; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -361,17 +364,19 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) - fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & + fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*US%m_to_Z*US%T_to_s*CS%Flux_const)* & (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 enddo ; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl, & + unit_scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*US%R_to_kg_m3*US%Z_to_m*US%s_to_T * & + G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - kg_m2_s_conversion * fluxes%saltFluxGlobalAdj endif endif fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic @@ -381,19 +386,21 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & delta_sss = sfc_state%SSS(i,j) - data_restore(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* & - (CS%Rho0*CS%Flux_const) * & + (US%m_to_Z*US%T_to_s * CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif enddo ; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl, & + unit_scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je) * & + US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - kg_m2_s_conversion * fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) enddo ; enddo endif endif @@ -407,7 +414,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & - (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + (US%R_to_kg_m3*CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 enddo ; enddo endif @@ -416,26 +423,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie if (associated(IOB%lprec)) & - fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lprec(i,j) = kg_m2_s_conversion * IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%fprec)) & - fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%fprec(i,j) = kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%q_flux)) & - fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%evap(i,j) = kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) ! liquid runoff flux if (associated(IOB%rofl_flux)) then - fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = kg_m2_s_conversion * IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) else if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = kg_m2_s_conversion * IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) endif ! ice runoff flux if (associated(IOB%rofi_flux)) then - fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%frunoff(i,j) = kg_m2_s_conversion * IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) elseif (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%frunoff(i,j) = kg_m2_s_conversion * IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) endif if (associated(IOB%ustar_berg)) & @@ -451,7 +458,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion*IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -465,7 +472,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! water flux due to sea ice and snow melt [kg/m2/s] if (associated(IOB%seaice_melt)) & - fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + fluxes%seaice_melt(i,j) = kg_m2_s_conversion * G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -517,8 +524,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + IOB%salt_flux(i-i0,j-j0)) - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( IOB%salt_flux(i-i0,j-j0) ) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + kg_m2_s_conversion*IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( kg_m2_s_conversion*IOB%salt_flux(i-i0,j-j0) ) enddo ; enddo endif @@ -527,7 +534,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sign_for_net_FW_bug = 1. if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & + net_FW(i,j) = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * & + (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) @@ -536,13 +544,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + fluxes%vprec(i,j) = fluxes%vprec(i,j) + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * & (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - kg_m2_s_conversion * fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) enddo ; enddo endif @@ -554,7 +562,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (CS%allow_flux_adjustments) then ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, fluxes) + call apply_flux_adjustments(G, US, CS, Time, fluxes) endif ! Allow for user-written code to alter fluxes after all the above @@ -590,10 +598,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) taux_at_h, & !< Zonal wind stresses at h points [Pa] tauy_at_h !< Meridional wind stresses at h points [Pa] - real :: gustiness !< unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 !< inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 !< squared wind stresses (Pa^2) - real :: tau_mag !< magnitude of the wind stress [Pa] + real :: gustiness !< unresolved gustiness that contributes to ustar [R Z L T-2 ~> Pa] + real :: Irho0 !< inverse of the mean density in [Z L-1 R-1 ~> m3 kg-1] + real :: taux2, tauy2 !< squared wind stresses [R2 Z2 L2 T-4 ~> Pa2] + real :: tau_mag !< magnitude of the wind stress [R Z L T-2 ~> Pa] + real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress units [R Z L T-2 Pa-1 ~> 1] + real :: stress_conversion ! A unit conversion factor from Pa times any stress multiplier [R Z L T-2 Pa-1 ~> 1] real :: I_GEarth !< 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice !< mass of sea ice at a face (kg/m^2) @@ -615,7 +625,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd - Irho0 = 1.0/CS%Rho0 + Irho0 = US%L_to_Z / CS%Rho0 + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + stress_conversion = Pa_conversion * CS%wind_stress_multiplier ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. @@ -701,14 +713,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) if (wind_stagger == BGRID_NE) then - if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * stress_conversion + if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * stress_conversion elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * stress_conversion + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * stress_conversion else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * stress_conversion + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * stress_conversion endif enddo ; enddo @@ -750,7 +762,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then @@ -775,7 +787,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -796,9 +808,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -843,7 +855,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%allow_flux_adjustments) then ! Apply adjustments to forces - call apply_force_adjustments(G, CS, Time, forces) + call apply_force_adjustments(G, US, CS, Time, forces) endif !### ! Allow for user-written code to alter fluxes after all the above @@ -858,8 +870,9 @@ end subroutine convert_IOB_to_forces !! - hflx_adj (Heat flux into the ocean, in W m-2) !! - sflx_adj (Salt flux into the ocean, in kg salt m-2 s-1) !! - prcme_adj (Fresh water flux into the ocean, in kg m-2 s-1) -subroutine apply_flux_adjustments(G, CS, Time, fluxes) +subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure type(forcing), intent(inout) :: fluxes !< Surface fluxes structure @@ -884,7 +897,8 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + & + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) @@ -892,7 +906,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) end subroutine apply_flux_adjustments @@ -902,21 +916,24 @@ end subroutine apply_flux_adjustments !! Available adjustments are: !! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) !! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) -subroutine apply_force_adjustments(G, CS, Time, forces) +subroutine apply_force_adjustments(G, US, CS, Time, forces) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [Pa] - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [R Z L T-2 ~> Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [R Z L T-2 ~> Pa] integer :: isc, iec, jsc, jec, i, j real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] logical :: overrode_x, overrode_y isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged @@ -937,8 +954,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) if (rDlon > 0.) rDlon = 1. / rDlon cosA = dLonDx * rDlon sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) + zonal_tau = Pa_conversion * tempx_at_h(i,j) + merid_tau = Pa_conversion * tempy_at_h(i,j) tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau enddo ; enddo @@ -991,7 +1008,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, !! restoring will be applied in this model. ! Local variables - real :: utide ! The RMS tidal velocity, in m s-1. + real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags type(time_type) :: Time_frc @@ -1034,7 +1051,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & @@ -1188,7 +1205,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) endif call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) @@ -1196,7 +1213,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1) + call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1, scale=US%m_to_Z*US%T_to_s) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) @@ -1204,7 +1221,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, enddo ; enddo else do j=jsd,jed; do i=isd,ied - utide=CS%utide + utide = CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo @@ -1219,8 +1236,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) + "The background gustiness in the winds.", & + units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & "The file in which the wind gustiness is found in "//& @@ -1228,7 +1245,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa + call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1, & + scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif ! See whether sufficiently thick sea ice should be treated as rigid. diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index ee3cd36b41..cf59d577d8 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -27,9 +27,9 @@ module MESO_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. + real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. - real :: Flux_const !< The restoring rate at the surface [m s-1]. + real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. real, dimension(:,:), pointer :: & @@ -83,7 +83,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -142,7 +142,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) - fluxes%lprec(i,j) = CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) + fluxes%lprec(i,j) = US%m_to_Z*US%T_to_s * CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 @@ -169,14 +169,14 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! call MOM_error(FATAL, "MESO_buoyancy_surface_forcing: " // & ! "Temperature and salinity restoring used without modification." ) - rhoXcp = CS%Rho0 * fluxes%C_p + rhoXcp = US%R_to_kg_m3*CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in ppt or PSU) that are being restored toward. if (G%mask2dT(i,j) > 0) then fluxes%heat_added(i,j) = G%mask2dT(i,j) * & - ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) - fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & + ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const) + fluxes%vprec(i,j) = - (CS%Rho0 * CS%Flux_const) * & (CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) else @@ -191,14 +191,14 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & - (density_restore - sfc_state%sfc_density(i,j)) + US%kg_m3_to_R * (density_restore - sfc_state%sfc_density(i,j)) enddo ; enddo endif endif ! end RESTOREBUOY @@ -242,7 +242,7 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) @@ -256,10 +256,9 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z/(86400.0*US%s_to_T), & fail_if_missing=.true.) - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & "The file with the SST toward which to restore in "//& diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index b057e06f9e..a6d6597c0e 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -580,7 +580,7 @@ program MOM_main if (.not. offline_tracer_mode) then if (fluxes%fluxes_used) then call enable_averaging(fluxes%dt_buoy_accum, Time, diag) - call forcing_diagnostics(fluxes, sfc_state, fluxes%dt_buoy_accum, grid, & + call forcing_diagnostics(fluxes, sfc_state, fluxes%dt_buoy_accum, grid, US, & diag, surface_forcing_CSp%handles) call disable_averaging(diag) else diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 442047f03c..56d7d5a846 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -78,19 +78,19 @@ module MOM_surface_forcing real :: south_lat !< southern latitude of the domain real :: len_lat !< domain length in latitude - real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - real :: Flux_const !< piston velocity for surface restoring [m s-1] + real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] - real :: Flux_const_S !< piston velocity for surface salinity restoring [m s-1] - real :: latent_heat_fusion !< latent heat of fusion [J kg-1] + real :: Flux_const_S !< piston velocity for surface salinity restoring [Z T-1 ~> m s-1] + real :: latent_heat_fusion !< latent heat of fusion times scaling factors [J T m-2 R-1 Z-1 s-1 ~> J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [J kg-1] real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing - real :: gust_const !< constant unresolved background gustiness for ustar [Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [Pa] + real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [R L Z T-1 ~> Pa] !! gust is used when read_gust_2d is true. real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to [degC] @@ -309,19 +309,19 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US elseif (trim(CS%buoy_config) == "const") then call buoyancy_forcing_const(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "linear") then - call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "MESO") then call MESO_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%MESO_forcing_CSp) elseif (trim(CS%buoy_config) == "Neverland") then call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%Neverland_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then - call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) + call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, US, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then call USER_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%user_forcing_CSp) elseif (trim(CS%buoy_config) == "BFB") then call BFB_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%BFB_forcing_CSp) elseif (trim(CS%buoy_config) == "dumbbell") then - call dumbbell_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%dumbbell_forcing_CSp) + call dumbbell_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%dumbbell_forcing_CSp) elseif (trim(CS%buoy_config) == "NONE") then call MOM_mesg("MOM_surface_forcing: buoyancy forcing has been set to omitted.") elseif (CS%variable_buoyforce .and. .not.CS%first_call_set_forcing) then @@ -348,7 +348,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & (.not.CS%adiabatic)) then - call set_net_mass_forcing(fluxes, forces, G) + call set_net_mass_forcing(fluxes, forces, G, US) endif CS%first_call_set_forcing = .false. @@ -371,31 +371,34 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables + real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] real :: mag_tau integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_const, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z !set steady surface wind stresses, in units of Pa. - mag_tau = sqrt( tau_x0**2 + tau_y0**2) + !### mag_tau = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * sqrt( tau_x0**2 + tau_y0**2) + mag_tau = Pa_conversion * sqrt( tau_x0**2 + tau_y0**2) do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = tau_x0 + forces%taux(I,j) = tau_x0 * Pa_conversion enddo ; enddo do J=js-1,Jeq ; do i=is,ie - forces%tauy(i,J) = tau_y0 + forces%tauy(i,J) = tau_y0 * Pa_conversion enddo ; enddo if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) + forces%ustar(i,j) = sqrt( US%L_to_Z * ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) + forces%ustar(i,j) = sqrt( US%L_to_Z * ( mag_tau + CS%gust_const ) / CS%Rho0 ) enddo ; enddo ; endif endif @@ -425,8 +428,8 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = 0.1*(1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / & - CS%len_lat)) + forces%taux(I,j) = 0.1*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) enddo ; enddo do J=js-1,Jeq ; do i=is,ie @@ -459,7 +462,8 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) =-0.2*cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) + forces%taux(I,j) = -0.2*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) enddo ; enddo do J=js-1,Jeq ; do i=is,ie @@ -492,9 +496,10 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat - forces%taux(I,j) = CS%gyres_taux_const + & + forces%taux(I,j) = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + (CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & - + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) + + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) )) enddo ; enddo do J=js-1,Jeq ; do i=is-1,ie+1 @@ -504,14 +509,14 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity if (CS%answers_2018) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & - forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & - forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_Z * ((CS%gust_const/CS%Rho0) + & + sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + forces%tauy(i,j)*forces%tauy(i,j) + & + forces%taux(i-1,j)*forces%taux(i-1,j) + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0) ) enddo ; enddo else - I_rho = 1.0 / CS%Rho0 + I_rho = US%L_to_Z / CS%Rho0 do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( (CS%gust_const + & + forces%ustar(i,j) = sqrt( (CS%gust_const + & sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) enddo ; enddo @@ -534,7 +539,9 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) ! Local variables character(len=200) :: filename ! The name of the input file. real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional - real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [Pa]. + real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [R L Z T-1 ~> Pa]. + real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress + ! units [R Z L T-2 Pa-1 ~> 1] integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and montly cycles. integer :: time_lev ! The time level that is used for a field. @@ -545,6 +552,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) @@ -582,8 +590,8 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) case ("A") temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & - temp_x(:,:), temp_y(:,:), & - G%Domain, stagger=AGRID, timelevel=time_lev) + temp_x(:,:), temp_y(:,:), G%Domain, stagger=AGRID, & + timelevel=time_lev, scale=Pa_conversion) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=js,je ; do I=is-1,Ieq @@ -596,13 +604,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & - temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) + forces%ustar(i,j) = sqrt((CS%gust(i,j) + & + sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j))) * US%L_to_Z / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & - temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + & + sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j)) / CS%Rho0) ) enddo ; enddo endif endif @@ -616,7 +624,8 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & temp_x(:,:), temp_y(:,:), & - G%Domain_aux, stagger=CGRID_NE, timelevel=time_lev) + G%Domain_aux, stagger=CGRID_NE, timelevel=time_lev, & + scale=Pa_conversion) do j=js,je ; do i=is,ie forces%taux(I,j) = CS%wind_scale * temp_x(I,j) forces%tauy(i,J) = CS%wind_scale * temp_y(i,J) @@ -625,7 +634,8 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) else call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & forces%taux(:,:), forces%tauy(:,:), & - G%Domain, stagger=CGRID_NE, timelevel=time_lev) + G%Domain, stagger=CGRID_NE, timelevel=time_lev, & + scale=Pa_conversion) if (CS%wind_scale /= 1.0) then do j=js,je ; do I=Isq,Ieq @@ -641,15 +651,15 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & - forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & - forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) + forces%ustar(i,j) = sqrt((CS%gust(i,j) + & + sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & + (forces%taux(i-1,j)**2 + forces%taux(i,j)**2))) ) * US%L_to_Z / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & - forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & - forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_Z * ( (CS%gust_const/CS%Rho0) + & + sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & + (forces%taux(i-1,j)**2 + forces%taux(i,j)**2)))/CS%Rho0)) enddo ; enddo endif endif @@ -685,6 +695,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [Pa]. real :: temp_ustar(SZI_(G),SZJ_(G)) ! ustar [m s-1] (not rescaled). + real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] integer :: i, j, is_in, ie_in, js_in, je_in logical :: read_uStar @@ -696,10 +707,9 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) CS%dataOverrideIsInitialized = .True. endif - is_in = G%isc - G%isd + 1 - ie_in = G%iec - G%isd + 1 - js_in = G%jsc - G%jsd + 1 - je_in = G%jec - G%jsd + 1 + is_in = G%isc - G%isd + 1 ; ie_in = G%iec - G%isd + 1 + js_in = G%jsc - G%jsd + 1 ; je_in = G%jec - G%jsd + 1 + Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 call data_override('OCN', 'taux', temp_x, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) @@ -707,10 +717,10 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) ! Ignore CS%wind_scale when using data_override ????? do j=G%jsc,G%jec ; do I=G%isc-1,G%IecB - forces%taux(I,j) = 0.5 * (temp_x(i,j) + temp_x(i+1,j)) + forces%taux(I,j) = Pa_conversion * 0.5 * (temp_x(i,j) + temp_x(i+1,j)) enddo ; enddo do J=G%jsc-1,G%JecB ; do i=G%isc,G%iec - forces%tauy(i,J) = 0.5 * (temp_y(i,j) + temp_y(i,j+1)) + forces%tauy(i,J) = Pa_conversion * 0.5 * (temp_y(i,j) + temp_y(i,j+1)) enddo ; enddo read_Ustar = (len_trim(CS%ustar_var) > 0) ! Need better control higher up ???? @@ -722,13 +732,13 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then call data_override('OCN', 'gust', CS%gust, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & - temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) + forces%ustar(i,j) = sqrt((Pa_conversion * sqrt(temp_x(i,j)*temp_x(i,j) + & + temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) * US%L_to_Z / CS%Rho0) enddo ; enddo else do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & - temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + forces%ustar(i,j) = sqrt(US%L_to_Z * (Pa_conversion*sqrt(temp_x(i,j)*temp_x(i,j) + & + temp_y(i,j)*temp_y(i,j))/CS%Rho0 + CS%gust_const/CS%Rho0 )) enddo ; enddo endif endif @@ -763,8 +773,9 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) ! anomalies when calculating restorative precipitation ! anomalies [ppt]. + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. real :: rhoXcp ! reference density times heat capacity [J m-3 degC-1] - real :: Irho0 ! inverse of the Boussinesq reference density [m3 kg-1] integer :: time_lev_daily ! time levels to read for fields with daily cycle integer :: time_lev_monthly ! time levels to read for fields with monthly cycle @@ -776,9 +787,9 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) call callTree_enter("buoyancy_forcing_from_files, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s - if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p - Irho0 = 1.0/CS%Rho0 + if (CS%use_temperature) rhoXcp = US%R_to_kg_m3*CS%Rho0 * fluxes%C_p ! Read the buoyancy forcing file call get_time(day, seconds, days) @@ -830,12 +841,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie fluxes%latent(i,j) = -CS%latent_heat_vapor*temp(i,j) - fluxes%evap(i,j) = -temp(i,j) + fluxes%evap(i,j) = -kg_m2_s_conversion*temp(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo else call MOM_read_data(CS%evaporation_file, CS%evap_var, fluxes%evap(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) endif CS%evap_last_lev = time_lev @@ -890,9 +901,9 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) case default ; time_lev = 1 end select call MOM_read_data(CS%snow_file, CS%snow_var, & - fluxes%fprec(:,:), G%Domain, timelevel=time_lev) + fluxes%fprec(:,:), G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) call MOM_read_data(CS%rain_file, CS%rain_var, & - fluxes%lprec(:,:), G%Domain, timelevel=time_lev) + fluxes%lprec(:,:), G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) if (CS%archaic_OMIP_file) then do j=js,je ; do i=is,ie fluxes%lprec(i,j) = fluxes%lprec(i,j) - fluxes%fprec(i,j) @@ -907,20 +918,20 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) end select if (CS%archaic_OMIP_file) then call MOM_read_data(CS%runoff_file, CS%lrunoff_var, temp(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) do j=js,je ; do i=is,ie fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) do j=js,je ; do i=is,ie fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) call MOM_read_data(CS%runoff_file, CS%frunoff_var, fluxes%frunoff(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) endif CS%runoff_last_lev = time_lev @@ -984,14 +995,14 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) else fluxes%heat_added(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 endif enddo ; enddo else do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then - fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) + fluxes%buoy(i,j) = US%kg_m3_to_R * (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & + (CS%G_Earth * CS%Flux_const / CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -1041,8 +1052,9 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US SSS_mean ! A (mean?) salinity about which to normalize local salinity ! anomalies when calculating restorative precipitation ! anomalies [ppt]. + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. - real :: Irho0 ! The inverse of the Boussinesq density [m3 kg-1]. integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and montly cycles. @@ -1056,9 +1068,9 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p - Irho0 = 1.0/CS%Rho0 if (.not.CS%dataOverrideIsInitialized) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) @@ -1077,10 +1089,12 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US ! note the sign convention do j=js,je ; do i=is,ie - fluxes%evap(i,j) = -fluxes%evap(i,j) ! Normal convention is positive into the ocean - ! but evap is normally a positive quantity in the files - fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) - fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) + ! This is dangerous because it is not clear whether the data files have been read! + fluxes%evap(i,j) = -fluxes%evap(i,j) ! Normal convention is positive into the ocean + ! but evap is normally a positive quantity in the files + fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) + fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) + fluxes%evap(i,j) = kg_m2_s_conversion*fluxes%evap(i,j) enddo ; enddo call data_override('OCN', 'sens', fluxes%sens(:,:), day, & @@ -1096,16 +1110,23 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) call data_override('OCN', 'snow', fluxes%fprec(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=kg_m2_s_conversion call data_override('OCN', 'rain', fluxes%lprec(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=kg_m2_s_conversion call data_override('OCN', 'runoff', fluxes%lrunoff(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=kg_m2_s_conversion call data_override('OCN', 'calving', fluxes%frunoff(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=kg_m2_s_conversion + + if (kg_m2_s_conversion /= 1.0) then ; do j=js,je ; do i=is,ie + fluxes%lprec(i,j) = fluxes%lprec(i,j) * kg_m2_s_conversion + fluxes%fprec(i,j) = fluxes%fprec(i,j) * kg_m2_s_conversion + fluxes%lrunoff(i,j) = fluxes%lrunoff(i,j) * kg_m2_s_conversion + fluxes%frunoff(i,j) = fluxes%frunoff(i,j) * kg_m2_s_conversion + enddo ; enddo ; endif ! Read the SST and SSS fields for damping. if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then @@ -1135,8 +1156,8 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US else do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then - fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) + fluxes%buoy(i,j) = US%kg_m3_to_R * (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & + (CS%G_Earth * CS%Flux_const / CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -1272,7 +1293,7 @@ end subroutine buoyancy_forcing_const !> Sets surface fluxes of heat and salinity by restoring to temperature and !! salinity profiles that vary linearly with latitude. -subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -1280,6 +1301,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -1319,7 +1341,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) T_restore = CS%T_south + (CS%T_north-CS%T_south)*y S_restore = CS%S_south + (CS%S_north-CS%S_south)*y if (G%mask2dT(i,j) > 0) then - fluxes%heat_added(i,j) = G%mask2dT(i,j) * & + fluxes%heat_added(i,j) = G%mask2dT(i,j) * (US%R_to_kg_m3*US%Z_to_m*US%s_to_T) * & ((T_Restore - sfc_state%SST(i,j)) * ((CS%Rho0 * fluxes%C_p) * CS%Flux_const)) fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & (S_Restore - sfc_state%SSS(i,j)) / & @@ -1334,8 +1356,8 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) "RESTOREBUOY to linear not written yet.") !do j=js,je ; do i=is,ie ! if (G%mask2dT(i,j) > 0) then - ! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - ! (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) + ! fluxes%buoy(i,j) = US%kg_m3_to_R * (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & + ! (CS%G_Earth * CS%Flux_const / CS%Rho0) ! else ! fluxes%buoy(i,j) = 0.0 ! endif @@ -1388,6 +1410,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C type(time_type) :: Time_frc ! This include declares and sets the variable "version". # include "version_variable.h" + real :: flux_const_default ! The unscaled value of FLUXCONST [m day-1] logical :: default_2018_answers character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=200) :: filename, gust_file ! The name of the gustiness input file. @@ -1640,36 +1663,42 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & - "The latent heat of fusion.", units="J/kg", default=hlf) + "The latent heat of fusion.", default=hlf, & + units="J/kg", scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, & + fail_if_missing=.true., unscaled=flux_const_default) if (CS%use_temperature) then call get_param(param_file, mdl, "FLUXCONST_T", CS%Flux_const_T, & "The constant that relates the restoring surface temperature "//& "flux to the relative surface anomaly (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - default=CS%Flux_const) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=1.0, & ! scale=US%m_to_Z*US%T_to_s, + default=flux_const_default) call get_param(param_file, mdl, "FLUXCONST_S", CS%Flux_const_S, & "The constant that relates the restoring surface salinity "//& "flux to the relative surface anomaly (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - default=CS%Flux_const) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, & + default=flux_const_default) endif - ! Convert flux constants from m day-1 to m s-1. + !### Convert flux constants from m day-1 to m s-1. Folding these into the scaling + ! factors above could change a division into a multiply by a reciprocal, which could + ! change answers at the level of roundoff. CS%Flux_const = CS%Flux_const / 86400.0 CS%Flux_const_T = CS%Flux_const_T / 86400.0 CS%Flux_const_S = CS%Flux_const_S / 86400.0 @@ -1698,8 +1727,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) + "The background gustiness in the winds.", & + units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1709,8 +1738,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) filename = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(filename,'gustiness',CS%gust,G%domain, & - timelevel=1) ! units should be Pa + call MOM_read_data(filename,'gustiness',CS%gust,G%domain, timelevel=1, & + scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif ! All parameter settings are now known. @@ -1727,7 +1756,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "ideal_hurr" .or.& trim(CS%wind_config) == "SCM_ideal_hurr") then - call idealized_hurricane_wind_init(Time, G, param_file, CS%idealized_hurricane_CSp) + call idealized_hurricane_wind_init(Time, G, US, param_file, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then call get_param(param_file, mdl, "CONST_WIND_TAUX", CS%tau_x0, & "With wind_config const, this is the constant zonal "//& @@ -1738,7 +1767,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. & trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS%SCM_CVmix_tests_CSp) - CS%SCM_CVmix_tests_CSp%Rho0 = CS%Rho0 !copy reference density for pass + CS%SCM_CVmix_tests_CSp%Rho0 = US%R_to_kg_m3*CS%Rho0 !copy reference density for pass endif call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index be29466e14..e6b7152e86 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -31,10 +31,9 @@ module Neverland_surface_forcing logical :: use_temperature !< If true, use temperature and salinity. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3]. + real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. - real :: flux_const !< The restoring rate at the surface [m s-1]. + real :: flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real, dimension(:,:), pointer :: & buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. character(len=200) :: inputdir !< The directory where NetCDF input files are. @@ -61,7 +60,8 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB real :: x, y real :: PI - real :: tau_max, off + real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] + real :: off is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -78,7 +78,7 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) ! calculation of ustar - otherwise the lower bound would be Isq. PI = 4.0*atan(1.0) forces%taux(:,:) = 0.0 - tau_max = 0.2 + tau_max = 0.2 * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z off = 0.02 do j=js,je ; do I=is-1,Ieq ! x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon @@ -104,9 +104,10 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. ! if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! ! This expression can be changed if desired, but need not be. -! forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & -! sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & -! 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) +! forces%ustar(i,j) = G%mask2dT(i,j) * sqrt((CS%gust_const + & +! sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & +! 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))) * & +! (US%L_to_Z / CS%Rho0) ) ! enddo ; enddo ; endif end subroutine Neverland_wind_forcing @@ -146,7 +147,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. ! Local variables real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. real :: density_restore ! De integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -195,14 +196,14 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! so that the original (unmodified) version is not accidentally used. ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & - (density_restore - sfc_state%sfc_density(i,j)) + US%kg_m3_to_R*(density_restore - sfc_state%sfc_density(i,j)) enddo ; enddo endif endif ! end RESTOREBUOY @@ -246,7 +247,7 @@ subroutine Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) ! call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & ! "The background gustiness in the winds.", units="Pa", & ! default=0.02) @@ -260,8 +261,8 @@ subroutine Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) ! Convert CS%flux_const from m day-1 to m s-1. CS%flux_const = CS%flux_const / 86400.0 endif diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 92151e6cde..caf862f097 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -33,11 +33,11 @@ module user_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. + real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 s-2 ~> m s-2]. - real :: Flux_const !< The restoring rate at the surface [m s-1]. + real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [Pa]. + !! that contributes to ustar [R L Z T-1 ~> Pa]. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -45,7 +45,7 @@ module user_surface_forcing contains -!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy, in [Pa]. +!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy, in [R Z L T-2 ~> Pa]. !! These are the stresses in the direction of the model grid (i.e. the same !! direction as the u- and v- velocities). subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) @@ -72,25 +72,26 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - ! Set the surface wind stresses, in units of Pa. A positive taux + ! Set the surface wind stresses, in units of [R L Z T-1 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 ! Change this to the desired expression. + ! Change this to the desired expression. + forces%taux(I,j) = G%mask2dCu(I,j) * 0.0*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z enddo ; enddo do J=js-1,Jeq ; do i=is,ie forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar + ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt((CS%gust_const + & + sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))) * (US%L_to_Z/CS%Rho0)) enddo ; enddo ; endif end subroutine USER_wind_forcing @@ -122,7 +123,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! (fprec, lrunoff and frunoff) left as arrays full of zeros. ! Evap is usually negative and precip is usually positive. All heat fluxes ! are in W m-2 and positive for heat going into the ocean. All fresh water -! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. +! fluxes are in [R Z T-1 ~> kg m-2 s-1] and positive for water moving into the ocean. ! Local variables real :: Temp_restore ! The temperature that is being restored toward [degC]. @@ -130,6 +131,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. + real :: Rho0_mks ! The mean density in MKS units [kg m-3] real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. @@ -138,6 +140,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + Rho0_mks = CS%Rho0 * US%R_to_kg_m3 ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. @@ -169,7 +172,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] + ! Fluxes of fresh water through the surface are in units of [R Z T-1 ~> kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j) @@ -199,18 +202,17 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & "Temperature and salinity restoring used without modification." ) - rhoXcp = CS%Rho0 * fluxes%C_p + rhoXcp = Rho0_mks * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in PSU or ppt) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 - fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & + fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const)) * & (Temp_restore - sfc_state%SST(i,j)) fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & - ((Salin_restore - sfc_state%SSS(i,j)) / & - (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) + ((Salin_restore - sfc_state%SSS(i,j)) / (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) enddo ; enddo else ! When modifying the code, comment out this error message. It is here @@ -219,7 +221,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / Rho0_mks do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -269,10 +271,10 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) + "The background gustiness in the winds.", & + units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& @@ -282,8 +284,8 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 endif diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index bb171aba7a..0cb012b208 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -46,7 +46,7 @@ module MOM_regridding !> This array is set by function setCoordinateResolution() !! It contains the "resolution" or delta coordinate of the target - !! coorindate. It has the units of the target coordinate, e.g. + !! coordinate. It has the units of the target coordinate, e.g. !! [Z ~> m] for z*, non-dimensional for sigma, etc. real, dimension(:), allocatable :: coordinateResolution @@ -56,9 +56,9 @@ module MOM_regridding !> This array is set by function set_target_densities() !! This array is the nominal coordinate of interfaces and is the - !! running sum of coordinateResolution. i.e. + !! running sum of coordinateResolution, in [R ~> kg m-3]. i.e. !! target_density(k+1) = coordinateResolution(k) + coordinateResolution(k) - !! It is only used in "rho" mode. + !! It is only used in "rho", "SLight" or "Hycom" mode. real, dimension(:), allocatable :: target_density !> A flag to indicate that the target_density arrays has been filled with data. @@ -199,8 +199,8 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha integer :: nz_fixed_sfc, k, nzf(4) - real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate, which may be - ! [m] or [Z ~> m] or [H ~> m or kg m-2] or [kg m-3] or other units. + real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate, which may be [m] + ! or [Z ~> m] or [H ~> m or kg m-2] or [R ~> kg m-3] or other units. real, dimension(:), allocatable :: h_max ! Maximum layer thicknesses [H ~> m or kg m-2] real, dimension(:), allocatable :: z_max ! Maximum interface depths [H ~> m or kg m-2] or other ! units depending on the coordinate @@ -310,13 +310,9 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m 'Unable to interpret "'//trim(string)//'".') endif allocate(dz(ke)) - if (ke==1) then - dz(:) = uniformResolution(ke, coord_mode, tmpReal, GV%Rlay(1), GV%Rlay(1)) - else - dz(:) = uniformResolution(ke, coord_mode, tmpReal, & - GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)), & - GV%Rlay(ke)+0.5*(GV%Rlay(ke)-GV%Rlay(ke-1)) ) - endif + dz(:) = uniformResolution(ke, coord_mode, tmpReal, & + US%R_to_kg_m3*(GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(min(2,ke)))), & + US%R_to_kg_m3*(GV%Rlay(ke) + 0.5*(GV%Rlay(ke)-GV%Rlay(max(ke-1,1)))) ) if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=trim(coord_units)) elseif (trim(string)=='PARAM') then @@ -469,13 +465,15 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m allocate( CS%coordinateResolution(CS%nk) ); CS%coordinateResolution(:) = -1.E30 if (state_dependent(CS%regridding_scheme)) then ! Target values - allocate( CS%target_density(CS%nk+1) ); CS%target_density(:) = -1.E30 + allocate( CS%target_density(CS%nk+1) ); CS%target_density(:) = -1.E30*US%kg_m3_to_R endif if (allocated(dz)) then - if ((coordinateMode(coord_mode) == REGRIDDING_SIGMA) .or. & - (coordinateMode(coord_mode) == REGRIDDING_RHO)) then + if (coordinateMode(coord_mode) == REGRIDDING_SIGMA) then call setCoordinateResolution(dz, CS, scale=1.0) + elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then + call setCoordinateResolution(dz, CS, scale=US%kg_m3_to_R) + CS%coord_scale = US%R_to_kg_m3 elseif (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then call setCoordinateResolution(dz, CS, scale=GV%m_to_H) CS%coord_scale = GV%H_to_m @@ -486,18 +484,18 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m endif if (allocated(rho_target)) then - call set_target_densities(CS, rho_target) + call set_target_densities(CS, US%kg_m3_to_R*rho_target) deallocate(rho_target) ! \todo This line looks like it would overwrite the target densities set just above? elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then - call set_target_densities_from_GV(GV, CS) - call log_param(param_file, mdl, "!TARGET_DENSITIES", CS%target_density, & + call set_target_densities_from_GV(GV, US, CS) + call log_param(param_file, mdl, "!TARGET_DENSITIES", US%R_to_kg_m3*CS%target_density(:), & 'RHO target densities for interfaces', units=coordinateUnits(coord_mode)) endif ! initialise coordinate-specific control structure - call initCoord(CS, GV, coord_mode) + call initCoord(CS, GV, US, coord_mode) if (main_parameters .and. coord_is_state_dependent) then call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & @@ -1947,12 +1945,13 @@ end function uniformResolution !> Initialize the coordinate resolutions by calling the appropriate initialization !! routine for the specified coordinate mode. -subroutine initCoord(CS, GV, coord_mode) +subroutine initCoord(CS, GV, US, coord_mode) type(regridding_CS), intent(inout) :: CS !< Regridding control structure character(len=*), intent(in) :: coord_mode !< A string indicating the coordinate mode. !! See the documenttion for regrid_consts !! for the recognized values. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type select case (coordinateMode(coord_mode)) case (REGRIDDING_ZSTAR) @@ -1962,11 +1961,14 @@ subroutine initCoord(CS, GV, coord_mode) case (REGRIDDING_SIGMA) call init_coord_sigma(CS%sigma_CS, CS%nk, CS%coordinateResolution) case (REGRIDDING_RHO) - call init_coord_rho(CS%rho_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS) + call init_coord_rho(CS%rho_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS, & + rho_scale=US%kg_m3_to_R) case (REGRIDDING_HYCOM1) - call init_coord_hycom(CS%hycom_CS, CS%nk, CS%coordinateResolution, CS%target_density, CS%interp_CS) + call init_coord_hycom(CS%hycom_CS, CS%nk, CS%coordinateResolution, CS%target_density, & + CS%interp_CS, rho_scale=US%kg_m3_to_R) case (REGRIDDING_SLIGHT) - call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS, GV%m_to_H) + call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, & + CS%interp_CS, GV%m_to_H, rho_scale=US%kg_m3_to_R) case (REGRIDDING_ADAPTIVE) call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution, GV%m_to_H) end select @@ -1991,15 +1993,16 @@ subroutine setCoordinateResolution( dz, CS, scale ) end subroutine setCoordinateResolution !> Set target densities based on the old Rlay variable -subroutine set_target_densities_from_GV( GV, CS ) +subroutine set_target_densities_from_GV( GV, US, CS ) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(regridding_CS), intent(inout) :: CS !< Regridding control structure ! Local variables integer :: k, nz nz = CS%nk - CS%target_density(1) = GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)) - CS%target_density(nz+1) = GV%Rlay(nz)+0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) + CS%target_density(1) = (GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(2))) + CS%target_density(nz+1) = (GV%Rlay(nz) + 0.5*(GV%Rlay(nz)-GV%Rlay(nz-1))) do k = 2,nz CS%target_density(k) = CS%target_density(k-1) + CS%coordinateResolution(k) enddo @@ -2010,7 +2013,7 @@ end subroutine set_target_densities_from_GV !> Set target densities based on vector of interface values subroutine set_target_densities( CS, rho_int ) type(regridding_CS), intent(inout) :: CS !< Regridding control structure - real, dimension(CS%nk+1), intent(in) :: rho_int !< Interface densities + real, dimension(CS%nk+1), intent(in) :: rho_int !< Interface densities [R ~> kg m-3] if (size(CS%target_density)/=size(rho_int)) then call MOM_error(FATAL, "set_target_densities inconsistent args!") @@ -2123,7 +2126,11 @@ function getCoordinateInterfaces( CS, undo_scaling ) call MOM_error(FATAL, 'MOM_regridding, getCoordinateInterfaces: '//& 'target densities not set!') - getCoordinateInterfaces(:) = CS%target_density(:) + if (unscale) then + getCoordinateInterfaces(:) = CS%coord_scale * CS%target_density(:) + else + getCoordinateInterfaces(:) = CS%target_density(:) + endif else if (unscale) then getCoordinateInterfaces(1) = 0. @@ -2401,7 +2408,7 @@ end subroutine dz_function1 integer function rho_function1( string, rho_target ) character(len=*), intent(in) :: string !< String with list of parameters in form !! dz_min, H_total, power, precision - real, dimension(:), allocatable, intent(inout) :: rho_target !< Profile of interface densities + real, dimension(:), allocatable, intent(inout) :: rho_target !< Profile of interface densities [kg m-3] ! Local variables integer :: nki, k, nk real :: ddx, dx, rho_1, rho_2, rho_3, drho, rho_4, drho_min diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 6928425e33..76c346c82e 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -18,9 +18,12 @@ module coord_hycom !> Nominal near-surface resolution real, allocatable, dimension(:) :: coordinateResolution - !> Nominal density of interfaces + !> Nominal density of interfaces [R ~> kg m-3] real, allocatable, dimension(:) :: target_density + !> Density scaling factor [R m3 kg-1 ~> 1] + real :: kg_m3_to_R + !> Maximum depths of interfaces real, allocatable, dimension(:) :: max_interface_depths @@ -36,12 +39,13 @@ module coord_hycom contains !> Initialise a hycom_CS with pointers to parameters -subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp_CS) +subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp_CS, rho_scale) type(hycom_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in generated grid real, dimension(nk), intent(in) :: coordinateResolution !< Nominal near-surface resolution [m] - real, dimension(nk+1),intent(in) :: target_density !< Interface target densities [kg m-3] + real, dimension(nk+1),intent(in) :: target_density !< Interface target densities [R ~> kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation + real, optional, intent(in) :: rho_scale !< A dimensional scaling factor for target_density if (associated(CS)) call MOM_error(FATAL, "init_coord_hycom: CS already associated!") allocate(CS) @@ -52,6 +56,8 @@ subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp CS%coordinateResolution(:) = coordinateResolution(:) CS%target_density(:) = target_density(:) CS%interp_CS = interp_CS + CS%kg_m3_to_R = 1.0 ; if (present(rho_scale)) CS%kg_m3_to_R = rho_scale + end subroutine init_coord_hycom !> This subroutine deallocates memory in the control structure for the coord_hycom module @@ -117,7 +123,7 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & ! Local variables integer :: k - real, dimension(nz) :: rho_col ! Layer quantities + real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] real, dimension(CS%nk) :: h_col_new ! New layer thicknesses real :: z_scale real :: stretching ! z* stretching, converts z* to z. @@ -132,7 +138,7 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_scale = 1.0 ; if (present(zScale)) z_scale = zScale ! Work bottom recording potential density - call calculate_density(T, S, p_col, rho_col, 1, nz, eqn_of_state) + call calculate_density(T, S, p_col, rho_col, 1, nz, eqn_of_state, scale=CS%kg_m3_to_R) ! This ensures the potential density profile is monotonic ! although not necessarily single valued. do k = nz-1, 1, -1 diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 74af5813eb..53b83644af 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -26,9 +26,12 @@ module coord_rho !! If false, integrate from the bottom upward, as does the rest of the model. logical :: integrate_downward_for_e = .false. - !> Nominal density of interfaces [kg m-3] + !> Nominal density of interfaces [R ~> kg m-3] real, allocatable, dimension(:) :: target_density + !> Density scaling factor [R m3 kg-1 ~> 1] + real :: kg_m3_to_R + !> Interpolation control structure type(interp_CS_type) :: interp_CS end type rho_CS @@ -43,12 +46,13 @@ module coord_rho contains !> Initialise a rho_CS with pointers to parameters -subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) +subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS, rho_scale) type(rho_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, intent(in) :: ref_pressure !< Coordinate reference pressure [Pa] - real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3] + real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3 or R ~> kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation + real, optional, intent(in) :: rho_scale !< A dimensional scaling factor for target_density if (associated(CS)) call MOM_error(FATAL, "init_coord_rho: CS already associated!") allocate(CS) @@ -58,6 +62,8 @@ subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) CS%ref_pressure = ref_pressure CS%target_density(:) = target_density(:) CS%interp_CS = interp_CS + CS%kg_m3_to_R = 1.0 ; if (present(rho_scale)) CS%kg_m3_to_R = rho_scale + end subroutine init_coord_rho !> This subroutine deallocates memory in the control structure for the coord_rho module @@ -111,7 +117,8 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & ! Local variables integer :: k, count_nonzero_layers integer, dimension(nz) :: mapping - real, dimension(nz) :: p, densities, h_nv + real, dimension(nz) :: p, h_nv + real, dimension(nz) :: densities ! Layer density [R ~> kg m-3] real, dimension(nz+1) :: xTmp real, dimension(CS%nk) :: h_new ! New thicknesses real, dimension(CS%nk+1) :: x1 @@ -127,7 +134,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & ! Compute densities on source column p(:) = CS%ref_pressure - call calculate_density(T, S, p, densities, 1, nz, eqn_of_state) + call calculate_density(T, S, p, densities, 1, nz, eqn_of_state, scale=CS%kg_m3_to_R) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) enddo @@ -238,8 +245,8 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ enddo ! Compute densities within current water column - call calculate_density( T_tmp, S_tmp, p, densities,& - 1, nz, eqn_of_state ) + call calculate_density( T_tmp, S_tmp, p, densities, & + 1, nz, eqn_of_state, scale=CS%kg_m3_to_R) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 8eb623d664..2e41d36473 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -51,9 +51,12 @@ module coord_slight !> A value of the stratification ratio that defines a problematic halocline region [nondim]. real :: halocline_strat_tol - !> Nominal density of interfaces [kg m-3]. + !> Nominal density of interfaces [R ~> kg m-3]. real, allocatable, dimension(:) :: target_density + !> Density scaling factor [R m3 kg-1 ~> 1] + real :: kg_m3_to_R + !> Maximum depths of interfaces [H ~> m or kg m-2]. real, allocatable, dimension(:) :: max_interface_depths @@ -69,13 +72,14 @@ module coord_slight contains !> Initialise a slight_CS with pointers to parameters -subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H) +subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H, rho_scale) type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, intent(in) :: ref_pressure !< Coordinate reference pressure [Pa] real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses + real, optional, intent(in) :: rho_scale !< A dimensional scaling factor for target_density real :: m_to_H_rescale ! A unit conversion factor. @@ -97,6 +101,7 @@ subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_ CS%dz_ml_min = 1.0 * m_to_H_rescale CS%halocline_filter_length = 2.0 * m_to_H_rescale CS%halocline_strat_tol = 0.25 ! Nondim. + CS%kg_m3_to_R = 1.0 ; if (present(rho_scale)) CS%kg_m3_to_R = rho_scale end subroutine init_coord_slight @@ -197,23 +202,32 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose !! of edge value calculations [H ~> m or kg m-2]. ! Local variables - real, dimension(nz) :: rho_col ! Layer quantities + real, dimension(nz) :: rho_col ! Layer densities [R ~> kg m-3] real, dimension(nz) :: T_f, S_f ! Filtered ayer quantities logical, dimension(nz+1) :: reliable ! If true, this interface is in a reliable position. real, dimension(nz+1) :: T_int, S_int ! Temperature and salinity interpolated to interfaces. - real, dimension(nz+1) :: rho_tmp, drho_dp, p_IS, p_R - real, dimension(nz+1) :: drhoIS_dT, drhoIS_dS - real, dimension(nz+1) :: drhoR_dT, drhoR_dS + real, dimension(nz+1) :: rho_tmp ! A temporary density [R ~> kg m-3] + real, dimension(nz+1) :: drho_dp ! The partial derivative of density with pressure [kg m-3 Pa-1] + real, dimension(nz+1) :: p_IS, p_R + real, dimension(nz+1) :: drhoIS_dT ! The partial derivative of in situ density with temperature + ! in [R degC-1 ~> kg m-3 degC-1] + real, dimension(nz+1) :: drhoIS_dS ! The partial derivative of in situ density with salinity + ! in [R ppt-1 ~> kg m-3 ppt-1] + real, dimension(nz+1) :: drhoR_dT ! The partial derivative of reference density with temperature + ! in [R degC-1 ~> kg m-3 degC-1] + real, dimension(nz+1) :: drhoR_dS ! The partial derivative of reference density with salinity + ! in [R ppt-1 ~> kg m-3 ppt-1] real, dimension(nz+1) :: strat_rat real :: H_to_cPa - real :: drIS, drR, Fn_now, I_HStol, Fn_zero_val + real :: drIS, drR ! In situ and reference density differences [R ~> kg m-3] + real :: Fn_now, I_HStol, Fn_zero_val real :: z_int_unst real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. real :: wgt, cowgt ! A weight and its complement, nondim. - real :: rho_ml_av ! The average potential density in a near-surface region [kg m-3]. + real :: rho_ml_av ! The average potential density in a near-surface region [R ~> kg m-3]. real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. - real :: rho_x_z ! A cumulative integral of a density [kg m-3 H ~> kg m-2 or kg2 m-5]. + real :: rho_x_z ! A cumulative integral of a density [R H ~> kg m-2 or kg2 m-5]. real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. real :: k_interior ! The (real) value of k where the interior grid starts. real :: k_int2 ! The (real) value of k where the interior grid starts. @@ -241,7 +255,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & do K=2,nz ; z_col_new(K) = z_col(1) + dz*real(K-1) ; enddo else call calculate_density(T_col, S_col, p_col, rho_col, 1, nz, & - eqn_of_state) + eqn_of_state, scale=CS%kg_m3_to_R) ! Find the locations of the target potential densities, flagging ! locations in apparently unstable regions as not reliable. @@ -363,9 +377,9 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & T_int(nz+1) = T_f(nz) ; S_int(nz+1) = S_f(nz) p_IS(nz+1) = z_col(nz+1) * H_to_Pa call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, 2, nz-1, & - eqn_of_state) + eqn_of_state, scale=CS%kg_m3_to_R) call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, 2, nz-1, & - eqn_of_state) + eqn_of_state, scale=CS%kg_m3_to_R) if (CS%compressibility_fraction > 0.0) then call calculate_compress(T_int, S_int, p_R, rho_tmp, drho_dp, 2, nz-1, & eqn_of_state) @@ -373,7 +387,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & do K=2,nz ; drho_dp(K) = 0.0 ; enddo endif - H_to_cPa = CS%compressibility_fraction*H_to_Pa + H_to_cPa = CS%compressibility_fraction*CS%kg_m3_to_R*H_to_Pa strat_rat(1) = 1.0 do K=2,nz drIS = drhoIS_dT(K) * (T_f(k) - T_f(k-1)) + & @@ -462,7 +476,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & ! The loop bounds are 2 & nz so the top and bottom interfaces do not move. ! Recall that z_col_new is positive downward. z_col_new(K) = min(z_col_new(K), CS%max_interface_depths(K), & - z_col_new(K-1) + CS%max_layer_thickness(k-1)) + z_col_new(K-1) + CS%max_layer_thickness(k-1)) enddo ; elseif (maximum_depths_set) then ; do K=2,nz z_col_new(K) = min(z_col_new(K), CS%max_interface_depths(K)) enddo ; elseif (maximum_h_set) then ; do k=2,nz diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 72b8c06413..a29a555f55 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -11,7 +11,7 @@ module MOM use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : diag_mediator_init, enable_averaging, enable_averages use MOM_diag_mediator, only : diag_mediator_infrastructure_init use MOM_diag_mediator, only : diag_set_state_ptrs, diag_update_remap_grids use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr @@ -164,7 +164,7 @@ module MOM vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint - !< A running time integral of the sea surface height [s m]. + !< A running time integral of the sea surface height [T m ~> s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc !< time-averaged (over a forcing time step) sea surface height !! with a correction for the inverse barometer [m] @@ -175,9 +175,9 @@ module MOM Hml => NULL() !< active mixed layer depth [m] real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of - !! the time integral of ssh_rint [s]. + !! the time integral of ssh_rint [T ~> s]. real :: time_in_thermo_cycle !< The running time of the current time-stepping - !! cycle in calls that step the thermodynamics [s]. + !! cycle in calls that step the thermodynamics [T ~> s]. type(ocean_grid_type) :: G !< structure containing metrics and grid info type(verticalGrid_type), pointer :: & @@ -186,14 +186,14 @@ module MOM US => NULL() !< structure containing various unit conversion factors type(thermo_var_ptrs) :: tv !< structure containing pointers to available thermodynamic fields real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer advection and lateral mixing - !! (in seconds), or equivalently the elapsed time since advectively updating the + !! [T ~> s], or equivalently the elapsed time since advectively updating the !! tracers. t_dyn_rel_adv is invariably positive and may span multiple coupling timesteps. real :: t_dyn_rel_thermo !< The time of the dynamics relative to diabatic processes and remapping - !! (in seconds). t_dyn_rel_thermo can be negative or positive depending on whether + !! [T ~> s]. t_dyn_rel_thermo can be negative or positive depending on whether !! the diabatic processes are applied before or after the dynamics and may span !! multiple coupling timesteps. real :: t_dyn_rel_diag !< The time of the diagnostics relative to diabatic processes and remapping - !! (in seconds). t_dyn_rel_diag is always positive, since the diagnostics must lag. + !! [T ~> s]. t_dyn_rel_diag is always positive, since the diagnostics must lag. integer :: ndyn_per_adv = 0 !< Number of calls to dynamics since the last call to advection. !### Must be saved if thermo spans coupling? @@ -214,8 +214,8 @@ module MOM !! This is intended for running MOM6 in offline tracer mode type(time_type), pointer :: Time !< pointer to the ocean clock - real :: dt !< (baroclinic) dynamics time step [s] - real :: dt_therm !< thermodynamics time step [s] + real :: dt !< (baroclinic) dynamics time step [T ~> s] + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. integer :: nstep_tot = 0 !< The total number of dynamic timesteps tcaaken @@ -392,7 +392,7 @@ module MOM !! The action of lateral processes on tracers occur in calls to !! advect_tracer and tracer_hordiff. Vertical mixing and possibly remapping !! occur inside of diabatic. -subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & +subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & end_cycle, cycle_length, reset_therm) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces @@ -400,7 +400,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval covered by this run segment [s]. + real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(Wave_parameters_CS), & optional, pointer :: Waves !< An optional pointer to a wave property CS @@ -432,17 +432,17 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: dt ! baroclinic time step [s] - real :: dtth ! time step for thickness diffusion [s] - real :: dtdia ! time step for diabatic processes [s] - real :: dt_therm ! a limited and quantized version of CS%dt_therm [s] - real :: dt_therm_here ! a further limited value of dt_therm [s] + real :: time_interval ! time interval covered by this run segment [T ~> s]. + real :: dt ! baroclinic time step [T ~> s] + real :: dtdia ! time step for diabatic processes [T ~> s] + real :: dt_therm ! a limited and quantized version of CS%dt_therm [T ~> s] + real :: dt_therm_here ! a further limited value of dt_therm [T ~> s] real :: wt_end, wt_beg real :: bbl_time_int ! The amount of time over which the calculated BBL ! properties will apply, for use in diagnostics, or 0 - ! if it is not to be calculated anew [s]. - real :: rel_time = 0.0 ! relative time since start of this call [s]. + ! if it is not to be calculated anew [T ~> s]. + real :: rel_time = 0.0 ! relative time since start of this call [T ~> s]. logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -457,7 +457,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & logical :: cycle_end ! If true, do calculations and diagnostics that are only done at ! the end of a stepping cycle (whatever that may mean). logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. - real :: cycle_time ! The length of the coupled time-stepping cycle [s]. + real :: cycle_time ! The length of the coupled time-stepping cycle [T ~> s]. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & ssh ! sea surface height, which may be based on eta_av [m] @@ -467,7 +467,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. - real :: I_wt_ssh + real :: I_wt_ssh ! The inverse of the time weights [T-1 ~> s-1] type(time_type) :: Time_local, end_time_thermo, Time_temp type(group_pass_type) :: pass_tau_ustar_psurf @@ -480,13 +480,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB u => CS%u ; v => CS%v ; h => CS%h + time_interval = US%s_to_T*time_int_in do_dyn = .true. ; if (present(do_dynamics)) do_dyn = do_dynamics do_thermo = .true. ; if (present(do_thermodynamics)) do_thermo = do_thermodynamics if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL,"Step_MOM: "//& "Both do_dynamics and do_thermodynamics are false, which makes no sense.") cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle - cycle_time = time_interval ; if (present(cycle_length)) cycle_time = cycle_length + cycle_time = time_interval ; if (present(cycle_length)) cycle_time = US%s_to_T*cycle_length therm_reset = cycle_start ; if (present(reset_therm)) therm_reset = reset_therm call cpu_clock_begin(id_clock_ocean) @@ -513,10 +514,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ntstep = floor(dt_therm/dt + 0.001) elseif (.not.do_thermo) then dt_therm = CS%dt_therm - if (present(cycle_length)) dt_therm = min(CS%dt_therm, cycle_length) + if (present(cycle_length)) dt_therm = min(CS%dt_therm, US%s_to_T*cycle_length) ! ntstep is not used. else - ntstep = MAX(1,MIN(n_max,floor(CS%dt_therm/dt + 0.001))) + ntstep = MAX(1, MIN(n_max, floor(CS%dt_therm/dt + 0.001))) dt_therm = dt*ntstep endif @@ -562,8 +563,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo if (associated(CS%VarMix)) then - call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), & - CS%diag) + call enable_averages(cycle_time, Time_start + real_to_time(US%T_to_s*cycle_time), CS%diag) call calc_resoln_function(h, CS%tv, G, GV, US, CS%VarMix) call disable_averaging(CS%diag) endif @@ -588,7 +588,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom - call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag) + call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag) call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif @@ -610,9 +610,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do n=1,n_max rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(US%T_to_s*(rel_time - 0.5*dt)) ! Set the local time to the end of the time step. - Time_local = Time_start + real_to_time(rel_time) + Time_local = Time_start + real_to_time(US%T_to_s*rel_time) if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) @@ -625,7 +625,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & elseif (thermo_does_span_coupling) then dtdia = dt_therm if ((fluxes%dt_buoy_accum > 0.0) .and. (dtdia > time_interval) .and. & - (abs(fluxes%dt_buoy_accum - dtdia) > 1e-6*dtdia)) then + (abs(US%s_to_T*fluxes%dt_buoy_accum - dtdia) > 1e-6*dtdia)) then call MOM_error(FATAL, "step_MOM: Mismatch between long thermodynamic "//& "timestep and time over which buoyancy fluxes have been accumulated.") endif @@ -639,10 +639,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) then ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they begin at the same time. - CS%Time = CS%Time + real_to_time(0.5*(dtdia-dt)) + CS%Time = CS%Time + real_to_time(0.5*US%T_to_s*(dtdia-dt)) ! The end-time of the diagnostic interval needs to be set ahead if there ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + real_to_time(dtdia-dt) + end_time_thermo = Time_local + real_to_time(US%T_to_s*(dtdia-dt)) endif ! Apply diabatic forcing, do mixing, and regrid. @@ -655,7 +655,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(US%T_to_s*(rel_time - 0.5*dt)) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -742,7 +742,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they end at the same time. - if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) + if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*US%T_to_s*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & @@ -757,7 +757,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(US%T_to_s*(rel_time - 0.5*dt)) endif if (do_dyn) then @@ -780,11 +780,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) ! Diagnostics that require the complete state to be up-to-date can be calculated. - call enable_averaging(CS%t_dyn_rel_diag, Time_local, CS%diag) + call enable_averages(CS%t_dyn_rel_diag, Time_local, CS%diag) call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, & CS%CDp, p_surf, CS%t_dyn_rel_diag, CS%diag_pre_sync,& G, GV, US, CS%diagnostics_CSp) - call post_tracer_diagnostics(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, CS%t_dyn_rel_diag) + call post_tracer_diagnostics(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, US%T_to_s*CS%t_dyn_rel_diag) call diag_copy_diag_to_storage(CS%diag_pre_sync, h, CS%diag) if (showCallTree) call callTree_waypoint("finished calculate_diagnostic_fields (step_MOM)") call disable_averaging(CS%diag) @@ -837,11 +837,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (cycle_end) then call cpu_clock_begin(id_clock_diagnostics) if (CS%time_in_cycle > 0.0) then - call enable_averaging(CS%time_in_cycle, Time_local, CS%diag) + call enable_averages(CS%time_in_cycle, Time_local, CS%diag) call post_surface_dyn_diags(CS%sfc_IDs, G, CS%diag, sfc_state, ssh) endif if (CS%time_in_thermo_cycle > 0.0) then - call enable_averaging(CS%time_in_thermo_cycle, Time_local, CS%diag) + call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) endif @@ -851,13 +851,13 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Accumulate the surface fluxes for assessing conservation if (do_thermo .and. fluxes%fluxes_used) & - call accumulate_net_input(fluxes, sfc_state, fluxes%dt_buoy_accum, & - G, CS%sum_output_CSp) + call accumulate_net_input(fluxes, sfc_state, CS%tv, fluxes%dt_buoy_accum, & + G, US, CS%sum_output_CSp) if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, & - dt_forcing=real_to_time(time_interval) ) + dt_forcing=real_to_time(US%T_to_s*time_interval) ) call cpu_clock_end(id_clock_other) @@ -876,11 +876,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step, !! intent in [Pa]. - real, intent(in) :: dt !< time interval covered by this call [s]. + real, intent(in) :: dt !< time interval covered by this call [T ~> s]. real, intent(in) :: dt_thermo !< time interval covered by any updates that may - !! span multiple dynamics steps [s]. + !! span multiple dynamics steps [T ~> s]. real, intent(in) :: bbl_time_int !< time interval over which updates to the - !! bottom boundary layer properties will apply [s], + !! bottom boundary layer properties will apply [T ~> s], !! or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type @@ -896,8 +896,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! various unit conversion factors type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component [m s-1] - v => NULL(), & ! v : meridional velocity component [m s-1] + u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] + v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1] h => NULL() ! h : layer thickness [H ~> m or kg m-2] logical :: calc_dtbt ! Indicates whether the dynamically adjusted @@ -919,7 +919,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag) + call enable_averages(dt_thermo, Time_local+real_to_time(US%T_to_s*(dt_thermo-dt)), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix) @@ -937,8 +937,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then - call enable_averaging(bbl_time_int, & - Time_local + real_to_time(bbl_time_int-dt), CS%diag) + call enable_averages(bbl_time_int, & + Time_local + real_to_time(US%T_to_s*(bbl_time_int-dt)), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(CS%u(:,:,:), CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & @@ -1041,7 +1041,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call cpu_clock_end(id_clock_dynamics) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) - call enable_averaging(dt, Time_local, CS%diag) + call enable_averages(dt, Time_local, CS%diag) ! These diagnostics are available after every time dynamics step. if (IDs%id_u > 0) call post_data(IDs%id_u, u, CS%diag) if (IDs%id_v > 0) call post_data(IDs%id_v, v, CS%diag) @@ -1077,13 +1077,13 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, & "Pre-advection frazil", G%HI, haloshift=0) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & - "Pre-advection salt deficit", G%HI, haloshift=0) - ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G) + "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%R_to_kg_m3*US%Z_to_m) + ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) call cpu_clock_end(id_clock_other) endif call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) - call enable_averaging(CS%t_dyn_rel_adv, Time_local, CS%diag) + call enable_averages(CS%t_dyn_rel_adv, Time_local, CS%diag) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) @@ -1091,7 +1091,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") call update_segment_tracer_reservoirs(G, GV, CS%uhtr, CS%vhtr, h, CS%OBC, & - CS%t_dyn_rel_adv, CS%tracer_Reg) + US%T_to_s*CS%t_dyn_rel_adv, CS%tracer_Reg) call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) @@ -1138,7 +1138,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - real, intent(in) :: dtdia !< The time interval over which to advance [s] + real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s] type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. type(wave_parameters_CS), & @@ -1159,10 +1159,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & use_ice_shelf = .false. if (associated(fluxes%frac_shelf_h)) use_ice_shelf = .true. - call enable_averaging(dtdia, Time_end_thermo, CS%diag) + call enable_averages(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then - call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + call apply_oda_tracer_increments(US%T_to_s*dtdia,G,tv,h,CS%odaCS) endif if (update_BBL) then @@ -1184,7 +1184,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) - call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) + call MOM_thermo_chksum("Pre-diabatic ", tv, G, US, haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) endif @@ -1201,7 +1201,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! (that may comprise several dynamical time steps) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. if ( CS%use_ALE_algorithm ) then - call enable_averaging(dtdia, Time_end_thermo, CS%diag) + call enable_averages(dtdia, Time_end_thermo, CS%diag) ! call pass_vector(u, v, G%Domain) if (associated(tv%T)) & call create_group_pass(pass_T_S_h, tv%T, G%Domain, To_All+Omit_Corners, halo=1) @@ -1221,9 +1221,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_ALE) if (use_ice_shelf) then call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, & - dtdia, fluxes%frac_shelf_h) + US%T_to_s*dtdia, fluxes%frac_shelf_h) else - call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, dtdia) + call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, US%T_to_s*dtdia) endif if (showCallTree) call callTree_waypoint("finished ALE_main (step_MOM_thermo)") @@ -1252,7 +1252,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call diag_update_remap_grids(CS%diag) !### Consider moving this up into the if ALE block. - call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, dtdia) + call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, US%T_to_s*dtdia) if (CS%debug) then call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) @@ -1266,8 +1266,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%frazil)) call hchksum(tv%frazil, & "Post-diabatic frazil", G%HI, haloshift=0) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & - "Post-diabatic salt deficit", G%HI, haloshift=0) - ! call MOM_thermo_chksum("Post-diabatic ", tv, G) + "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%R_to_kg_m3*US%Z_to_m) + ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) call check_redundant("Post-diabatic ", u, v, G) endif call disable_averaging(CS%diag) @@ -1276,7 +1276,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & else ! complement of "if (.not.CS%adiabatic)" call cpu_clock_begin(id_clock_diabatic) - call adiabatic(h, tv, fluxes, dtdia, G, GV, CS%diabatic_CSp) + call adiabatic(h, tv, fluxes, US%T_to_s*dtdia, G, GV, CS%diabatic_CSp) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1325,6 +1325,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS logical :: do_vertical !< If enough time has elapsed, do the diabatic tracer sources/sinks logical :: adv_converged !< True if all the horizontal fluxes have been used + real :: dt_off ! The offline timestep [T ~> s] integer :: dt_offline, dt_offline_vertical logical :: skip_diffusion integer :: id_eta_diff_end @@ -1353,6 +1354,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call extract_offline_main(CS%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, & dt_offline, dt_offline_vertical, skip_diffusion) Time_end = increment_date(Time_start, seconds=floor(time_interval+0.001)) + dt_off = US%s_to_T*REAL(dt_offline) + call enable_averaging(time_interval, Time_end, CS%diag) ! Check to see if this is the first iteration of the offline interval @@ -1403,9 +1406,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (associated(CS%VarMix)) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, dt_off, G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & + call tracer_hordiff(CS%h, dt_off, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1428,9 +1431,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (associated(CS%VarMix)) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, dt_off, G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & + call tracer_hordiff(CS%h, dt_off, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1465,8 +1468,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + call tracer_hordiff(h_end, dt_off, CS%MEKE, CS%VarMix, G, GV, US, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif CS%h = h_end @@ -1737,7 +1740,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The (baroclinic) dynamics time step. The time-step that "//& "is actually used will be an integer fraction of the "//& "forcing time-step (DT_FORCING in ocean-only mode or the "//& - "coupling timestep in coupled mode.)", units="s", & + "coupling timestep in coupled mode.)", units="s", scale=US%s_to_T, & fail_if_missing=.true.) call get_param(param_file, "MOM", "DT_THERM", CS%dt_therm, & "The thermodynamic and tracer advection time step. "//& @@ -1745,7 +1748,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "and less than the forcing or coupling time-step, unless "//& "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& "can be an integer multiple of the coupling timestep. By "//& - "default DT_THERM is set to DT.", units="s", default=CS%dt) + "default DT_THERM is set to DT.", & + units="s", scale=US%s_to_T, default=US%T_to_s*CS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", CS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -1779,7 +1783,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%split) then call get_param(param_file, "MOM", "DTBT", dtbt, default=-0.98) - default_val = CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 + default_val = US%T_to_s*CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 CS%dtbt_reset_period = -1.0 call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, & "The period between recalculations of DTBT (if DTBT <= 0). "//& @@ -2354,7 +2358,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) if (associated(CS%sponge_CSp)) & - call init_sponge_diags(Time, G, diag, CS%sponge_CSp) + call init_sponge_diags(Time, G, GV, US, diag, CS%sponge_CSp) if (associated(CS%ALE_sponge_CSp)) & call init_ALE_sponge_diags(Time, G, diag, CS%ALE_sponge_CSp) @@ -2368,7 +2372,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%sponge_CSp, CS%ALE_sponge_CSp) endif - call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) + call tracer_advect_init(Time, G, US, param_file, diag, CS%tracer_adv_CSp) call tracer_hor_diff_init(Time, G, US, param_file, diag, CS%tv%eqn_of_state, & CS%tracer_diff_CSp) @@ -2376,7 +2380,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("tracer registry now locked (initialize_MOM)") ! now register some diagnostics since the tracer registry is now locked - call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) + call register_surface_diags(Time, G, US, CS%sfc_IDs, CS%diag, CS%tv) call register_diags(Time, G, GV, US, CS%IDs, CS%diag) call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, US, & @@ -2566,7 +2570,7 @@ subroutine MOM_timing_init(CS) id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER) id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE) - id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) + id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE) id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE) id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) @@ -2648,10 +2652,12 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) "Height unit conversion factor", "Z meter-1") call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & "Thickness unit conversion factor", "H meter-1") - call register_restart_field(US%m_to_Z_restart, "m_to_L", .false., restart_CSp, & + call register_restart_field(US%m_to_L_restart, "m_to_L", .false., restart_CSp, & "Length unit conversion factor", "L meter-1") call register_restart_field(US%s_to_T_restart, "s_to_T", .false., restart_CSp, & "Time unit conversion factor", "T second-1") + call register_restart_field(US%kg_m3_to_R_restart, "kg_m3_to_R", .false., restart_CSp, & + "Density unit conversion factor", "R m3 kg-1") end subroutine set_restart_fields @@ -2668,7 +2674,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) !! the SSH correction using the equation of state. real :: Rho_conv ! The density used to convert surface pressure to - ! a corrected effective SSH [kg m-3]. + ! a corrected effective SSH [R ~> kg m-3]. real :: IgR0 ! The SSH conversion factor from Pa to m [m Pa-1]. logical :: calc_rho integer :: i, j, is, ie, js, je @@ -2682,11 +2688,11 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) do j=js,je ; do i=is,ie if (calc_rho) then call calculate_density(tv%T(i,j,1), tv%S(i,j,1), p_atm(i,j)/2.0, & - Rho_conv, tv%eqn_of_state) + Rho_conv, tv%eqn_of_state, scale=US%kg_m3_to_R) else - Rho_conv=GV%Rho0 + Rho_conv = GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * GV%mks_g_Earth) + IgR0 = 1.0 / (Rho_conv * US%R_to_kg_m3*GV%mks_g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif @@ -2709,8 +2715,6 @@ subroutine extract_surface_state(CS, sfc_state) type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info type(unit_scale_type), pointer :: US => NULL() !< structure containing various unit conversion factors real, dimension(:,:,:), pointer :: & -! u => NULL(), & !< u : zonal velocity component [m s-1] -! v => NULL(), & !< v : meridional velocity component [m s-1] h => NULL() !< h : layer thickness [H ~> m or kg m-2] real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed @@ -2743,12 +2747,8 @@ subroutine extract_surface_state(CS, sfc_state) call allocate_surface_state(sfc_state, G, use_temperature, do_integrals=.true.) endif sfc_state%frazil => CS%tv%frazil - sfc_state%TempxPmE => CS%tv%TempxPmE - sfc_state%internal_heat => CS%tv%internal_heat sfc_state%T_is_conT = CS%tv%T_is_conT sfc_state%S_is_absS = CS%tv%S_is_absS - if (associated(CS%visc%taux_shelf)) sfc_state%taux_shelf => CS%visc%taux_shelf - if (associated(CS%visc%tauy_shelf)) sfc_state%tauy_shelf => CS%visc%tauy_shelf do j=js,je ; do i=is,ie sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) @@ -2801,7 +2801,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * CS%tv%T(i,j,k) sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * CS%tv%S(i,j,k) else - sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) + dh * GV%Rlay(k) + sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) + dh * US%R_to_kg_m3*GV%Rlay(k) endif depth(i) = depth(i) + dh enddo ; enddo @@ -2920,7 +2920,7 @@ subroutine extract_surface_state(CS, sfc_state) if (G%mask2dT(i,j)>0.) then ! instantaneous melt_potential [J m-2] - sfc_state%melt_potential(i,j) = CS%tv%C_p * CS%GV%Rho0 * delT(i) + sfc_state%melt_potential(i,j) = CS%tv%C_p * US%R_to_kg_m3*GV%Rho0 * delT(i) endif enddo enddo ! end of j loop @@ -2930,7 +2930,31 @@ subroutine extract_surface_state(CS, sfc_state) !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ! Convert from gSalt to kgSalt - sfc_state%salt_deficit(i,j) = 1000.0 * CS%tv%salt_deficit(i,j) + sfc_state%salt_deficit(i,j) = 1000.0 * US%R_to_kg_m3*US%Z_to_m*CS%tv%salt_deficit(i,j) + enddo ; enddo + endif + if (allocated(sfc_state%TempxPmE) .and. associated(CS%tv%TempxPmE)) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + sfc_state%TempxPmE(i,j) = US%R_to_kg_m3*US%Z_to_m*CS%tv%TempxPmE(i,j) + enddo ; enddo + endif + if (allocated(sfc_state%internal_heat) .and. associated(CS%tv%internal_heat)) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + sfc_state%internal_heat(i,j) = CS%tv%internal_heat(i,j) + enddo ; enddo + endif + if (allocated(sfc_state%taux_shelf) .and. associated(CS%visc%taux_shelf)) then + !$OMP parallel do default(shared) + do j=js,je ; do I=is-1,ie + sfc_state%taux_shelf(I,j) = US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L*CS%visc%taux_shelf(I,j) + enddo ; enddo + endif + if (allocated(sfc_state%tauy_shelf) .and. associated(CS%visc%tauy_shelf)) then + !$OMP parallel do default(shared) + do J=js-1,je ; do i=is,ie + sfc_state%tauy_shelf(i,J) = US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L*CS%visc%tauy_shelf(i,J) enddo ; enddo endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 9bb0a02606..5737999426 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -77,13 +77,13 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, - !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. + !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> kg m-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. - alpha_star, & ! Compression adjusted specific volume [m3 kg-1]. + alpha_star, & ! Compression adjusted specific volume [R-1 ~> m3 kg-1]. dz_geo ! The change in geopotential across a layer [m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. ! p may be adjusted (with a nonlinear equation of state) so that @@ -96,7 +96,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the - ! deepest variable density near-surface layer [kg m-3]. + ! deepest variable density near-surface layer [R ~> kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & dM, & ! A barotropic correction to the Montgomery potentials to @@ -110,7 +110,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). - real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. + real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [R ~> kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients [L T-2 ~> m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost @@ -125,10 +125,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real :: I_gEarth ! The inverse of g_Earth [s2 Z m-2 ~> s2 m-1] ! real :: dalpha - real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). - real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. + real :: Pa_to_p_dyn ! A conversion factor from Pa (= kg m-1 s-2) to the units of + ! dynamic pressure (R L2 T-2) [ R L2 T-2 m s2 kg-1 ~> nondim] + real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). + real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each - ! interface [kg m-3]. + ! interface [R-1 ~> m3 kg-1]. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -148,9 +150,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif + Pa_to_p_dyn = US%kg_m3_to_R * US%m_s_to_L_T**2 I_gEarth = 1.0 / (US%L_T_to_m_s**2 * GV%g_Earth) dp_neglect = GV%H_to_Pa * GV%H_subroundoff - do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo + do k=1,nz ; alpha_Lay(k) = 1.0 / (GV%Rlay(k)) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo if (use_p_atm) then @@ -200,7 +203,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 - SSH(i,j) = SSH(i,j) + (US%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k) + SSH(i,j) = SSH(i,j) + GV%H_to_RZ * h(i,j,k) * alpha_Lay(k) enddo ; enddo ; enddo endif @@ -233,7 +236,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb) @@ -250,7 +253,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) private(rho_in_situ) do k=1,nz ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k),tv_tmp%S(:,j,k),p_ref, & - rho_in_situ,Isq,Ieq-Isq+2,tv%eqn_of_state) + rho_in_situ,Isq,Ieq-Isq+2,tv%eqn_of_state, scale=US%kg_m3_to_R) do i=Isq,Ieq+1 ; alpha_star(i,j,k) = 1.0 / rho_in_situ(i) ; enddo enddo ; enddo endif ! use_EOS @@ -259,20 +262,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_star(i,j,nz) + M(i,j,nz) = geopot_bot(i,j) + Pa_to_p_dyn*p(i,j,nz+1) * alpha_star(i,j,nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) + M(i,j,k) = M(i,j,k+1) + Pa_to_p_dyn*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) enddo ; enddo enddo else ! not use_EOS !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_Lay(nz) + M(i,j,nz) = geopot_bot(i,j) + Pa_to_p_dyn*p(i,j,nz+1) * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * dalpha_int(K+1) + M(i,j,k) = M(i,j,k+1) + Pa_to_p_dyn*p(i,j,K+1) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -295,11 +298,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enddo ; enddo ! if (use_EOS) then ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) +! M(i,j,k) = M(i,j,k-1) - Pa_to_p_dyn*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) ! enddo ; enddo ; enddo ! else ! not use_EOS ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * dalpha_int(K) +! M(i,j,k) = M(i,j,k-1) - Pa_to_p_dyn*p(i,j,K) * dalpha_int(K) ! enddo ; enddo ; enddo ! endif ! use_EOS @@ -320,14 +323,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * Pa_to_p_dyn * & ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * Pa_to_p_dyn * & ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc @@ -374,7 +377,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !! atmosphere-ocean [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies - !! [m2 s-2 H-1 ~> m s-2]. + !! [L2 T-2 H-1 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -392,7 +395,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! than the mixed layer have the mixed layer's properties [ppt]. real :: Rho_cv_BL(SZI_(G)) ! The coordinate potential density in - ! the deepest variable density near-surface layer [kg m-3]. + ! the deepest variable density near-surface layer [R ~> kg m-3]. real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation ! for compressibility [Z ~> m]. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal @@ -401,7 +404,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients [L T-2 ~> m s-2] real :: h_neglect ! A thickness that is so small it is usually lost @@ -435,7 +438,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -488,7 +491,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -509,8 +512,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & - Isq,Ieq-Isq+2,tv%eqn_of_state) - do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R*G_Rho0) enddo ; enddo endif ! use_EOS @@ -616,7 +618,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies - !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. + !! [L2 T-2 H-1 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility !! compensated), times g/rho_0 [L2 Z-1 T-2 ~> m s-2]. @@ -626,9 +628,9 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) real :: press(SZI_(G)) ! Interface pressure [Pa]. real :: T_int(SZI_(G)) ! Interface temperature [degC]. real :: S_int(SZI_(G)) ! Interface salinity [ppt]. - real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. - real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [kg m-3 ppt-1]. - real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer [kg m-3]. + real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_in_situ(SZI_(G)) ! In-situ density at the top of a layer [R ~> kg m-3]. real :: G_Rho0 ! A scaled version of g_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using @@ -665,7 +667,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & - Isq, Ieq-Isq+2, tv%eqn_of_state) + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -676,7 +678,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, & - Isq, Ieq-Isq+2, tv%eqn_of_state) + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + G_Rho0 * & ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) * & @@ -717,21 +719,21 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) !! to free surface height anomalies !! [L2 H-1 T-2 ~> m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: alpha_star !< The layer specific volumes - !! (maybe compressibility compensated) [m3 kg-1]. + !! (maybe compressibility compensated) [R-1 ~> m3 kg-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & dpbce, & ! A barotropic correction to the pbce to enable the use of ! a reduced gravity form of the equations [L2 H-1 T-2 ~> m4 kg-1 s-2]. - C_htot ! dP_dH divided by the total ocean pressure [Z2 s2 m-2 T-2 H-1 ~> m2 kg-1]. + C_htot ! dP_dH divided by the total ocean pressure [R L2 T-2 H-1 Pa-1 ~> m2 kg-1]. real :: T_int(SZI_(G)) ! Interface temperature [degC]. real :: S_int(SZI_(G)) ! Interface salinity [ppt]. - real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. - real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [kg m-3 ppt-1]. - real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [kg m-3]. - real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. - real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each interface [kg m-3]. + real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [R ~> kg m-3]. + real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. + real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each interface [R-1 ~> m3 kg-1]. real :: dP_dH ! A factor that converts from thickness to pressure times other dimensional - ! conversion factors [Z2 s2 Pa m-2 T-2 H-1 ~> Pa m2 kg-1]. + ! conversion factors [R L2 T-2 H-1 ~> Pa m2 kg-1]. real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_EOS ! If true, density is calculated from T & S using @@ -742,12 +744,9 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) use_EOS = associated(tv%eqn_of_state) - dP_dH = US%m_s_to_L_T**2*GV%H_to_Pa + dP_dH = GV%g_Earth * GV%H_to_RZ dp_neglect = GV%H_to_Pa * GV%H_subroundoff - do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo - do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo - if (use_EOS) then if (present(alpha_star)) then !$OMP parallel do default(shared) @@ -765,10 +764,10 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) !$OMP parallel do default(shared) private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) do j=Jsq,Jeq+1 call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) - pbce(i,j,nz) = dP_dH / rho_in_situ(i) + pbce(i,j,nz) = dP_dH / (rho_in_situ(i)) enddo do k=nz-1,1,-1 do i=Isq,Ieq+1 @@ -776,18 +775,22 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) S_int(i) = 0.5*(tv%S(i,j,k)+tv%S(i,j,k+1)) enddo call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, & - Isq, Ieq-Isq+2, tv%eqn_of_state) + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, & - Isq, Ieq-Isq+2, tv%eqn_of_state) + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=Isq,Ieq+1 - pbce(i,j,k) = pbce(i,j,k+1) + ((p(i,j,K+1)-p(i,j,1))*C_htot(i,j)) * & + pbce(i,j,k) = pbce(i,j,k+1) + ((p(i,j,K+1)-p(i,j,1))*C_htot(i,j)) * & ((dR_dT(i)*(tv%T(i,j,k+1)-tv%T(i,j,k)) + & - dR_dS(i)*(tv%S(i,j,k+1)-tv%S(i,j,k))) / rho_in_situ(i)**2) + dR_dS(i)*(tv%S(i,j,k+1)-tv%S(i,j,k))) / (rho_in_situ(i)**2)) enddo enddo enddo endif else ! not use_EOS + + do k=1,nz ; alpha_Lay(k) = 1.0 / (GV%Rlay(k)) ; enddo + do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 @@ -796,7 +799,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k+1) + ((p(i,j,K+1)-p(i,j,1))*C_htot(i,j)) * & - dalpha_int(K+1) + dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index f84b8e780e..75a2dfad7f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -145,7 +145,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! interface atop a layer [m2 s-2]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer [kg m-3]. + ! density near-surface layer [R ~> kg m-3]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_za ! The zonal integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing [m2 s-2]. @@ -229,7 +229,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb) @@ -286,7 +286,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p useMassWghtInterp = CS%useMassWghtInterp) endif else - alpha_anom = 1.0/GV%Rlay(k) - alpha_ref + alpha_anom = 1.0/(US%R_to_kg_m3*GV%Rlay(k)) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp(i,j) = GV%H_to_Pa * h(i,j,k) dza(i,j,k) = alpha_anom * dp(i,j) @@ -349,7 +349,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & - (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) + (p(i,j,1)*(1.0/(US%R_to_kg_m3*GV%Rlay(1)) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -469,9 +469,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer [kg m-3]. + ! density near-surface layer [R ~> kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & - dz, & ! The change in geopotential thickness through a layer [m2 s-2]. + dz_geo, & ! The change in geopotential thickness through a layer times some dimensional + ! rescaling factors [kg m-1 R-1 s-2 ~> m2 s-2]. pa, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the ! the interface atop a layer [Pa]. dpa, & ! The change in pressure anomaly between the top and bottom @@ -495,16 +496,18 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. - real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. + real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [Pa] (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. - real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: g_Earth_mks_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: g_Earth_z_geo ! Another scaled version of g_Earth [R m5 kg-1 Z-1 s-2 ~> m s-2]. real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 in [L2 m5 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. - real :: Rho_ref ! The reference density [kg m-3]. + real :: G_Rho0 ! G_Earth / Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. + real :: Rho_ref ! The reference density [R ~> kg m-3]. + real :: Rho_ref_mks ! The reference density in mks units [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. @@ -531,10 +534,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = GV%g_Earth/GV%Rho0 - rho_ref = CS%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / (US%R_to_kg_m3*GV%Rho0) + g_Earth_mks_z = US%L_T_to_m_s**2 * GV%g_Earth + g_Earth_z_geo = US%R_to_kg_m3*US%L_T_to_m_s**2 * GV%g_Earth + G_Rho0 = GV%g_Earth / GV%Rho0 + rho_ref_mks = CS%Rho0 + rho_ref = rho_ref_mks*US%kg_m3_to_R if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -587,7 +592,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -609,11 +614,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 if (use_p_atm) then - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, & + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) else - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -646,12 +651,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*g_Earth_z_geo)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) + pa(i,j) = (rho_ref*g_Earth_z_geo)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -677,20 +682,20 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, g_Earth_z, & + rho_ref_mks, CS%Rho0, g_Earth_mks_z, & dz_neglect, G%bathyT, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, g_Earth_z, & + rho_ref_mks, CS%Rho0, g_Earth_mks_z, & G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, g_Earth_z, G%HI, G%HI, tv%eqn_of_state, & + rho_ref_mks, CS%Rho0, g_Earth_mks_z, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif @@ -701,17 +706,17 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dz(i,j) = g_Earth_z * GV%H_to_Z*h(i,j,k) - dpa(i,j) = (GV%Rlay(k) - rho_ref)*dz(i,j) - intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref)*dz(i,j)*h(i,j,k) + dz_geo(i,j) = g_Earth_z_geo * GV%H_to_Z*h(i,j,k) + dpa(i,j) = (GV%Rlay(k) - rho_ref) * dz_geo(i,j) + intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref) * dz_geo(i,j)*h(i,j,k) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - intx_dpa(I,j) = 0.5*(GV%Rlay(k) - rho_ref) * (dz(i,j)+dz(i+1,j)) + intx_dpa(I,j) = 0.5*(GV%Rlay(k) - rho_ref) * (dz_geo(i,j) + dz_geo(i+1,j)) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - inty_dpa(i,J) = 0.5*(GV%Rlay(k) - rho_ref) * (dz(i,j)+dz(i,j+1)) + inty_dpa(i,J) = 0.5*(GV%Rlay(k) - rho_ref) * (dz_geo(i,j) + dz_geo(i,j+1)) enddo ; enddo endif diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 073f790fc5..faa7912f1e 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -143,7 +143,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! interface atop a layer [m2 s-2]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer [kg m-3]. + ! density near-surface layer [R ~> kg m-3]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_za_bk ! The zonal integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing [m2 s-2]. @@ -225,7 +225,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb) @@ -251,7 +251,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, inty_dza(:,:,k), bathyP=p(:,:,nz+1), dP_tiny=dp_neglect, & useMassWghtInterp = CS%useMassWghtInterp) else - alpha_anom = 1.0/GV%Rlay(k) - alpha_ref + alpha_anom = 1.0/(US%R_to_kg_m3*GV%Rlay(k)) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp(i,j) = GV%H_to_Pa * h(i,j,k) dza(i,j,k) = alpha_anom * dp(i,j) @@ -314,7 +314,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - US%m_s_to_L_T**2*(p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/(US%R_to_kg_m3*GV%Rlay(1)) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -450,9 +450,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer [kg m-3]. + ! density near-surface layer [R ~> kg m-3]. real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices - dz_bk, & ! The change in geopotential thickness through a layer [m2 s-2]. + dz_bk, & ! The change in geopotential thickness through a layer times some dimensional + ! rescaling factors [kg m-1 R-1 s-2 ~> m2 s-2]. pa_bk, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the ! the interface atop a layer [Pa]. dpa_bk, & ! The change in pressure anomaly between the top and bottom @@ -476,16 +477,18 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, & ! Top and bottom edge salinities for linear reconstructions within each layer [ppt]. T_t, T_b ! Top and bottom edge temperatures for linear reconstructions within each layer [degC]. - real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. + real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. - real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. - real :: Rho_ref ! The reference density [kg m-3]. + real :: g_Earth_mks_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: g_Earth_z_geo ! Another scaled version of g_Earth [R m5 kg-1 Z-1 s-2 ~> m s-2]. + real :: G_Rho0 ! G_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. + real :: Rho_ref ! The reference density [R-1 ~> kg m-3]. + real :: Rho_ref_mks ! The reference density in mks units [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. @@ -515,10 +518,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth + I_Rho0 = US%m_s_to_L_T**2 / (US%R_to_kg_m3*GV%Rho0) + g_Earth_mks_z = US%L_T_to_m_s**2 * GV%g_Earth + g_Earth_z_geo = US%R_to_kg_m3*US%L_T_to_m_s**2 * GV%g_Earth G_Rho0 = GV%g_Earth / GV%Rho0 - rho_ref = CS%Rho0 + Rho_ref_mks = CS%Rho0 + Rho_ref = Rho_ref_mks*US%kg_m3_to_R if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -571,7 +576,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -594,10 +599,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, do j=Jsq,Jeq+1 if (use_p_atm) then call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) else call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -624,9 +629,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, endif endif -!$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,e,p_atm,nz,use_EOS,& -!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, & -!$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& +!$OMP parallel do default(none) shared(use_p_atm,Rho_ref,Rho_ref_mks,G,GV,e,p_atm,nz,use_EOS,& +!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z_geo, & +!$OMP g_Earth_mks_z,h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, & !$OMP intx_pa_bk,inty_pa_bk,dpa_bk,intz_dpa_bk, & @@ -645,12 +650,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (Rho_ref*g_Earth_z_geo)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) + pa_bk(ib,jb) = (Rho_ref*g_Earth_z_geo)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -674,20 +679,20 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, g_Earth_z, & + Rho_ref_mks, CS%Rho0, g_Earth_mks_z, & dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, g_Earth_z, & + Rho_ref_mks, CS%Rho0, g_Earth_mks_z, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, g_Earth_z, G%HI, G%Block(n), tv%eqn_of_state, & + Rho_ref_mks, CS%Rho0, g_Earth_mks_z, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif @@ -697,15 +702,15 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - dz_bk(ib,jb) = g_Earth_z*GV%H_to_Z*h(i,j,k) - dpa_bk(ib,jb) = (GV%Rlay(k) - rho_ref)*dz_bk(ib,jb) - intz_dpa_bk(ib,jb) = 0.5*(GV%Rlay(k) - rho_ref)*dz_bk(ib,jb)*h(i,j,k) + dz_bk(ib,jb) = g_Earth_z_geo*GV%H_to_Z*h(i,j,k) + dpa_bk(ib,jb) = (GV%Rlay(k) - Rho_ref)*dz_bk(ib,jb) + intz_dpa_bk(ib,jb) = 0.5*(GV%Rlay(k) - Rho_ref) * dz_bk(ib,jb)*h(i,j,k) enddo ; enddo do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk - intx_dpa_bk(Ib,jb) = 0.5*(GV%Rlay(k) - rho_ref) * (dz_bk(ib,jb)+dz_bk(ib+1,jb)) + intx_dpa_bk(Ib,jb) = 0.5*(GV%Rlay(k) - Rho_ref) * (dz_bk(ib,jb)+dz_bk(ib+1,jb)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk - inty_dpa_bk(ib,Jb) = 0.5*(GV%Rlay(k) - rho_ref) * (dz_bk(ib,jb)+dz_bk(ib,jb+1)) + inty_dpa_bk(ib,Jb) = 0.5*(GV%Rlay(k) - Rho_ref) * (dz_bk(ib,jb)+dz_bk(ib,jb+1)) enddo ; enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5f97f5933a..14fc918b60 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -159,11 +159,10 @@ module MOM_barotropic type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. - real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. - real :: dtbt !< The barotropic time step [s]. + real :: dtbt !< The barotropic time step [T ~> s]. real :: dtbt_fraction !< The fraction of the maximum time-step that !! should used. The default is 0.98. - real :: dtbt_max !< The maximum stable barotropic time step [s]. + real :: dtbt_max !< The maximum stable barotropic time step [T ~> s]. real :: dt_bt_filter !< The time-scale over which the barotropic mode solutions are !! filtered [T ~> s] if positive, or as a fraction of DT if !! negative [nondim]. This can never be taken to be longer than 2*dt. @@ -395,8 +394,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. - real, intent(in) :: dt !< The time increment to integrate over. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations [m s-2]. + real, intent(in) :: dt !< The time increment to integrate over [T ~> s]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, + !! [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, !! [L T-2 ~> m s-2]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -444,9 +444,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! gradient at the start of the barotropic stepping !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from - !! ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. + !! ocean to the seafloor [R L Z T-2 ~> Pa]. real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress - !! from ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. + !! from ocean to the seafloor [R L Z T-2 ~> Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate @@ -580,13 +580,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1]. - real :: mass_accel_to_Z ! The depth unit converison times an acceleration conversion divided by - ! the mean density (Rho0) [Z L m s2 T-2 kg-1 ~> m3 kg-1]. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1]. + real :: mass_accel_to_Z ! The inverse of the mean density (Rho0) [R-1 ~> m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. - real :: dt_in_T ! The baroclinic time step [T ~> s]. real :: bebt ! A copy of CS%bebt [nondim]. real :: be_proj ! The fractional amount by which velocities are projected ! when project_velocity is true. For now be_proj is set @@ -653,8 +651,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw - dt_in_T = US%s_to_T*dt - Idt = 1.0 / dt_in_T + + Idt = 1.0 / dt accel_underflow = CS%vel_underflow * Idt use_BT_cont = .false. @@ -714,17 +712,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, nstep = CEILING(dt/CS%dtbt - 0.0001) if (is_root_PE() .and. (nstep /= CS%nstep_last)) then write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, & - & " seconds, max ", ES12.6, ".")') (dt/nstep), CS%dtbt_max + & " seconds, max ", ES12.6, ".")') (US%T_to_s*dt/nstep), US%T_to_s*CS%dtbt_max call MOM_mesg(mesg, 3) endif CS%nstep_last = nstep ! Set the actual barotropic time step. Instep = 1.0 / real(nstep) - dtbt = dt_in_T * Instep + dtbt = dt * Instep bebt = CS%bebt be_proj = CS%bebt - mass_accel_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_accel_to_Z = 1.0 / GV%Rho0 mass_to_Z = US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans @@ -740,7 +738,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_bt_start = time_end_in - real_to_time(dt) + time_bt_start = time_end_in - real_to_time(US%T_to_s*dt) endif !--- begin setup for group halo update @@ -1262,7 +1260,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP find_etaav,jsvf,jevf,isvf,ievf,eta_sum,eta_wtd, & !$OMP ubt_sum,uhbt_sum,PFu_bt_sum,Coru_bt_sum,ubt_wtd,& !$OMP ubt_trans,vbt_sum,vhbt_sum,PFv_bt_sum, & -!$OMP Corv_bt_sum,vbt_wtd,vbt_trans,eta_src,dt_in_T,dtbt, & +!$OMP Corv_bt_sum,vbt_wtd,vbt_trans,eta_src,dt,dtbt, & !$OMP Rayleigh_u, Rayleigh_v, & !$OMP use_BT_Cont,BTCL_u,uhbt0,BTCL_v,vhbt0,eta,Idt,US) & !$OMP private(u_max_cor,v_max_cor,eta_cor_max,Htot) @@ -1360,7 +1358,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! CFL_cor. u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) - eta_cor_max = dt_in_T * (CS%IareaT(i,j) * & + eta_cor_max = dt * (CS%IareaT(i,j) * & (((find_uhbt(u_max_cor, BTCL_u(I,j), US) + uhbt0(I,j)) - & (find_uhbt(-u_max_cor, BTCL_u(I-1,j), US) + uhbt0(I-1,j))) + & ((find_vhbt(v_max_cor, BTCL_v(i,J), US) + vhbt0(i,J)) - & @@ -1376,8 +1374,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif ; enddo ; enddo else ; do j=js,je ; do i=is,ie - if (abs(CS%eta_cor(i,j)) > dt_in_T*CS%eta_cor_bound(i,j)) & - CS%eta_cor(i,j) = sign(dt_in_T*CS%eta_cor_bound(i,j), CS%eta_cor(i,j)) + if (abs(CS%eta_cor(i,j)) > dt*CS%eta_cor_bound(i,j)) & + CS%eta_cor(i,j) = sign(dt*CS%eta_cor_bound(i,j), CS%eta_cor(i,j)) enddo ; enddo ; endif ; endif !$OMP do do j=js,je ; do i=is,ie @@ -1491,9 +1489,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (project_velocity) then ; eta_PF_BT => eta ; else ; eta_PF_BT => eta_pred ; endif if (CS%dt_bt_filter >= 0.0) then - dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt_in_T)) + dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt)) else - dt_filt = 0.5 * max(0.0, dt_in_T * min(-CS%dt_bt_filter, 2.0)) + dt_filt = 0.5 * max(0.0, dt * min(-CS%dt_bt_filter, 2.0)) endif nfilter = ceiling(dt_filt / dtbt) @@ -1551,21 +1549,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + elseif ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + elseif ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) endif enddo ; enddo endif @@ -2141,13 +2139,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! symmetric-memory computational domain, not in the wide halo regions. if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then - u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt_in_T + u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo endif enddo ; enddo ; endif if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then - v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt_in_T + v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif @@ -2369,8 +2367,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) call min_across_PEs(dtbt_max) if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync) - CS%dtbt = CS%dtbt_fraction * US%T_to_s * dtbt_max - CS%dtbt_max = US%T_to_s * dtbt_max + CS%dtbt = CS%dtbt_fraction * dtbt_max + CS%dtbt_max = dtbt_max end subroutine set_dtbt !> The following 4 subroutines apply the open boundary conditions. @@ -3660,8 +3658,6 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) ! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: d_eta ! The difference between estimates of the total ! thicknesses [H ~> m or kg m-2]. - real :: limit_dt ! The fractional mass-source limit divided by the - ! thermodynamic time step [s-1]. integer :: is, ie, js, je, nz, i, j, k real, parameter :: frac_cor = 0.25 real, parameter :: slow_rate = 0.125 @@ -3672,7 +3668,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - !$OMP parallel do default(shared) private(eta_h,h_tot,limit_dt,d_eta) + !$OMP parallel do default(shared) private(eta_h,h_tot,d_eta) do j=js,je do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo if (GV%Boussinesq) then @@ -3743,7 +3739,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed [Z ~> m]. - real :: dtbt_input, dtbt_tmp + real :: dtbt_input ! The input value of DTBT, [nondim] if negative or [s] if positive. + real :: dtbt_tmp ! A temporary copy of CS%dtbt read from a restart file [T ~> s] real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag ! piston velocities. character(len=200) :: inputdir ! The directory in which to find input files. @@ -4161,7 +4158,11 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) CS%dtbt_fraction = -dtbt_input dtbt_tmp = -1.0 - if (query_initialized(CS%dtbt, "DTBT", restart_CS)) dtbt_tmp = CS%dtbt + if (query_initialized(CS%dtbt, "DTBT", restart_CS)) then + dtbt_tmp = CS%dtbt + if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & + dtbt_tmp = (US%s_to_T / US%s_to_T_restart) * CS%dtbt + endif ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 @@ -4169,14 +4170,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra) if (dtbt_input > 0.0) then - CS%dtbt = dtbt_input + CS%dtbt = US%s_to_T * dtbt_input elseif (dtbt_tmp > 0.0) then CS%dtbt = dtbt_tmp endif if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false. - call log_param(param_file, mdl, "DTBT as used", CS%dtbt) - call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max) + call log_param(param_file, mdl, "DTBT as used", CS%dtbt*US%T_to_s) + call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max*US%T_to_s) ! ubtav, vbtav, ubt_IC, vbt_IC, uhbt_IC, and vhbt_IC are allocated and ! initialized in register_barotropic_restarts. @@ -4328,30 +4329,20 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! Calculate other constants which are used for btstep. - ! The following is only valid with the Boussinesq approximation. -! if (GV%Boussinesq) then - do j=js,je ; do I=is-1,ie - if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%bathyT(i+1,j) + G%bathyT(i,j)) - else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless - CS%IDatu(I,j) = 0. - endif - enddo ; enddo - do J=js-1,je ; do i=is,ie - if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) - else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless - CS%IDatv(i,J) = 0. - endif - enddo ; enddo -! else -! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) -! enddo ; enddo -! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) -! enddo ; enddo -! endif + do j=js,je ; do I=is-1,ie + if (G%mask2dCu(I,j)>0.) then + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%bathyT(i+1,j) + G%bathyT(i,j)) + else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless + CS%IDatu(I,j) = 0. + endif + enddo ; enddo + do J=js-1,je ; do i=is,ie + if (G%mask2dCv(i,J)>0.) then + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) + else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless + CS%IDatv(i,J) = 0. + endif + enddo ; enddo call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) if (CS%bound_BT_corr) then diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index e8347881f7..659ca478ed 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -117,11 +117,12 @@ end subroutine MOM_state_chksum_3arg ! ============================================================================= !> Write out chksums for the model's thermodynamic state variables. -subroutine MOM_thermo_chksum(mesg, tv, G, haloshift) +subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). integer :: is, ie, js, je, nz, hs @@ -131,7 +132,8 @@ subroutine MOM_thermo_chksum(mesg, tv, G, haloshift) if (associated(tv%T)) call hchksum(tv%T, mesg//" T",G%HI,haloshift=hs) if (associated(tv%S)) call hchksum(tv%S, mesg//" S",G%HI,haloshift=hs) if (associated(tv%frazil)) call hchksum(tv%frazil, mesg//" frazil",G%HI,haloshift=hs) - if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, mesg//" salt deficit",G%HI,haloshift=hs) + if (associated(tv%salt_deficit)) & + call hchksum(tv%salt_deficit, mesg//" salt deficit",G%HI,haloshift=hs, scale=US%R_to_kg_m3*US%Z_to_m) end subroutine MOM_thermo_chksum diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a2a125eabe..96fa98cbf3 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -73,7 +73,7 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vhbt, OBC, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. @@ -89,7 +89,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vh intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & @@ -149,12 +149,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vh ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -164,12 +164,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vh ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -180,24 +180,24 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vh LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -208,7 +208,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vh end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & +subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. @@ -219,7 +219,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -278,8 +278,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / (dt_in_T) - I_dt = 1.0 / (dt_in_T) + CFL_dt = CS%CFL_limit_adjust / dt + I_dt = 1.0 / dt if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -300,7 +300,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,u,h_in,h_L,h_R,use_visc_rem,visc_rem_u, & -!$OMP uh,dt_in_T,US,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & +!$OMP uh,dt,US,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & !$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC) & !$OMP private(do_I,duhdu,du,du_max_CFL,du_min_CFL,uh_tot_0,duhdu_tot_0, & !$OMP is_simple,FAuI,visc_rem_max,I_vrm,du_lim,dx_E,dx_W,any_simple_OBC ) & @@ -315,7 +315,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & @@ -419,7 +419,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (present(uhbt)) then call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, duhdu_tot_0, du, & - du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true., uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz @@ -434,7 +434,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (set_BT_cont) then call set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,& - du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -487,10 +487,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then if (present(u_cor)) then - call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & + call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) else - call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & + call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) endif endif ; endif @@ -498,7 +498,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -514,7 +514,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh !! with u [H L ~> m2 or kg m-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -539,15 +539,15 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt_in_T * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt_in_T * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) @@ -575,7 +575,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, end subroutine zonal_flux_layer !> Sets the effective interface thickness at each zonal velocity point. -subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL, & +subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, US, LB, vol_CFL, & marginal, visc_rem_u, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -586,7 +586,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio @@ -614,14 +614,14 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt_in_T * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I,j,k) * dt * G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt_in_T * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I,j,k) * dt * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -683,7 +683,7 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -711,7 +711,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< !! The barotropic velocity adjustment [L T-1 ~> m s-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. @@ -779,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt * min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -818,7 +818,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -847,7 +847,7 @@ end subroutine zonal_flux_adjust !> Sets a structure that describes the zonal barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & - du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -867,7 +867,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable !! value of du [L T-1 ~> m s-1]. - real, intent(in) :: dt_in_T !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -915,13 +915,13 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0 / (dt_in_T) + nz = G%ke ; Idt = 1.0 / dt min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & - du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently @@ -963,11 +963,11 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & - visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & - visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & - visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) do I=ish-1,ieh ; if (do_I(I)) then FAmt_0(I) = FAmt_0(I) + duhdu_0(I) FAmt_L(I) = FAmt_L(I) + duhdu_L(I) @@ -1009,7 +1009,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, end subroutine set_zonal_BT_cont !> Calculates the mass or volume fluxes through the meridional faces, and other related quantities. -subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, & +subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. @@ -1018,7 +1018,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -1077,8 +1077,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / (dt_in_T) - I_dt = 1.0 / (dt_in_T) + CFL_dt = CS%CFL_limit_adjust / dt + I_dt = 1.0 / dt if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -1099,7 +1099,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,v,h_in,h_L,h_R,vh,use_visc_rem, & -!$OMP visc_rem_v,dt_in_T,US,G,GV,CS,local_specified_BC,OBC,vhbt, & +!$OMP visc_rem_v,dt,US,G,GV,CS,local_specified_BC,OBC,vhbt, & !$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC ) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & @@ -1115,7 +1115,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & @@ -1215,7 +1215,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (present(vhbt)) then call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & - dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true., vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz @@ -1229,7 +1229,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (set_BT_cont) then call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,& - dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1282,10 +1282,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then if (present(v_cor)) then - call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & + call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) else - call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & + call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) endif endif ; endif @@ -1293,7 +1293,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, J, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. @@ -1312,7 +1312,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v !! [H L ~> m2 or kg m-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1336,16 +1336,16 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i) * dt_in_T * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt_in_T * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) @@ -1374,7 +1374,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, end subroutine merid_flux_layer !> Sets the effective interface thickness at each meridional velocity point. -subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL, & +subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, US, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. @@ -1386,7 +1386,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: vol_CFL !< If true, rescale the ratio @@ -1413,15 +1413,15 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt_in_T * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i,J,k) * dt * G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt_in_T * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i,J,k) * dt * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & @@ -1483,7 +1483,7 @@ end subroutine merid_face_thickness !> Returns the barotropic velocity adjustment that gives the desired barotropic (layer-summed) transport. subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & - dv, dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1510,7 +1510,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with !! dv at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. @@ -1578,7 +1578,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt * min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1617,7 +1617,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1646,7 +1646,7 @@ end subroutine meridional_flux_adjust !> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & - dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. @@ -1666,7 +1666,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! of dv [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value !! of dv [L T-1 ~> m s-1]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -1714,13 +1714,13 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/(dt_in_T) + nz = G%ke ; Idt = 1.0 / dt min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & - dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently @@ -1762,11 +1762,11 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, dvhdv_0, & - visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & - visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & - visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) do i=ish,ieh ; if (do_I(i)) then FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 1f43a699a1..957a3338ca 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -12,7 +12,7 @@ module MOM_dynamics_split_RK2 use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : diag_mediator_init, enable_averages use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr use MOM_diag_mediator, only : register_diag_field, register_static_field use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids @@ -56,7 +56,7 @@ module MOM_dynamics_split_RK2 use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant -use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS +use MOM_vert_friction, only : vertvisc_init, vertvisc_CS use MOM_vert_friction, only : updateCFLtruncationValue use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units @@ -124,9 +124,9 @@ module MOM_dynamics_split_RK2 !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean - !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + !! to the seafloor [R L Z T-2 ~> Pa] real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean - !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + !! to the seafloor [R L Z T-2 ~> Pa] type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the !! effective summed open face areas as a function !! of barotropic flow. @@ -248,7 +248,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt !< time step [T ~> s] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic !! time step [Pa] @@ -317,10 +317,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. - real :: Idt ! The inverse of the timestep [s-1] logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -334,9 +332,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta - dt_in_T = US%s_to_T*dt - Idt = 1.0 / dt - sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums showCallTree = callTree_showQuery() @@ -410,7 +405,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! PFu = d/dx M(h,T,S) ! pbce = dM/deta - if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) + if (CS%begw == 0.0) call enable_averages(dt, Time_local, CS%diag) call cpu_clock_begin(id_clock_pres) call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) @@ -472,14 +467,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * v_bc_accel(i,J,k)) enddo ; enddo enddo - call enable_averaging(dt, Time_local, CS%diag) + call enable_averages(dt, Time_local, CS%diag) call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) @@ -516,7 +511,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt_in_T, G, GV, US, CS%continuity_CSp, & + call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then @@ -544,7 +539,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_end(id_clock_btstep) ! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt_in_T * CS%be + dt_pred = dt * CS%be call cpu_clock_begin(id_clock_mom_update) !$OMP parallel do default(shared) @@ -580,9 +575,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - call vertvisc(up, vp, h, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then @@ -590,7 +585,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) @@ -603,7 +598,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -636,7 +631,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo ; enddo ; enddo ! The correction phase of the time step starts here. - call enable_averaging(dt, Time_local, CS%diag) + call enable_averages(dt, Time_local, CS%diag) ! Calculate a revised estimate of the free-surface height correction to be ! used in the next call to btstep. This call is at this point so that @@ -755,11 +750,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo @@ -808,7 +803,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & + call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) @@ -824,7 +819,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, US%T_to_s*dt) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -839,10 +834,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt_in_T + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt_in_T + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt enddo ; enddo enddo @@ -978,7 +973,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt !< time step [T ~> s] type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for !! budget analysis type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation @@ -1105,6 +1100,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av + id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', & + grain=CLOCK_ROUTINE) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) @@ -1180,7 +1178,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo - call continuity(u, v, h, h_tmp, uh, vh, US%s_to_T*dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) do k=1,nz ; do j=jsd,jed ; do i=isd,ied CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) @@ -1244,7 +1242,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param id_clock_horvisc = cpu_clock_id('(Ocean horizontal viscosity)', grain=CLOCK_MODULE) id_clock_mom_update = cpu_clock_id('(Ocean momentum increments)', grain=CLOCK_MODULE) id_clock_pass = cpu_clock_id('(Ocean message passing)', grain=CLOCK_MODULE) - id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', grain=CLOCK_ROUTINE) id_clock_btcalc = cpu_clock_id('(Ocean barotropic mode calc)', grain=CLOCK_MODULE) id_clock_btstep = cpu_clock_id('(Ocean barotropic mode stepping)', grain=CLOCK_MODULE) id_clock_btforce = cpu_clock_id('(Ocean barotropic forcing calc)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 9e8be65d7a..ed7c440010 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -57,7 +57,7 @@ module MOM_dynamics_unsplit use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : diag_mediator_init, enable_averages use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr use MOM_diag_mediator, only : register_diag_field, register_static_field use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids @@ -94,8 +94,7 @@ module MOM_dynamics_unsplit use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type -use MOM_vert_friction, only : vertvisc, vertvisc_coef -use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS +use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units use MOM_wave_interface, only: wave_parameters_CS @@ -117,9 +116,9 @@ module MOM_dynamics_unsplit diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean - !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + !! to the seafloor [R L Z T-2 ~> Pa] real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean - !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + !! to the seafloor [R L Z T-2 ~> Pa] logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -198,7 +197,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! viscosities, bottom drag viscosities, and related fields. type(time_type), intent(in) :: Time_local !< The model time at the end !! of the time step. - real, intent(in) :: dt !< The dynamics time step [s]. + real, intent(in) :: dt !< The dynamics time step [T ~> s]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface !! pressure at the start of this dynamic step [Pa]. @@ -228,14 +227,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() - real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_in_T = US%s_to_T*dt - dt_pred = dt_in_T / 3.0 + dt_pred = dt / 3.0 h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 @@ -256,7 +253,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif ! diffu = horizontal viscosity terms (u,h) - call enable_averaging(dt,Time_local, CS%diag) + call enable_averages(dt, Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & G, GV, US, CS%hor_visc_CSp) @@ -266,12 +263,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt_in_T*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) - call enable_averaging(0.5*dt,Time_local-real_to_time(0.5*dt), CS%diag) + call enable_averages(0.5*dt, Time_local-real_to_time(0.5*US%T_to_s*dt), CS%diag) ! Here the first half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) @@ -285,16 +282,16 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + dt_in_T * CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + dt * CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + dt_in_T * CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + dt * CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -343,7 +340,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) - call enable_averaging(dt, Time_local, CS%diag) + call enable_averages(dt, Time_local, CS%diag) call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) @@ -358,7 +355,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt_in_T), G, GV, US, & + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) @@ -395,11 +392,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * 0.5 * & + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * 0.5 * & + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -422,7 +419,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(upp, vpp, hp, h, uh, vh, (dt_in_T*0.5), G, GV, US, & + call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) @@ -431,12 +428,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - call enable_averaging(0.5*dt, Time_local, CS%diag) + call enable_averages(0.5*dt, Time_local, CS%diag) ! Here the second half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) call disable_averaging(CS%diag) - call enable_averaging(dt, Time_local, CS%diag) + call enable_averages(dt, Time_local, CS%diag) ! h_av = (h + hp)/2 do k=1,nz @@ -444,10 +441,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) enddo ; enddo enddo @@ -473,11 +470,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index af33db8011..98de5b931c 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -55,7 +55,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : diag_mediator_init, enable_averages use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr use MOM_diag_mediator, only : register_diag_field, register_static_field use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl @@ -92,8 +92,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type -use MOM_vert_friction, only : vertvisc, vertvisc_coef -use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS +use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units @@ -114,9 +113,9 @@ module MOM_dynamics_unsplit_RK2 diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean - !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + !! to the seafloor [R L Z T-2 ~> Pa] real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean - !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + !! to the seafloor [R L Z T-2 ~> Pa] real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme. @@ -206,7 +205,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! viscosities, and related fields. type(time_type), intent(in) :: Time_local !< The model time at the end of !! the time step. - real, intent(in) :: dt !< The baroclinic dynamics time step [s]. + real, intent(in) :: dt !< The baroclinic dynamics time step [T ~> s]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to !! the surface pressure at the beginning @@ -239,15 +238,13 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() - real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic ! time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_in_T = US%s_to_T*dt - dt_pred = dt_in_T * CS%BE + dt_pred = dt * CS%BE h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 @@ -268,7 +265,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, endif ! diffu = horizontal viscosity terms (u,h) - call enable_averaging(dt,Time_local, CS%diag) + call enable_averages(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp) @@ -341,13 +338,13 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) - call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, US%T_to_s*dt_pred, G, GV, US, & + call enable_averages(dt, Time_local, CS%diag) + call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - call vertvisc(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, & + call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -355,7 +352,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -377,20 +374,20 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif -! call enable_averaging(dt,Time_local, CS%diag) ?????????????????????/ +! call enable_averages(dt, Time_local, CS%diag) ?????????????????????/ ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * (1.+CS%begw) * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * & + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * (1.+CS%begw) * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * & + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo @@ -412,7 +409,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, h_in, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -420,10 +417,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt_in_T*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt_in_T*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt*vh(i,J,k) enddo ; enddo enddo diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index a8c6f7bf1a..05f2cac00a 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -82,35 +82,36 @@ module MOM_forcing_type ! water mass fluxes into the ocean [kg m-2 s-1]; these fluxes impact the ocean mass real, pointer, dimension(:,:) :: & - evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [kg m-2 s-1] - lprec => NULL(), & !< precipitating liquid water into the ocean [kg m-2 s-1] - fprec => NULL(), & !< precipitating frozen water into the ocean [kg m-2 s-1] - vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [kg m-2 s-1] - lrunoff => NULL(), & !< liquid river runoff entering ocean [kg m-2 s-1] - frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [kg m-2 s-1] - seaice_melt => NULL(), & !< snow/seaice melt (positive) or formation (negative) [kg m-2 s-1] + evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1] + lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] + fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1] + vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1] + lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] + frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] + seaice_melt => NULL(), & !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] netMassIn => NULL(), & !< Sum of water mass flux out of the ocean [kg m-2 s-1] netMassOut => NULL(), & !< Net water mass flux into of the ocean [kg m-2 s-1] netSalt => NULL() !< Net salt entering the ocean [kgSalt m-2 s-1] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & - heat_content_cond => NULL(), & !< heat content associated with condensating water [W m-2] - heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip [W m-2] (diagnostic) - heat_content_icemelt => NULL(), & !< heat content associated with snow/seaice melt/formation [W/m^2] - heat_content_fprec => NULL(), & !< heat content associated with frozen precip [W m-2] - heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip [W m-2] - heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff [W m-2] - heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff [W m-2] - heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean [W m-2] - heat_content_massin => NULL() !< heat content associated with mass entering ocean [W m-2] + heat_content_cond => NULL(), & !< heat content associated with condensating water [J kg-1 R Z T-1 ~> W m-2] + heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip [J kg-1 R Z T-1 ~> W m-2] + heat_content_icemelt => NULL(), & !< heat content associated with snow and seaice + !! melt and formation [J kg-1 R Z T-1 ~> W m-2] + heat_content_fprec => NULL(), & !< heat content associated with frozen precip [J kg-1 R Z T-1 ~> W m-2] + heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip [J kg-1 R Z T-1 ~> W m-2] + heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff [J kg-1 R Z T-1 ~> W m-2] + heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff [J kg-1 R Z T-1 ~> W m-2] + heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean [J kg-1 R Z T-1 ~> W m-2] + heat_content_massin => NULL() !< heat content associated with mass entering ocean [J kg-1 R Z T-1 ~> W m-2] ! salt mass flux (contributes to ocean mass only if non-Bouss ) real, pointer, dimension(:,:) :: & - salt_flux => NULL(), & !< net salt flux into the ocean [kgSalt m-2 s-1] - salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler [kgSalt m-2 s-1] + salt_flux => NULL(), & !< net salt flux into the ocean [R Z T-1 ~> kgSalt m-2 s-1] + salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler [R Z T-1 ~> kgSalt m-2 s-1] salt_flux_added => NULL() !< additional salt flux from restoring or flux adjustment before adjustment - !! to net zero [kgSalt m-2 s-1] + !! to net zero [R Z T-1 ~> kgSalt m-2 s-1] ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() @@ -130,7 +131,7 @@ module MOM_forcing_type ! tide related inputs real, pointer, dimension(:,:) :: & - TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer [W m-2] + TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer [R Z3 T-3 ~> W m-2] ustar_tidal => NULL() !< tidal contribution to bottom ustar [Z T-1 ~> m s-1] ! iceberg related inputs @@ -150,12 +151,12 @@ module MOM_forcing_type !! or freezing (negative) [m year-1] ! Scalars set by surface forcing modules - real :: vPrecGlobalAdj !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] - real :: saltFluxGlobalAdj !< adjustment to restoring salt flux to zero out global net [kgSalt m-2 s-1] - real :: netFWGlobalAdj !< adjustment to net fresh water to zero out global net [kg m-2 s-1] - real :: vPrecGlobalScl !< scaling of restoring vprec to zero out global net ( -1..1 ) [nondim] - real :: saltFluxGlobalScl !< scaling of restoring salt flux to zero out global net ( -1..1 ) [nondim] - real :: netFWGlobalScl !< scaling of net fresh water to zero out global net ( -1..1 ) [nondim] + real :: vPrecGlobalAdj = 0. !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] + real :: saltFluxGlobalAdj = 0. !< adjustment to restoring salt flux to zero out global net [kgSalt m-2 s-1] + real :: netFWGlobalAdj = 0. !< adjustment to net fresh water to zero out global net [kg m-2 s-1] + real :: vPrecGlobalScl = 0. !< scaling of restoring vprec to zero out global net ( -1..1 ) [nondim] + real :: saltFluxGlobalScl = 0. !< scaling of restoring salt flux to zero out global net ( -1..1 ) [nondim] + real :: netFWGlobalScl = 0. !< scaling of net fresh water to zero out global net ( -1..1 ) [nondim] logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass !! fluxes have been applied to the ocean. @@ -185,8 +186,8 @@ module MOM_forcing_type type, public :: mech_forcing ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - taux => NULL(), & !< zonal wind stress [Pa] - tauy => NULL(), & !< meridional wind stress [Pa] + taux => NULL(), & !< zonal wind stress [R L Z T-2 ~> Pa] + tauy => NULL(), & !< meridional wind stress [R L Z T-2 ~> Pa] ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean [kg m-2 s-1]. @@ -336,20 +337,21 @@ module MOM_forcing_type !! for optimization purposes. The 2d (i,j) wrapper is the next subroutine below. !! This routine multiplies fluxes by dt, so that the result is an accumulation of fluxes !! over a time step. -subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & +subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & - h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & - aggregate_FW, nonpenSW, netmassInOut_rate,net_Heat_Rate, & + h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & + aggregate_FW, nonpenSW, netmassInOut_rate, net_Heat_Rate, & net_salt_rate, pen_sw_bnd_Rate, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible !! forcing fields. NULL unused fields. type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW integer, intent(in) :: j !< j-index to work on - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt_in_T !< The time step for these fluxes [T ~> s] real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content @@ -391,27 +393,31 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, !! Summed over SW bands when diagnosing nonpenSW. real, dimension(SZI_(G)), & optional, intent(out) :: net_Heat_rate !< Rate of net surface heating - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. real, dimension(SZI_(G)), & optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean - !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1]. + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]. real, dimension(SZI_(G)), & optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean - !! [H s-1 ~> m s-1 or kg m-2 s-1]. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth [H ~> m or kg m-2] real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW [degC H ~> degC m or degC kg m-2]. - real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) + real :: pen_sw_tot_rate(SZI_(G)) ! Summed rate of shortwave heating across bands + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real :: Ih_limit ! inverse depth at which surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth - real :: J_m2_to_H ! converts J/m^2 to H units (m for Bouss and kg/m^2 for non-Bouss) - real :: Irho0 ! 1.0 / Rho0 [m3 kg-1] + real :: W_m2_to_H_T ! converts W/m^2 to H degC T-1 [degC H T-1 W-2 m2 ~> degC m3 J-1 or degC kg J-1] + real :: RZ_T_to_W_m2_degC ! Converts mass fluxes to heat fluxes per degree temperature + ! change [W m-2 degC-1 T R-1 Z-1 ~> J kg degC] real :: I_Cp ! 1.0 / C_p [kg decC J-1] + real :: RZcp_to_H ! Unit convsersion factors divided by the heat capacity + ! [kg degC H R-1 Z-1 J-1 ~> degC m3 J-1 or kg degC J-1] logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays character(len=200) :: mesg integer :: is, ie, nz, i, k, n @@ -433,9 +439,11 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, !}BGR Ih_limit = 1.0 / FluxRescaleDepth - Irho0 = 1.0 / GV%Rho0 + RZ_T_to_W_m2_degC = fluxes%C_p*US%R_to_kg_m3*US%Z_to_m*US%s_to_T I_Cp = 1.0 / fluxes%C_p - J_m2_to_H = 1.0 / (GV%H_to_kg_m2 * fluxes%C_p) + W_m2_to_H_T = 1.0 / (US%s_to_T * GV%H_to_kg_m2 * fluxes%C_p) + + RZcP_to_H = 1.0 / (GV%H_to_RZ * fluxes%C_p) is = G%isc ; ie = G%iec ; nz = G%ke @@ -474,8 +482,8 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,k) ; enddo ; enddo if (nsw >= 1) then - call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) !, penSW_scale=J_m2_to_H*dt - if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) !, penSW_scale=J_m2_to_H + call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) !, penSW_scale=W_m2_to_H_T*dt_in_T + if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) !, penSW_scale=W_m2_to_H_T endif do i=is,ie @@ -488,7 +496,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, Pen_sw_tot(i) = 0.0 if (nsw >= 1) then do n=1,nsw - Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, Pen_SW_bnd(n,i)) + Pen_SW_bnd(n,i) = W_m2_to_H_T*scale*dt_in_T * max(0.0, Pen_SW_bnd(n,i)) Pen_sw_tot(i) = Pen_sw_tot(i) + Pen_SW_bnd(n,i) enddo else @@ -499,7 +507,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, pen_sw_tot_rate(i) = 0.0 if (nsw >= 1) then do n=1,nsw - Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, Pen_SW_bnd_rate(n,i)) + Pen_SW_bnd_rate(n,i) = W_m2_to_H_T*scale * max(0.0, Pen_SW_bnd_rate(n,i)) pen_sw_tot_rate(i) = pen_sw_tot_rate(i) + pen_sw_bnd_rate(n,i) enddo else @@ -508,16 +516,18 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, endif ! net volume/mass of liquid and solid passing through surface boundary fluxes - netMassInOut(i) = dt * (scale * (((((( fluxes%lprec(i,j) & + netMassInOut(i) = dt_in_T * (scale * & + (((((( fluxes%lprec(i,j) & + fluxes%fprec(i,j) ) & + fluxes%evap(i,j) ) & + fluxes%lrunoff(i,j) ) & + fluxes%vprec(i,j) ) & + fluxes%seaice_melt(i,j)) & - + fluxes%frunoff(i,j) )) + + fluxes%frunoff(i,j) )) - if (do_NMIOr) then ! Repeat the above code w/ dt=1s for legacy reasons - netMassInOut_rate(i) = (scale * (((((( fluxes%lprec(i,j) & + if (do_NMIOr) then ! Repeat the above code without multiplying by a timestep for legacy reasons + netMassInOut_rate(i) = (scale * & + (((((( fluxes%lprec(i,j) & + fluxes%fprec(i,j) ) & + fluxes%evap(i,j) ) & + fluxes%lrunoff(i,j) ) & @@ -532,8 +542,9 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! is added to the ocean, which may still need to be coded. Not that the units ! of netMassInOut are still kg_m2, so no conversion to H should occur yet. if (.not.GV%Boussinesq .and. associated(fluxes%salt_flux)) then - netMassInOut(i) = netMassInOut(i) + dt * (scale * fluxes%salt_flux(i,j)) - if (do_NMIOr) netMassInOut_rate(i) = netMassInOut_rate(i) + (scale * fluxes%salt_flux(i,j)) + netMassInOut(i) = netMassInOut(i) + dt_in_T * (scale * fluxes%salt_flux(i,j)) + if (do_NMIOr) netMassInOut_rate(i) = netMassInOut_rate(i) + & + (scale * fluxes%salt_flux(i,j)) endif ! net volume/mass of water leaving the ocean. @@ -543,73 +554,66 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! evap > 0 means condensating water is added into ocean. ! evap < 0 means evaporation of water from the ocean, in ! which case heat_content_evap is computed in MOM_diabatic_driver.F90 - if (fluxes%evap(i,j) < 0.0) then - netMassOut(i) = netMassOut(i) + fluxes%evap(i,j) + if (fluxes%evap(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%evap(i,j) ! if (associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA - endif ! lprec < 0 means sea ice formation taking water from the ocean. ! smg: we should split the ice melt/formation from the lprec - if (fluxes%lprec(i,j) < 0.0) then - netMassOut(i) = netMassOut(i) + fluxes%lprec(i,j) - endif + if (fluxes%lprec(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%lprec(i,j) ! seaice_melt < 0 means sea ice formation taking water from the ocean. - if (fluxes%seaice_melt(i,j) < 0.0) then - netMassOut(i) = netMassOut(i) + fluxes%seaice_melt(i,j) - endif + if (fluxes%seaice_melt(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%seaice_melt(i,j) ! vprec < 0 means virtual evaporation arising from surface salinity restoring, ! in which case heat_content_vprec is computed in MOM_diabatic_driver.F90. - if (fluxes%vprec(i,j) < 0.0) then - netMassOut(i) = netMassOut(i) + fluxes%vprec(i,j) - endif - netMassOut(i) = dt * scale * netMassOut(i) + if (fluxes%vprec(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%vprec(i,j) + + netMassOut(i) = dt_in_T * scale * netMassOut(i) ! convert to H units (Bouss=meter or non-Bouss=kg/m^2) - netMassInOut(i) = GV%kg_m2_to_H * netMassInOut(i) - if (do_NMIOr) netMassInOut_rate(i) = GV%kg_m2_to_H * netMassInOut_rate(i) - netMassOut(i) = GV%kg_m2_to_H * netMassOut(i) + netMassInOut(i) = GV%RZ_to_H * netMassInOut(i) + if (do_NMIOr) netMassInOut_rate(i) = GV%RZ_to_H * netMassInOut_rate(i) + netMassOut(i) = GV%RZ_to_H * netMassOut(i) ! surface heat fluxes from radiation and turbulent fluxes (K * H) ! (H=m for Bouss, H=kg/m2 for non-Bouss) ! CIME provides heat flux from snow&ice melt (seaice_melt_heat), so this is added below if (associated(fluxes%seaice_melt_heat)) then - net_heat(i) = scale * dt * J_m2_to_H * & + net_heat(i) = scale * dt_in_T * W_m2_to_H_T * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & fluxes%seaice_melt_heat(i,j)) ) !Repeats above code w/ dt=1. for legacy reason - if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & + if (do_NHR) net_heat_rate(i) = scale * W_m2_to_H_T * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & fluxes%seaice_melt_heat(i,j))) else - net_heat(i) = scale * dt * J_m2_to_H * & + net_heat(i) = scale * dt_in_T * W_m2_to_H_T * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) !Repeats above code w/ dt=1. for legacy reason - if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & + if (do_NHR) net_heat_rate(i) = scale * W_m2_to_H_T * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) endif ! Add heat flux from surface damping (restoring) (K * H) or flux adjustments. if (associated(fluxes%heat_added)) then - net_heat(i) = net_heat(i) + (scale * (dt * J_m2_to_H)) * fluxes%heat_added(i,j) - if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale * (J_m2_to_H)) * fluxes%heat_added(i,j) + net_heat(i) = net_heat(i) + (scale * (dt_in_T * W_m2_to_H_T)) * fluxes%heat_added(i,j) + if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale * (W_m2_to_H_T)) * fluxes%heat_added(i,j) endif ! Add explicit heat flux for runoff (which is part of the ice-ocean boundary ! flux type). Runoff is otherwise added with a temperature of SST. if (useRiverHeatContent) then ! remove lrunoff*SST here, to counteract its addition elsewhere - net_heat(i) = (net_heat(i) + (scale*(dt*J_m2_to_H)) * fluxes%heat_content_lrunoff(i,j)) - & - (GV%kg_m2_to_H * (scale * dt)) * fluxes%lrunoff(i,j) * T(i,1) + net_heat(i) = (net_heat(i) + (scale*(dt_in_T * RZcP_to_H)) * fluxes%heat_content_lrunoff(i,j)) - & + (GV%RZ_to_H * (scale * dt_in_T)) * fluxes%lrunoff(i,j) * T(i,1) !BGR-Jul 5, 2017{ !Intentionally neglect the following contribution to rate for legacy reasons. - !if (do_NHR) net_heat_rate(i) = (net_heat_rate(i) + (scale*(J_m2_to_H)) * fluxes%heat_content_lrunoff(i,j)) - & - ! (GV%kg_m2_to_H * (scale)) * fluxes%lrunoff(i,j) * T(i,1) + !if (do_NHR) net_heat_rate(i) = (net_heat_rate(i) + (scale*RZcP_to_H) * fluxes%heat_content_lrunoff(i,j)) - & + ! (GV%RZ_to_H * (scale)) * fluxes%lrunoff(i,j) * T(i,1) !}BGR if (calculate_diags .and. associated(tv%TempxPmE)) then - tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & + tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt_in_T) * & (I_Cp*fluxes%heat_content_lrunoff(i,j) - fluxes%lrunoff(i,j)*T(i,1)) endif endif @@ -618,15 +622,15 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! flux type). Calving is otherwise added with a temperature of SST. if (useCalvingHeatContent) then ! remove frunoff*SST here, to counteract its addition elsewhere - net_heat(i) = net_heat(i) + (scale*(dt*J_m2_to_H)) * fluxes%heat_content_frunoff(i,j) - & - (GV%kg_m2_to_H * (scale * dt)) * fluxes%frunoff(i,j) * T(i,1) + net_heat(i) = net_heat(i) + (scale*(dt_in_T * RZcP_to_H)) * fluxes%heat_content_frunoff(i,j) - & + (GV%RZ_to_H * (scale * dt_in_T)) * fluxes%frunoff(i,j) * T(i,1) !BGR-Jul 5, 2017{ !Intentionally neglect the following contribution to rate for legacy reasons. -! if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale*(J_m2_to_H)) * fluxes%heat_content_frunoff(i,j) - & -! (GV%kg_m2_to_H * (scale)) * fluxes%frunoff(i,j) * T(i,1) +! if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale*RZcP_to_H) * fluxes%heat_content_frunoff(i,j) - & +! (GV%RZ_to_H * scale) * fluxes%frunoff(i,j) * T(i,1) !}BGR if (calculate_diags .and. associated(tv%TempxPmE)) then - tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & + tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt_in_T) * & (I_Cp*fluxes%heat_content_frunoff(i,j) - fluxes%frunoff(i,j)*T(i,1)) endif endif @@ -641,19 +645,19 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! When evap, lprec, or vprec > 0, then we know their heat content here ! via settings from inside of the appropriate config_src driver files. ! if (associated(fluxes%heat_content_lprec)) then -! net_heat(i) = net_heat(i) + scale * dt * J_m2_to_H * & +! net_heat(i) = net_heat(i) + scale * dt_in_T * RZcP_to_H * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) + & ! (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) + & ! (fluxes%heat_content_cond(i,j) + fluxes%heat_content_vprec(i,j)))))) ! endif if (fluxes%num_msg < fluxes%max_msg) then - if (Pen_SW_tot(i) > 1.000001*J_m2_to_H*scale*dt*fluxes%sw(i,j)) then + if (Pen_SW_tot(i) > 1.000001 * W_m2_to_H_T*scale*dt_in_T*fluxes%sw(i,j)) then fluxes%num_msg = fluxes%num_msg + 1 write(mesg,'("Penetrating shortwave of ",1pe17.10, & &" exceeds total shortwave of ",1pe17.10,& &" at ",1pg11.4,"E, "1pg11.4,"N.")') & - Pen_SW_tot(i),J_m2_to_H*scale*dt*fluxes%sw(i,j),& + Pen_SW_tot(i),W_m2_to_H_T*scale*dt_in_T * fluxes%sw(i,j),& G%geoLonT(i,j),G%geoLatT(i,j) call MOM_error(WARNING,mesg) endif @@ -667,7 +671,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! diagnose non-downwelling SW if (present(nonPenSW)) then - nonPenSW(i) = scale * dt * J_m2_to_H * fluxes%sw(i,j) - Pen_SW_tot(i) + nonPenSW(i) = scale * dt_in_T * W_m2_to_H_T * fluxes%sw(i,j) - Pen_SW_tot(i) endif ! Salt fluxes @@ -677,9 +681,9 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Boussinesq: (ppt * m) ! non-Bouss: (g/m^2) if (associated(fluxes%salt_flux)) then - Net_salt(i) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%kg_m2_to_H + Net_salt(i) = (scale * dt_in_T * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H !Repeat above code for 'rate' term - if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0 * fluxes%salt_flux(i,j))) * GV%kg_m2_to_H + if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H endif ! Diagnostics follow... @@ -687,7 +691,8 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Store Net_salt for unknown reason? if (associated(fluxes%salt_flux)) then - if (calculate_diags) fluxes%netSalt(i,j) = Net_salt(i) + ! This seems like a bad idea to me. -RWH + if (calculate_diags) fluxes%netSalt(i,j) = US%kg_m3_to_R*US%m_to_Z*US%T_to_s*Net_salt(i) endif ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or @@ -695,10 +700,10 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (associated(fluxes%heat_content_massin)) then if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt_in_T else ! net is "out" fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & - T(i,1) * GV%H_to_kg_m2 / dt + T(i,1) * GV%H_to_RZ / dt_in_T endif else fluxes%heat_content_massin(i,j) = 0. @@ -710,10 +715,10 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (associated(fluxes%heat_content_massout)) then if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt_in_T else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & - T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_RZ / dt_in_T endif else fluxes%heat_content_massout(i,j) = 0.0 @@ -804,17 +809,18 @@ end subroutine extractFluxes1d !> 2d wrapper for 1d extract fluxes from surface fluxes type. !! This subroutine extracts fluxes from the surface fluxes type. It multiplies the !! fluxes by dt, so that the result is an accumulation of the fluxes over a time step. -subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & +subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, & useRiverHeatContent, useCalvingHeatContent, h, T, & netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & aggregate_FW) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt_in_T !< The time step for these fluxes [T ~> s] real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content @@ -849,12 +855,12 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j -!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,FluxRescaleDepth, & +!$OMP parallel do default(none) shared(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, & !$OMP useRiverHeatContent, useCalvingHeatContent, & !$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, & !$OMP aggregate_FW) do j=G%jsc, G%jec - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent,& h(:,j,:), T(:,j,:), netMassInOut(:,j), netMassOut(:,j), & net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW) @@ -898,8 +904,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band ! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G)) :: pressure ! pressurea the surface [Pa] - real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [kg m-3 degC-1] - real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [kg m-3 ppt-1] + real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R degC-1 ~> kg m-3 degC-1] + real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R ppt-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G),SZK_(G)+1) :: netPen ! The net penetrating shortwave radiation at each level ! [degC H ~> degC m or degC kg m-2] @@ -907,7 +913,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt logical :: useCalvingHeatContent real :: depthBeforeScalingFluxes ! A depth scale [H ~> m or kg m-2] real :: GoRho ! The gravitational acceleration divided by mean density times some - ! unit conversion factors [L2 m3 H-1 s kg-1 T-3 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + ! unit conversion factors [L2 H-1 s R-1 T-3 ~> m4 kg-1 s-2 or m7 kg-2 s-2] real :: H_limit_fluxes ! Another depth scale [H ~> m or kg m-2] ! smg: what do we do when have heat fluxes from calving and river? @@ -916,7 +922,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = (GV%g_Earth*US%m_to_Z * GV%H_to_m*US%T_to_s) / GV%Rho0 + GoRho = (GV%g_Earth * GV%H_to_Z*US%T_to_s) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc @@ -929,7 +935,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! netSalt = salt via surface fluxes [ppt H s-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux ! this call returns the rate because dt=1 - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt*US%s_to_T, & depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & netSalt, penSWbnd, tv, .false., skip_diags=skip_diags) @@ -941,7 +947,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! Density derivatives call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, & - dRhodT, dRhodS, start, npts, tv%eqn_of_state) + dRhodT, dRhodS, start, npts, tv%eqn_of_state, scale=US%kg_m3_to_R) ! Adjust netSalt to reflect dilution effect of FW flux netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! ppt H/s @@ -1008,10 +1014,12 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< shift in halo + real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] integer :: is, ie, js, je, nz, hshift is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - hshift=1; if (present(haloshift)) hshift=haloshift + hshift = 1 ; if (present(haloshift)) hshift = haloshift + RZ_T_conversion = US%R_to_kg_m3*US%Z_to_m*US%s_to_T ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie @@ -1043,43 +1051,51 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%sens)) & call hchksum(fluxes%sens, mesg//" fluxes%sens",G%HI,haloshift=hshift) if (associated(fluxes%evap)) & - call hchksum(fluxes%evap, mesg//" fluxes%evap",G%HI,haloshift=hshift) + call hchksum(fluxes%evap, mesg//" fluxes%evap",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%lprec)) & - call hchksum(fluxes%lprec, mesg//" fluxes%lprec",G%HI,haloshift=hshift) + call hchksum(fluxes%lprec, mesg//" fluxes%lprec",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%fprec)) & - call hchksum(fluxes%fprec, mesg//" fluxes%fprec",G%HI,haloshift=hshift) + call hchksum(fluxes%fprec, mesg//" fluxes%fprec",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%vprec)) & - call hchksum(fluxes%vprec, mesg//" fluxes%vprec",G%HI,haloshift=hshift) + call hchksum(fluxes%vprec, mesg//" fluxes%vprec",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%seaice_melt)) & - call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",G%HI,haloshift=hshift) + call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%seaice_melt_heat)) & call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat",G%HI,haloshift=hshift) if (associated(fluxes%p_surf)) & call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",G%HI,haloshift=hshift) if (associated(fluxes%salt_flux)) & - call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux",G%HI,haloshift=hshift) + call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%TKE_tidal)) & - call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal",G%HI,haloshift=hshift) + call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal",G%HI,haloshift=hshift, & + scale=US%R_to_kg_m3**3*US%Z_to_m**3*US%s_to_T) if (associated(fluxes%ustar_tidal)) & call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%lrunoff)) & - call hchksum(fluxes%lrunoff, mesg//" fluxes%lrunoff",G%HI,haloshift=hshift) + call hchksum(fluxes%lrunoff, mesg//" fluxes%lrunoff",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%frunoff)) & - call hchksum(fluxes%frunoff, mesg//" fluxes%frunoff",G%HI,haloshift=hshift) + call hchksum(fluxes%frunoff, mesg//" fluxes%frunoff",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_lrunoff)) & - call hchksum(fluxes%heat_content_lrunoff, mesg//" fluxes%heat_content_lrunoff",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_lrunoff, mesg//" fluxes%heat_content_lrunoff", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_frunoff)) & - call hchksum(fluxes%heat_content_frunoff, mesg//" fluxes%heat_content_frunoff",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_frunoff, mesg//" fluxes%heat_content_frunoff", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_lprec)) & - call hchksum(fluxes%heat_content_lprec, mesg//" fluxes%heat_content_lprec",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_lprec, mesg//" fluxes%heat_content_lprec", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_fprec)) & - call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_icemelt)) & - call hchksum(fluxes%heat_content_icemelt, mesg//" fluxes%heat_content_icemelt",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_icemelt, mesg//" fluxes%heat_content_icemelt", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_cond)) & - call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_massout)) & - call hchksum(fluxes%heat_content_massout, mesg//" fluxes%heat_content_massout",G%HI,haloshift=hshift) + call hchksum(fluxes%heat_content_massout, mesg//" fluxes%heat_content_massout", G%HI, & + haloshift=hshift, scale=RZ_T_conversion) end subroutine MOM_forcing_chksum !> Write out chksums for the driving mechanical forces. @@ -1100,7 +1116,7 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) ! and js...je as their extent. if (associated(forces%taux) .and. associated(forces%tauy)) & call uvchksum(mesg//" forces%tau[xy]", forces%taux, forces%tauy, G%HI, & - haloshift=hshift, symmetric=.true.) + haloshift=hshift, symmetric=.true., scale=US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) if (associated(forces%ustar)) & @@ -1213,13 +1229,15 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, Time, & - 'Zonal surface stress from ocean interactions with atmos and ice', 'Pa', & + 'Zonal surface stress from ocean interactions with atmos and ice', & + 'Pa', conversion=US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L, & standard_name='surface_downward_x_stress', cmor_field_name='tauuo', & cmor_units='N m-2', cmor_long_name='Surface Downward X Stress', & cmor_standard_name='surface_downward_x_stress') handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & - 'Meridional surface stress ocean interactions with atmos and ice', 'Pa', & + 'Meridional surface stress ocean interactions with atmos and ice', & + 'Pa', conversion=US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L, & standard_name='surface_downward_y_stress', cmor_field_name='tauvo', & cmor_units='N m-2', cmor_long_name='Surface Downward Y Stress', & cmor_standard_name='surface_downward_y_stress') @@ -1253,7 +1271,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, cmor_standard_name='sea_water_pressure_at_sea_water_surface') handles%id_TKE_tidal = register_diag_field('ocean_model', 'TKE_tidal', diag%axesT1, Time, & - 'Tidal source of BBL mixing', 'W m-2') + 'Tidal source of BBL mixing', 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) if (.not. use_temperature) then handles%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, Time, & @@ -1289,18 +1307,21 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1') handles%id_fprec = register_diag_field('ocean_model', 'fprec', diag%axesT1, Time, & - 'Frozen precipitation into ocean', 'kg m-2 s-1', & + 'Frozen precipitation into ocean', & + units='kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & standard_name='snowfall_flux', cmor_field_name='prsn', & cmor_standard_name='snowfall_flux', cmor_long_name='Snowfall Flux where Ice Free Ocean over Sea') handles%id_lprec = register_diag_field('ocean_model', 'lprec', diag%axesT1, Time, & - 'Liquid precipitation into ocean', 'kg m-2 s-1', & + 'Liquid precipitation into ocean', & + units='kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & standard_name='rainfall_flux', & cmor_field_name='prlq', cmor_standard_name='rainfall_flux', & cmor_long_name='Rainfall Flux where Ice Free Ocean over Sea') handles%id_vprec = register_diag_field('ocean_model', 'vprec', diag%axesT1, Time, & - 'Virtual liquid precip into ocean due to SSS restoring', 'kg m-2 s-1') + 'Virtual liquid precip into ocean due to SSS restoring', & + units='kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_frunoff = register_diag_field('ocean_model', 'frunoff', diag%axesT1, Time, & 'Frozen runoff (calving) and iceberg melt into ocean', 'kg m-2 s-1', & @@ -1430,58 +1451,62 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, !=============================================================== ! surface heat flux maps - handles%id_heat_content_frunoff = register_diag_field('ocean_model', 'heat_content_frunoff', & - diag%axesT1, Time, 'Heat content (relative to 0C) of solid runoff into ocean', 'W m-2', & + handles%id_heat_content_frunoff = register_diag_field('ocean_model', 'heat_content_frunoff', & + diag%axesT1, Time, 'Heat content (relative to 0C) of solid runoff into ocean', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & standard_name='temperature_flux_due_to_solid_runoff_expressed_as_heat_flux_into_sea_water') - handles%id_heat_content_lrunoff = register_diag_field('ocean_model', 'heat_content_lrunoff', & - diag%axesT1, Time, 'Heat content (relative to 0C) of liquid runoff into ocean', 'W m-2', & + handles%id_heat_content_lrunoff = register_diag_field('ocean_model', 'heat_content_lrunoff', & + diag%axesT1, Time, 'Heat content (relative to 0C) of liquid runoff into ocean', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water') handles%id_hfrunoffds = register_diag_field('ocean_model', 'hfrunoffds', & - diag%axesT1, Time, 'Heat content (relative to 0C) of liquid+solid runoff into ocean', 'W m-2',& + diag%axesT1, Time, 'Heat content (relative to 0C) of liquid+solid runoff into ocean', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water') handles%id_heat_content_lprec = register_diag_field('ocean_model', 'heat_content_lprec', & diag%axesT1,Time,'Heat content (relative to 0degC) of liquid precip entering ocean', & - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_heat_content_fprec = register_diag_field('ocean_model', 'heat_content_fprec',& diag%axesT1,Time,'Heat content (relative to 0degC) of frozen prec entering ocean',& - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_heat_content_icemelt = register_diag_field('ocean_model', 'heat_content_icemelt',& diag%axesT1,Time,'Heat content (relative to 0degC) of water flux due to sea ice melting/freezing',& - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_heat_content_vprec = register_diag_field('ocean_model', 'heat_content_vprec', & diag%axesT1,Time,'Heat content (relative to 0degC) of virtual precip entering ocean',& - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_heat_content_cond = register_diag_field('ocean_model', 'heat_content_cond', & diag%axesT1,Time,'Heat content (relative to 0degC) of water condensing into ocean',& - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_hfrainds = register_diag_field('ocean_model', 'hfrainds', & diag%axesT1,Time,'Heat content (relative to 0degC) of liquid+frozen precip entering ocean', & - 'W m-2',standard_name='temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water',& + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + standard_name='temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water',& cmor_long_name='Heat Content (relative to 0degC) of Liquid + Frozen Precipitation') handles%id_heat_content_surfwater = register_diag_field('ocean_model', 'heat_content_surfwater',& diag%axesT1, Time, & 'Heat content (relative to 0degC) of net water crossing ocean surface (frozen+liquid)', & - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_heat_content_massout = register_diag_field('ocean_model', 'heat_content_massout', & diag%axesT1, Time,'Heat content (relative to 0degC) of net mass leaving ocean ocean via evap and ice form',& - 'W m-2', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & cmor_field_name='hfevapds', & cmor_standard_name='temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water', & cmor_long_name='Heat Content (relative to 0degC) of Water Leaving Ocean via Evaporation and Ice Formation') handles%id_heat_content_massin = register_diag_field('ocean_model', 'heat_content_massin', & diag%axesT1, Time,'Heat content (relative to 0degC) of net mass entering ocean ocean',& - 'W m-2') + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_net_heat_coupler = register_diag_field('ocean_model', 'net_heat_coupler', & diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',& @@ -1778,21 +1803,22 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_saltflux = register_diag_field('ocean_model', 'salt_flux', diag%axesT1, Time,& 'Net salt flux into ocean at surface (restoring + sea-ice)', & - 'kg m-2 s-1',cmor_field_name='sfdsi', & - cmor_standard_name='downward_sea_ice_basal_salt_flux', & + units='kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + cmor_field_name='sfdsi', cmor_standard_name='downward_sea_ice_basal_salt_flux', & cmor_long_name='Downward Sea Ice Basal Salt Flux') handles%id_saltFluxIn = register_diag_field('ocean_model', 'salt_flux_in', diag%axesT1, Time, & - 'Salt flux into ocean at surface from coupler', 'kg m-2 s-1') + 'Salt flux into ocean at surface from coupler', & + units='kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_saltFluxAdded = register_diag_field('ocean_model', 'salt_flux_added', & diag%axesT1,Time,'Salt flux into ocean at surface due to restoring or flux adjustment', & - 'kg m-2 s-1') + units='kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_saltFluxGlobalAdj = register_scalar_field('ocean_model', & 'salt_flux_global_restoring_adjustment', Time, diag, & 'Adjustment needed to balance net global salt flux into ocean at surface', & - 'kg m-2 s-1') + units='kg m-2 s-1') !, conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) handles%id_vPrecGlobalAdj = register_scalar_field('ocean_model', & 'vprec_global_adjustment', Time, diag, & @@ -2048,7 +2074,6 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) end subroutine copy_common_forcing_fields - !> This subroutine calculates certain derived forcing fields based on information !! from a mech_forcing type and stores them in a (thermodynamic) forcing type. subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) @@ -2056,15 +2081,15 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< grid type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: Rho0 !< A reference density of seawater [kg m-3], + real, intent(in) :: Rho0 !< A reference density of seawater [R ~> kg m-3], !! as used to calculate ustar. - real :: taux2, tauy2 ! Squared wind stress components [Pa2]. - real :: Irho0 ! Inverse of the mean density rescaled to [Z2 m / kg ~> m3 kg-1] + real :: taux2, tauy2 ! Squared wind stress components [R2 L2 Z2 T-4 ~> Pa2]. + real :: Irho0 ! Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Irho0 = US%m_to_Z**2 / Rho0 + Irho0 = US%L_to_Z / Rho0 if (associated(forces%taux) .and. associated(forces%tauy) .and. & associated(fluxes%ustar_gustless)) then @@ -2080,8 +2105,8 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) G%mask2dCv(i,J) * forces%tauy(i,J)**2) / & (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - fluxes%ustar_gustless(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(taux2 + tauy2) / Rho0) -!### Change to: + fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0) +!### For efficiency this could be changed to: ! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo endif @@ -2091,48 +2116,53 @@ end subroutine set_derived_forcing_fields !> This subroutine determines the net mass source to the ocean from !! a (thermodynamic) forcing type and stores it in a mech_forcing type. -subroutine set_net_mass_forcing(fluxes, forces, G) +subroutine set_net_mass_forcing(fluxes, forces, G, US) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_grid_type), intent(in) :: G !< The ocean grid type if (associated(forces%net_mass_src)) & - call get_net_mass_forcing(fluxes, G, forces%net_mass_src) + call get_net_mass_forcing(fluxes, G, US, forces%net_mass_src) end subroutine set_net_mass_forcing !> This subroutine calculates determines the net mass source to the ocean from !! a (thermodynamic) forcing type and stores it in a provided array. -subroutine get_net_mass_forcing(fluxes, G, net_mass_src) +subroutine get_net_mass_forcing(fluxes, G, US, net_mass_src) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< The ocean grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean !! [kg m-2 s-1]. + real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + RZ_T_conversion = US%R_to_kg_m3*US%Z_to_m*US%s_to_T + net_mass_src(:,:) = 0.0 if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%lprec(i,j) enddo ; enddo ; endif if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%fprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%fprec(i,j) enddo ; enddo ; endif if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%vprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%vprec(i,j) enddo ; enddo ; endif if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lrunoff(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%lrunoff(i,j) enddo ; enddo ; endif if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%frunoff(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%frunoff(i,j) enddo ; enddo ; endif if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%evap(i,j) enddo ; enddo ; endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%seaice_melt(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) enddo ; enddo ; endif end subroutine get_net_mass_forcing @@ -2192,12 +2222,13 @@ end subroutine mech_forcing_diags !> Offer buoyancy forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. -subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) +subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, US, diag, handles) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. real, intent(in) :: dt !< time step type(ocean_grid_type), intent(in) :: G !< grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), intent(in) :: diag !< diagnostic regulator type(forcing_diags), intent(inout) :: handles !< diagnostic ids @@ -2206,6 +2237,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) real :: total_transport ! for diagnosing integrated boundary transport real :: ave_flux ! for diagnosing averaged boundary flux real :: C_p ! seawater heat capacity (J/(deg K * kg)) + real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] real :: I_dt ! inverse time step real :: ppt2mks ! conversion between ppt and mks integer :: i,j,is,ie,js,je @@ -2213,6 +2245,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call cpu_clock_begin(handles%id_clock_forcing) C_p = fluxes%C_p + RZ_T_conversion = US%R_to_kg_m3*US%Z_to_m*US%s_to_T I_dt = 1.0/dt ppt2mks = 1e-3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2224,18 +2257,18 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_prcme > 0 .or. handles%id_total_prcme > 0 .or. handles%id_prcme_ga > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%lprec)) res(i,j) = res(i,j)+fluxes%lprec(i,j) - if (associated(fluxes%fprec)) res(i,j) = res(i,j)+fluxes%fprec(i,j) + if (associated(fluxes%lprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) + if (associated(fluxes%fprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%fprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if (associated(fluxes%evap)) res(i,j) = res(i,j)+fluxes%evap(i,j) - if (associated(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) - if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) - if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) - if (associated(fluxes%seaice_melt)) res(i,j) = res(i,j)+fluxes%seaice_melt(i,j) + if (associated(fluxes%evap)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) + if (associated(fluxes%lrunoff)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lrunoff(i,j) + if (associated(fluxes%frunoff)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%frunoff(i,j) + if (associated(fluxes%vprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) + if (associated(fluxes%seaice_melt)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) enddo ; enddo if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then - total_transport = global_area_integral(res,G) + total_transport = global_area_integral(res, G) call post_data(handles%id_total_prcme, total_transport, diag) endif if (handles%id_prcme_ga > 0) then @@ -2248,17 +2281,17 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%lprec)) then - if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) endif if (associated(fluxes%vprec)) then - if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) endif if (associated(fluxes%evap)) then - if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) endif if (associated(fluxes%seaice_melt)) then if (fluxes%seaice_melt(i,j) < 0.0) & - res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) endif enddo ; enddo if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) @@ -2276,25 +2309,25 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) res(i,j) = 0.0 if (associated(fluxes%fprec)) & - res(i,j) = res(i,j) + fluxes%fprec(i,j) + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%fprec(i,j) if (associated(fluxes%lrunoff)) & - res(i,j) = res(i,j) + fluxes%lrunoff(i,j) + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lrunoff(i,j) if (associated(fluxes%frunoff)) & - res(i,j) = res(i,j) + fluxes%frunoff(i,j) + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%frunoff(i,j) if (associated(fluxes%lprec)) then - if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) endif if (associated(fluxes%vprec)) then - if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) endif ! fluxes%cond is not needed because it is derived from %evap > 0 if (associated(fluxes%evap)) then - if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) endif if (associated(fluxes%seaice_melt)) then if (fluxes%seaice_melt(i,j) > 0.0) & - res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) endif enddo ; enddo if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) @@ -2310,17 +2343,17 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_evap > 0) .and. associated(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) if ((handles%id_total_evap > 0) .and. associated(fluxes%evap)) then - total_transport = global_area_integral(fluxes%evap,G) + total_transport = global_area_integral(fluxes%evap, G, scale=RZ_T_conversion) call post_data(handles%id_total_evap, total_transport, diag) endif if ((handles%id_evap_ga > 0) .and. associated(fluxes%evap)) then - ave_flux = global_area_mean(fluxes%evap,G) + ave_flux = global_area_mean(fluxes%evap, G, scale=RZ_T_conversion) call post_data(handles%id_evap_ga, ave_flux, diag) endif if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - res(i,j) = fluxes%lprec(i,j) + fluxes%fprec(i,j) + res(i,j) = RZ_T_conversion* (fluxes%lprec(i,j) + fluxes%fprec(i,j)) enddo ; enddo if (handles%id_precip > 0) call post_data(handles%id_precip, res, diag) if (handles%id_total_precip > 0) then @@ -2336,11 +2369,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%lprec)) then if (handles%id_lprec > 0) call post_data(handles%id_lprec, fluxes%lprec, diag) if (handles%id_total_lprec > 0) then - total_transport = global_area_integral(fluxes%lprec,G) + total_transport = global_area_integral(fluxes%lprec, G, scale=RZ_T_conversion) call post_data(handles%id_total_lprec, total_transport, diag) endif if (handles%id_lprec_ga > 0) then - ave_flux = global_area_mean(fluxes%lprec,G) + ave_flux = global_area_mean(fluxes%lprec, G, scale=RZ_T_conversion) call post_data(handles%id_lprec_ga, ave_flux, diag) endif endif @@ -2348,11 +2381,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%fprec)) then if (handles%id_fprec > 0) call post_data(handles%id_fprec, fluxes%fprec, diag) if (handles%id_total_fprec > 0) then - total_transport = global_area_integral(fluxes%fprec,G) + total_transport = global_area_integral(fluxes%fprec ,G, scale=RZ_T_conversion) call post_data(handles%id_total_fprec, total_transport, diag) endif if (handles%id_fprec_ga > 0) then - ave_flux = global_area_mean(fluxes%fprec,G) + ave_flux = global_area_mean(fluxes%fprec, G, scale=RZ_T_conversion) call post_data(handles%id_fprec_ga, ave_flux, diag) endif endif @@ -2360,11 +2393,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%vprec)) then if (handles%id_vprec > 0) call post_data(handles%id_vprec, fluxes%vprec, diag) if (handles%id_total_vprec > 0) then - total_transport = global_area_integral(fluxes%vprec,G) + total_transport = global_area_integral(fluxes%vprec, G, scale=RZ_T_conversion) call post_data(handles%id_total_vprec, total_transport, diag) endif if (handles%id_vprec_ga > 0) then - ave_flux = global_area_mean(fluxes%vprec,G) + ave_flux = global_area_mean(fluxes%vprec, G, scale=RZ_T_conversion) call post_data(handles%id_vprec_ga, ave_flux, diag) endif endif @@ -2372,7 +2405,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%lrunoff)) then if (handles%id_lrunoff > 0) call post_data(handles%id_lrunoff, fluxes%lrunoff, diag) if (handles%id_total_lrunoff > 0) then - total_transport = global_area_integral(fluxes%lrunoff,G) + total_transport = global_area_integral(fluxes%lrunoff, G, scale=RZ_T_conversion) call post_data(handles%id_total_lrunoff, total_transport, diag) endif endif @@ -2380,7 +2413,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%frunoff)) then if (handles%id_frunoff > 0) call post_data(handles%id_frunoff, fluxes%frunoff, diag) if (handles%id_total_frunoff > 0) then - total_transport = global_area_integral(fluxes%frunoff,G) + total_transport = global_area_integral(fluxes%frunoff, G, scale=RZ_T_conversion) call post_data(handles%id_total_frunoff, total_transport, diag) endif endif @@ -2388,7 +2421,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%seaice_melt)) then if (handles%id_seaice_melt > 0) call post_data(handles%id_seaice_melt, fluxes%seaice_melt, diag) if (handles%id_total_seaice_melt > 0) then - total_transport = global_area_integral(fluxes%seaice_melt,G) + total_transport = global_area_integral(fluxes%seaice_melt, G, scale=RZ_T_conversion) call post_data(handles%id_total_seaice_melt, total_transport, diag) endif endif @@ -2398,63 +2431,63 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) & call post_data(handles%id_heat_content_lrunoff, fluxes%heat_content_lrunoff, diag) if ((handles%id_total_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) then - total_transport = global_area_integral(fluxes%heat_content_lrunoff,G) + total_transport = global_area_integral(fluxes%heat_content_lrunoff, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_lrunoff, total_transport, diag) endif if ((handles%id_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) & call post_data(handles%id_heat_content_frunoff, fluxes%heat_content_frunoff, diag) if ((handles%id_total_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) then - total_transport = global_area_integral(fluxes%heat_content_frunoff,G) + total_transport = global_area_integral(fluxes%heat_content_frunoff, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_frunoff, total_transport, diag) endif if ((handles%id_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) & call post_data(handles%id_heat_content_lprec, fluxes%heat_content_lprec, diag) if ((handles%id_total_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) then - total_transport = global_area_integral(fluxes%heat_content_lprec,G) + total_transport = global_area_integral(fluxes%heat_content_lprec, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_lprec, total_transport, diag) endif if ((handles%id_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) & call post_data(handles%id_heat_content_fprec, fluxes%heat_content_fprec, diag) if ((handles%id_total_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) then - total_transport = global_area_integral(fluxes%heat_content_fprec,G) + total_transport = global_area_integral(fluxes%heat_content_fprec, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_fprec, total_transport, diag) endif if ((handles%id_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) & call post_data(handles%id_heat_content_icemelt, fluxes%heat_content_icemelt, diag) if ((handles%id_total_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) then - total_transport = global_area_integral(fluxes%heat_content_icemelt,G) + total_transport = global_area_integral(fluxes%heat_content_icemelt, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_icemelt, total_transport, diag) endif if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) & call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag) if ((handles%id_total_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) then - total_transport = global_area_integral(fluxes%heat_content_vprec,G) + total_transport = global_area_integral(fluxes%heat_content_vprec, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_vprec, total_transport, diag) endif if ((handles%id_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) & call post_data(handles%id_heat_content_cond, fluxes%heat_content_cond, diag) if ((handles%id_total_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) then - total_transport = global_area_integral(fluxes%heat_content_cond,G) + total_transport = global_area_integral(fluxes%heat_content_cond, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_cond, total_transport, diag) endif if ((handles%id_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) & call post_data(handles%id_heat_content_massout, fluxes%heat_content_massout, diag) if ((handles%id_total_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) then - total_transport = global_area_integral(fluxes%heat_content_massout,G) + total_transport = global_area_integral(fluxes%heat_content_massout,G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_massout, total_transport, diag) endif if ((handles%id_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) & call post_data(handles%id_heat_content_massin, fluxes%heat_content_massin, diag) if ((handles%id_total_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) then - total_transport = global_area_integral(fluxes%heat_content_massin,G) + total_transport = global_area_integral(fluxes%heat_content_massin, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif @@ -2492,25 +2525,33 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) !if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt !else - if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) - if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + if (associated(fluxes%heat_content_lrunoff)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_icemelt)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_icemelt(i,j) + if (associated(fluxes%heat_content_vprec)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_massout)) & + res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_massout(i,j) !endif - if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) + if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo if (handles%id_net_heat_surface > 0) call post_data(handles%id_net_heat_surface, res, diag) if (handles%id_total_net_heat_surface > 0) then - total_transport = global_area_integral(res,G) + total_transport = global_area_integral(res, G) call post_data(handles%id_total_net_heat_surface, total_transport, diag) endif if (handles%id_net_heat_surface_ga > 0) then - ave_flux = global_area_mean(res,G) + ave_flux = global_area_mean(res, G) call post_data(handles%id_net_heat_surface_ga, ave_flux, diag) endif endif @@ -2533,7 +2574,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) enddo ; enddo if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag) if (handles%id_total_heat_content_surfwater > 0) then - total_transport = global_area_integral(res,G) + total_transport = global_area_integral(res, G, scale=RZ_T_conversion) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) endif endif @@ -2690,21 +2731,21 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_saltflux > 0) .and. associated(fluxes%salt_flux)) & call post_data(handles%id_saltflux, fluxes%salt_flux, diag) if ((handles%id_total_saltflux > 0) .and. associated(fluxes%salt_flux)) then - total_transport = ppt2mks*global_area_integral(fluxes%salt_flux,G) + total_transport = ppt2mks*global_area_integral(fluxes%salt_flux, G, scale=RZ_T_conversion) call post_data(handles%id_total_saltflux, total_transport, diag) endif if ((handles%id_saltFluxAdded > 0) .and. associated(fluxes%salt_flux_added)) & call post_data(handles%id_saltFluxAdded, fluxes%salt_flux_added, diag) if ((handles%id_total_saltFluxAdded > 0) .and. associated(fluxes%salt_flux_added)) then - total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_added,G) + total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_added, G, scale=RZ_T_conversion) call post_data(handles%id_total_saltFluxAdded, total_transport, diag) endif if (handles%id_saltFluxIn > 0 .and. associated(fluxes%salt_flux_in)) & call post_data(handles%id_saltFluxIn, fluxes%salt_flux_in, diag) if ((handles%id_total_saltFluxIn > 0) .and. associated(fluxes%salt_flux_in)) then - total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_in,G) + total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_in, G, scale=RZ_T_conversion) call post_data(handles%id_total_saltFluxIn, total_transport, diag) endif diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 7d12f0b9e9..6db05423da 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -66,7 +66,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta - H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) + H_to_rho_eta = GV%H_to_RZ * Z_to_eta I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) !$OMP parallel default(shared) private(dilate,htot) @@ -116,7 +116,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) else !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) + eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -173,7 +173,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta - H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) + H_to_rho_eta = GV%H_to_RZ * Z_to_eta I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) !$OMP parallel default(shared) private(htot) @@ -214,7 +214,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) + eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 30a2a451a8..fc60d54f10 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -42,7 +42,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !! interfaces between u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [[T-2 ~> s-2] + !! interfaces between u-points [T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units @@ -51,17 +51,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature [degC], with the values in ! in massless layers filled vertically by diffusion. - S, & ! The filled salinity [ppt], with the values in + S !, & ! The filled salinity [ppt], with the values in ! in massless layers filled vertically by diffusion. - Rho ! Density itself, when a nonlinear equation of state is not in use [kg m-3]. +! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres ! The pressure at an interface [Pa]. real, dimension(SZIB_(G)) :: & - drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1]. - drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. + drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1]. + drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & - drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1]. - drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. + drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1]. + drho_dS_v ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZIB_(G)) :: & T_u, & ! Temperature on the interface at the u-point [degC]. S_u, & ! Salinity on the interface at the u-point [ppt]. @@ -71,19 +71,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & S_v, & ! Salinity on the interface at the v-point [ppt]. pres_v ! Pressure on the interface at the v-point [Pa]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density - real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the - ! interface times the grid spacing [kg m-3]. - real :: drdkL, drdkR ! Vertical density differences across an interface [kg m-3]. + real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the + ! interface times the grid spacing [R ~> kg m-3]. + real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. real :: hg2A, hg2B ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. - real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4]. + real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -91,7 +91,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: dz_neglect ! A change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. - real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) + real :: G_Rho0 ! The gravitational acceleration divided by density [Z2 T-2 R-1 ~> m5 kg-2 s-2] real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. real :: L_to_Z ! A conversion factor between from units for lateral distances @@ -177,7 +177,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & S_u(I) = 0.25*((S(i,j,k) + S(i+1,j,k)) + (S(i,j,k-1) + S(i+1,j,k-1))) enddo call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, & - drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) + drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do I=is-1,ie @@ -243,7 +243,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ; enddo ! end of j-loop ! Calculate the meridional isopycnal slope. - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & @@ -263,7 +263,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & S_v(i) = 0.25*((S(i,j,k) + S(i,j+1,k)) + (S(i,j,k-1) + S(i,j+1,k-1))) enddo call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, & - drho_dS_v, is, ie-is+1, tv%eqn_of_state) + drho_dS_v, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=is,ie if (use_EOS) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 873b0bdfb2..586419f19e 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -50,25 +50,21 @@ module MOM_variables ocean_mass, & !< The total mass of the ocean [kg m-2]. ocean_heat, & !< The total heat content of the ocean in [degC kg m-2]. ocean_salt, & !< The total salt content of the ocean in [kgSalt m-2]. - salt_deficit !< The salt needed to maintain the ocean column at a minimum + taux_shelf, & !< The zonal stresses on the ocean under shelves [Pa]. + tauy_shelf, & !< The meridional stresses on the ocean under shelves [Pa]. + TempxPmE, & !< The net inflow of water into the ocean times the temperature at which this + !! inflow occurs during the call to step_MOM [degC kg m-2]. + salt_deficit, & !< The salt needed to maintain the ocean column at a minimum !! salinity of 0.01 PSU over the call to step_MOM [kgSalt m-2]. + internal_heat !< Any internal or geothermal heat sources that are applied to the ocean + !! integrated over the call to step_MOM [degC kg m-2]. logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the !! conservative temperature in [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the !! absolute salinity in [g/kg]. - real, pointer, dimension(:,:) :: & - taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [Pa]. - tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [Pa]. real, pointer, dimension(:,:) :: frazil => NULL() !< The energy needed to heat the ocean column to the freezing point during the call !! to step_MOM [J m-2]. - real, pointer, dimension(:,:) :: TempxPmE => NULL() - !< The net inflow of water into the ocean times the temperature at which this inflow - !! occurs during the call to step_MOM [degC kg m-2]. This should be prescribed in the - !! forcing fields, but as it often is not, this is a useful heat budget diagnostic. - real, pointer, dimension(:,:) :: internal_heat => NULL() - !< Any internal or geothermal heat sources that are applied to the ocean integrated - !! over the call to step_MOM [degC kg m-2]. type(coupler_2d_bc_type) :: tr_fields !< A structure that may contain an !! array of named fields describing tracer-related quantities. !### NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING CONVENTION AND HAVE NO @@ -105,11 +101,11 @@ module MOM_variables real, dimension(:,:), pointer :: salt_deficit => NULL() !< The salt needed to maintain the ocean column !! at a minimum salinity of MIN_SALINITY since the last time - !! that calculate_surface_state was called, [gSalt m-2]. + !! that calculate_surface_state was called, [ppt R Z ~> gSalt m-2]. real, dimension(:,:), pointer :: TempxPmE => NULL() !< The net inflow of water into the ocean times the !! temperature at which this inflow occurs since the - !! last call to calculate_surface_state [degC kg m-2]. + !! last call to calculate_surface_state [degC R Z ~> degC kg m-2]. !! This should be prescribed in the forcing fields, but !! as it often is not, this is a useful heat budget diagnostic. real, dimension(:,:), pointer :: internal_heat => NULL() @@ -127,8 +123,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & T => NULL(), & !< Pointer to the temperature state variable [degC] S => NULL(), & !< Pointer to the salinity state variable [ppt ~> PSU or g/kg] - u => NULL(), & !< Pointer to the zonal velocity [m s-1] - v => NULL(), & !< Pointer to the meridional velocity [m s-1] + u => NULL(), & !< Pointer to the zonal velocity [L T-1 ~> m s-1] + v => NULL(), & !< Pointer to the meridional velocity [L T-1 ~> m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -211,8 +207,8 @@ module MOM_variables !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed !! to [kg Z3 m-3 T-3 ~> W m-2]. real, pointer, dimension(:,:) :: & - taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [Pa]. - tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [Pa]. + taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [R Z L T-2 ~> Pa]. + tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [R Z L T-2 ~> Pa]. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() !< Thickness of the viscous top boundary layer under ice shelves at u-points [Z ~> m]. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() @@ -297,7 +293,7 @@ module MOM_variables !> Allocates the fields for the surface (return) properties of !! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & - gas_fields_ocn, use_meltpot) + gas_fields_ocn, use_meltpot, use_iceshelves) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. @@ -310,9 +306,11 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. logical, optional, intent(in) :: use_meltpot !< If true, allocate the space for melt potential + logical, optional, intent(in) :: use_iceshelves !< If true, allocate the space for the stresses + !! under ice shelves. ! local variables - logical :: use_temp, alloc_integ, use_melt_potential + logical :: use_temp, alloc_integ, use_melt_potential, alloc_iceshelves integer :: is, ie, js, je, isd, ied, jsd, jed integer :: isdB, iedB, jsdB, jedB @@ -323,6 +321,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & use_temp = .true. ; if (present(use_temperature)) use_temp = use_temperature alloc_integ = .true. ; if (present(do_integrals)) alloc_integ = do_integrals use_melt_potential = .false. ; if (present(use_meltpot)) use_melt_potential = use_meltpot + alloc_iceshelves = .false. ; if (present(use_iceshelves)) alloc_iceshelves = use_iceshelves if (sfc_state%arrays_allocated) return @@ -347,8 +346,15 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (use_temp) then allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0 + allocate(sfc_state%TempxPmE(isd:ied,jsd:jed)) ; sfc_state%TempxPmE(:,:) = 0.0 + allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 + allocate(sfc_state%internal_heat(isd:ied,jsd:jed)) ; sfc_state%internal_heat(:,:) = 0.0 endif - allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 + endif + + if (alloc_iceshelves) then + allocate(sfc_state%taux_shelf(IsdB:IedB,jsd:jed)) ; sfc_state%taux_shelf(:,:) = 0.0 + allocate(sfc_state%tauy_shelf(isd:ied,JsdB:JedB)) ; sfc_state%tauy_shelf(:,:) = 0.0 endif if (present(gas_fields_ocn)) & @@ -457,9 +463,9 @@ subroutine MOM_thermovar_chksum(mesg, tv, G) if (associated(tv%frazil)) & call hchksum(tv%frazil, mesg//" tv%frazil", G%HI) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=G%US%R_to_kg_m3*G%US%Z_to_m) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=G%US%R_to_kg_m3*G%US%Z_to_m) end subroutine MOM_thermovar_chksum end module MOM_variables diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 43c673a592..093db28c07 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -49,7 +49,7 @@ module MOM_verticalGrid !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & g_prime, & !< The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. - Rlay !< The target coordinate value (potential density) in each layer [kg m-3]. + Rlay !< The target coordinate value (potential density) in each layer [R ~> kg m-3]. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogeneous region. integer :: nk_rho_varies = 0 !< The number of layers at the top where the @@ -61,6 +61,8 @@ module MOM_verticalGrid real :: H_to_Pa !< A constant that translates the units of thickness to pressure [Pa]. real :: H_to_Z !< A constant that translates thickness units to the units of depth. real :: Z_to_H !< A constant that translates depth units to thickness units. + real :: H_to_RZ !< A constant that translates thickness units to the units of mass per unit area. + real :: RZ_to_H !< A constant that translates mass per unit area units to thickness units. real :: H_to_MKS !< A constant that translates thickness units to its !! MKS unit (m or kg m-2) based on GV%Boussinesq @@ -99,7 +101,7 @@ subroutine verticalGridInit( param_file, GV, US ) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & @@ -141,15 +143,15 @@ subroutine verticalGridInit( param_file, GV, US ) GV%ke = nk if (GV%Boussinesq) then - GV%H_to_kg_m2 = GV%Rho0 * GV%H_to_m + GV%H_to_kg_m2 = US%R_to_kg_m3*GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m GV%H_to_MKS = GV%H_to_m else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 - GV%m_to_H = GV%Rho0 * GV%kg_m2_to_H - GV%H_to_m = GV%H_to_kg_m2 / GV%Rho0 + GV%m_to_H = US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H + GV%H_to_m = GV%H_to_kg_m2 / (US%R_to_kg_m3*GV%Rho0) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H GV%H_to_MKS = GV%H_to_kg_m2 endif @@ -160,6 +162,9 @@ subroutine verticalGridInit( param_file, GV, US ) GV%Z_to_H = US%Z_to_m * GV%m_to_H GV%Angstrom_Z = US%m_to_Z * GV%Angstrom_m + GV%H_to_RZ = GV%H_to_kg_m2 * US%kg_m3_to_R * US%m_to_Z + GV%RZ_to_H = GV%kg_m2_to_H * US%R_to_kg_m3 * US%Z_to_m + ! Log derivative values. call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) @@ -267,9 +272,10 @@ function get_tr_flux_units(GV, tr_units, tr_vol_conc_units, tr_mass_conc_units) end function get_tr_flux_units !> This sets the coordinate data for the "layer mode" of the isopycnal model. -subroutine setVerticalGridAxes( Rlay, GV ) +subroutine setVerticalGridAxes( Rlay, GV, scale ) type(verticalGrid_type), intent(inout) :: GV !< The container for vertical grid data - real, dimension(GV%ke), intent(in) :: Rlay !< The layer target density + real, dimension(GV%ke), intent(in) :: Rlay !< The layer target density [R ~> kg m-3] + real, intent(in) :: scale !< A unit scaling factor for Rlay ! Local variables integer :: k, nk @@ -277,13 +283,13 @@ subroutine setVerticalGridAxes( Rlay, GV ) GV%zAxisLongName = 'Target Potential Density' GV%zAxisUnits = 'kg m-3' - do k=1,nk ; GV%sLayer(k) = Rlay(k) ; enddo + do k=1,nk ; GV%sLayer(k) = scale*Rlay(k) ; enddo if (nk > 1) then - GV%sInterface(1) = 1.5*Rlay(1) - 0.5*Rlay(2) - do K=2,nk ; GV%sInterface(K) = 0.5*( Rlay(k-1) + Rlay(k) ) ; enddo - GV%sInterface(nk+1) = 1.5*Rlay(nk) - 0.5*Rlay(nk-1) + GV%sInterface(1) = scale * (1.5*Rlay(1) - 0.5*Rlay(2)) + do K=2,nk ; GV%sInterface(K) = scale * 0.5*( Rlay(k-1) + Rlay(k) ) ; enddo + GV%sInterface(nk+1) = scale * (1.5*Rlay(nk) - 0.5*Rlay(nk-1)) else - GV%sInterface(1) = 0.0 ; GV%sInterface(nk+1) = 2.0*Rlay(nk) + GV%sInterface(1) = 0.0 ; GV%sInterface(nk+1) = 2.0*scale*Rlay(nk) endif end subroutine setVerticalGridAxes diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index e0bbd832bb..dd72378671 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -66,7 +66,7 @@ module MOM_PointAccel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of zonal velocities over the !! previous timestep. This subroutine is called from vertvisc. -subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, str, a, hv) +subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rpt, str, a, hv) integer, intent(in) :: I !< The zonal index of the column to be documented. integer, intent(in) :: j !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -80,7 +80,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms !! in the continuity equations. - real, intent(in) :: dt !< The ocean dynamics time step [s]. + real, intent(in) :: dt_in_T !< The ocean dynamics time step [T ~> s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. @@ -95,6 +95,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real :: f_eff, CFL real :: Angstrom real :: truncvel, du + real :: dt ! The time step [s] real :: Inorm(SZK_(G)) real :: e(SZK_(G)+1) real :: h_scale, uh_scale @@ -106,6 +107,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st integer :: file Angstrom = GV%Angstrom_H + GV%H_subroundoff + dt = US%T_to_s*dt_in_T h_scale = GV%H_to_m ; uh_scale = GV%H_to_m ! if (.not.associated(CS)) return @@ -397,7 +399,7 @@ end subroutine write_u_accel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of meridional velocities over !! the previous timestep. This subroutine is called from vertvisc. -subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, str, a, hv) +subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rpt, str, a, hv) integer, intent(in) :: i !< The zonal index of the column to be documented. integer, intent(in) :: J !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -411,7 +413,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in !! the continuity equations. - real, intent(in) :: dt !< The ocean dynamics time step [s]. + real, intent(in) :: dt_in_T !< The ocean dynamics time step [T ~> s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. @@ -426,6 +428,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real :: f_eff, CFL real :: Angstrom real :: truncvel, dv + real :: dt ! The time step [s] real :: Inorm(SZK_(G)) real :: e(SZK_(G)+1) real :: h_scale, uh_scale @@ -437,6 +440,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st integer :: file Angstrom = GV%Angstrom_H + GV%H_subroundoff + dt = US%T_to_s*dt_in_T h_scale = GV%H_to_m ; uh_scale = GV%H_to_m ! if (.not.associated(CS)) return diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7344a5e677..d4fa0a59c8 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -66,9 +66,9 @@ module MOM_diagnostics ! following fields have nz layers. real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [L T-1 s-1 ~> m s-2] - dv_dt => NULL(), & !< net j-acceleration [L T-1 s-1 ~> m s-2] - dh_dt => NULL(), & !< thickness rate of change [H s-1 ~> m s-1 or kg m-2 s-1] + du_dt => NULL(), & !< net i-acceleration [L T-2 ~> m s-2] + dv_dt => NULL(), & !< net j-acceleration [L T-2 ~> m s-2] + dh_dt => NULL(), & !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density @@ -210,7 +210,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! If p_surf is not associated, it is the same !! as setting the surface pressure to 0. real, intent(in) :: dt !< The time difference since the last - !! call to this subroutine [s]. + !! call to this subroutine [T ~> s]. type(diag_grid_storage), intent(in) :: diag_pre_sync !< Target grids from previous timestep type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a !! previous call to diagnostics_init. @@ -222,7 +222,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! Local variables integer i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb - ! coordinate variable potential density [kg m-3]. + ! coordinate variable potential density [R ~> kg m-3]. real :: Rcv(SZI_(G),SZJ_(G),SZK_(G)) ! Two temporary work arrays real :: work_3d(SZI_(G),SZJ_(G),SZK_(G)) @@ -255,7 +255,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (loc(CS)==0) call MOM_error(FATAL, & "calculate_diagnostic_fields: Module must be initialized before used.") - call calculate_derivs(US%s_to_T*dt, G, CS) + call calculate_derivs(dt, G, CS) if (dt > 0.0) then call diag_save_grids(CS%diag) @@ -464,10 +464,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (associated(tv%eqn_of_state)) then pressure_1d(:) = tv%P_Ref -!$OMP parallel do default(none) shared(tv,Rcv,is,ie,js,je,nz,pressure_1d) + !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, & - Rcv(:,j,k), is-1, ie-is+3, tv%eqn_of_state) + Rcv(:,j,k), is-1, ie-is+3, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo ; enddo else ! Rcv should not be used much in this case, so fill in sensible values. do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 @@ -642,19 +642,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CS%cfl_cg1(i,j) = (dt*US%m_s_to_L_T*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdxT(i,j) + CS%cfl_cg1_x(i,j) = (dt*US%m_s_to_L_T*CS%cg1(i,j)) * G%IdxT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdyT(i,j) + CS%cfl_cg1_y(i,j) = (dt*US%m_s_to_L_T*CS%cg1(i,j)) * G%IdyT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) endif @@ -829,20 +829,23 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) call post_data(CS%id_col_ht, z_bot, CS%diag) endif + ! NOTE: int_density_z expects z_top and z_btm values from [ij]sq to [ij]eq+1 if (CS%id_col_mass > 0 .or. CS%id_pbo > 0) then do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then IG_Earth = 1.0 / GV%mks_g_Earth ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo - do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo + do j=G%jscB,G%jecB+1 ; do i=G%iscB,G%iecB+1 + z_bot(i,j) = 0.0 + enddo ; enddo do k=1,nz - do j=js,je ; do i=is,ie + do j=G%jscB,G%jecB+1 ; do i=G%iscB,G%iecB+1 z_top(i,j) = z_bot(i,j) z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%Rho0, GV%mks_g_Earth*US%Z_to_m, & + z_top, z_bot, 0.0, US%R_to_kg_m3*GV%Rho0, GV%mks_g_Earth*US%Z_to_m, & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth @@ -850,7 +853,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) enddo else do k=1,nz ; do j=js,je ; do i=is,ie - mass(i,j) = mass(i,j) + (GV%H_to_m*GV%Rlay(k))*h(i,j,k) + mass(i,j) = mass(i,j) + (GV%H_to_m*US%R_to_kg_m3*GV%Rlay(k))*h(i,j,k) enddo ; enddo ; enddo endif else @@ -1200,7 +1203,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output - real, intent(in) :: dt_int !< total time step associated with these diagnostics [s]. + real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), & @@ -1211,7 +1214,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [m] - real :: I_time_int ! The inverse of the time interval [s-1]. + real :: I_time_int ! The inverse of the time interval [T-1 ~> s-1]. real :: zos_area_mean, volo, ssh_ga integer :: i, j, is, ie, js, je @@ -1350,7 +1353,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real, intent(in) :: dt_trans !< total time step associated with the transports [s]. + real, intent(in) :: dt_trans !< total time step associated with the transports [T ~> s]. type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry ! Local variables @@ -1360,14 +1363,14 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy real, dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo ! Diagnostics of layer mass transport [kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tend ! Change in layer thickness due to dynamics ! [H s-1 ~> m s-1 or kg m-2 s-1]. - real :: Idt ! The inverse of the time interval [s-1] + real :: Idt ! The inverse of the time interval [T-1 ~> s-1] real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes ! [kg L-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Idt = 1. / dt_trans - H_to_kg_m2_dt = GV%H_to_kg_m2 * US%L_to_m**2 * Idt + H_to_kg_m2_dt = GV%H_to_kg_m2 * US%L_to_m**2 * US%s_to_T * Idt call diag_save_grids(diag) call diag_copy_storage_to_diag(diag, diag_pre_dyn) @@ -1563,10 +1566,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag if (CS%id_e_D>0) call safe_alloc_ptr(CS%e_D,isd,ied,jsd,jed,nz+1) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & - 'Mixed Layer Coordinate Potential Density', 'kg m-3') + 'Mixed Layer Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_Rcv = register_diag_field('ocean_model', 'Rho_cv', diag%axesTL, Time, & - 'Coordinate Potential Density', 'kg m-3') + 'Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rhopot0 = register_diag_field('ocean_model', 'rhopot0', diag%axesTL, Time, & 'Potential density referenced to surface', 'kg m-3') @@ -1731,9 +1734,10 @@ end subroutine MOM_diagnostics_init !> Register diagnostics of the surface state and integrated quantities -subroutine register_surface_diags(Time, G, IDs, diag, tv) +subroutine register_surface_diags(Time, G, US, IDs, diag, tv) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -1787,18 +1791,20 @@ subroutine register_surface_diags(Time, G, IDs, diag, tv) endif if (associated(tv%frazil)) then IDs%id_fraz = register_diag_field('ocean_model', 'frazil', diag%axesT1, Time, & - 'Heat from frazil formation', 'W m-2', cmor_field_name='hfsifrazil', & + 'Heat from frazil formation', 'W m-2', conversion=US%s_to_T, cmor_field_name='hfsifrazil', & cmor_standard_name='heat_flux_into_sea_water_due_to_frazil_ice_formation', & cmor_long_name='Heat Flux into Sea Water due to Frazil Ice Formation') endif endif IDs%id_salt_deficit = register_diag_field('ocean_model', 'salt_deficit', diag%axesT1, Time, & - 'Salt sink in ocean due to ice flux', 'psu m-2 s-1') + 'Salt sink in ocean due to ice flux', & + 'psu m-2 s-1', conversion=G%US%R_to_kg_m3*G%US%Z_to_m*US%s_to_T) IDs%id_Heat_PmE = register_diag_field('ocean_model', 'Heat_PmE', diag%axesT1, Time, & - 'Heat flux into ocean from mass flux into ocean', 'W m-2') + 'Heat flux into ocean from mass flux into ocean', & + 'W m-2', conversion=G%US%R_to_kg_m3*G%US%Z_to_m*US%s_to_T) IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& - 'Heat flux into ocean from geothermal or other internal sources', 'W m-2') + 'Heat flux into ocean from geothermal or other internal sources', 'W m-2', conversion=US%s_to_T) end subroutine register_surface_diags @@ -1845,7 +1851,7 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) 'm s-1', v_extensive=.true., conversion=GV%H_to_m) IDs%id_dynamics_h_tendency = register_diag_field('ocean_model','dynamics_h_tendency', & diag%axesTl, Time, 'Change in layer thicknesses due to horizontal dynamics', & - 'm s-1', v_extensive=.true., conversion=GV%H_to_m) + 'm s-1', v_extensive=.true., conversion=GV%H_to_m*US%s_to_T) end subroutine register_transport_diags @@ -2006,7 +2012,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) id = register_static_field('ocean_model','Rho_0', diag%axesNull, & 'mean ocean density used with the Boussinesq approximation', & - 'kg m-3', cmor_field_name='rhozero', & + 'kg m-3', cmor_field_name='rhozero', conversion=US%R_to_kg_m3, & cmor_standard_name='reference_sea_water_density_for_boussinesq_approximation', & cmor_long_name='reference sea water density for boussinesq approximation') if (id > 0) call post_data(id, GV%Rho0, diag, .true.) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d6f495faa5..f99b6d7f7c 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -98,7 +98,7 @@ module MOM_sum_output type(EFP_type) :: heat_prev_EFP !< An extended fixed point version of heat_prev type(EFP_type) :: salt_prev_EFP !< An extended fixed point version of salt_prev type(EFP_type) :: mass_prev_EFP !< An extended fixed point version of mass_prev - real :: dt !< The baroclinic dynamics time step [s]. + real :: dt_in_T !< The baroclinic dynamics time step [T ~> s]. type(time_type) :: energysavedays !< The interval between writing the energies !! and other integral quantities of the run. @@ -179,9 +179,9 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) - call get_param(param_file, mdl, "DT", CS%dt, & - "The (baroclinic) dynamics time step.", units="s", & - fail_if_missing=.true.) + call get_param(param_file, mdl, "DT", CS%dt_in_T, & + "The (baroclinic) dynamics time step.", & + units="s", scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "MAXTRUNC", CS%maxtrunc, & "The run will be stopped, and the day set to a very "//& "large value if the velocity is truncated more than "//& @@ -542,7 +542,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ tmp1(i,j,k) = H_to_kg_m2 * h(i,j,k) * areaTm(i,j) enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = US%m_to_Z * (mass_lay(k) / GV%Rho0) ; enddo + do k=1,nz ; vol_lay(k) = US%m_to_Z * (mass_lay(k) / (US%R_to_kg_m3*GV%Rho0)) ; enddo endif endif ! Boussinesq @@ -666,7 +666,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(US%R_to_kg_m3*GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -675,7 +675,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(US%R_to_kg_m3*GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -716,21 +716,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * CS%dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * CS%dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * CS%dt_in_T) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * CS%dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * CS%dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * CS%dt_in_T) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo @@ -750,7 +750,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ CS%salt_prev_EFP = salt_EFP ; CS%net_salt_in_EFP = real_to_EFP(0.0) CS%heat_prev_EFP = heat_EFP ; CS%net_heat_in_EFP = real_to_EFP(0.0) endif - Irho0 = 1.0/GV%Rho0 + Irho0 = 1.0 / (US%R_to_kg_m3*GV%Rho0) if (CS%use_temperature) then Salt_chg_EFP = Salt_EFP - CS%salt_prev_EFP @@ -936,13 +936,16 @@ end subroutine write_energy !> This subroutine accumates the net input of volume, salt and heat, through !! the ocean surface for use in diagnosing conservation. -subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) +subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible !! forcing fields. Unused fields are unallocated. type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. real, intent(in) :: dt !< The amount of time over which to average [s]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call !! to MOM_sum_output_init. ! Local variables @@ -959,6 +962,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) real :: heat_input ! The total heat added by boundary fluxes, integrated ! over a time step and summed over space [J]. real :: C_p ! The heat capacity of seawater [J degC-1 kg-1]. + real :: dt_in_T ! Time increment [T ~> s] + real :: RZL2_to_kg ! A combination of scaling factors for mass [kg R-1 Z-1 L-2 ~> 1] type(EFP_type) :: & FW_in_EFP, & ! Extended fixed point version of FW_input [kg] @@ -970,12 +975,14 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec C_p = fluxes%C_p + RZL2_to_kg = US%L_to_m**2*US%R_to_kg_m3*US%Z_to_m + dt_in_T = US%s_to_T*dt FW_in(:,:) = 0.0 ; FW_input = 0.0 if (associated(fluxes%evap)) then if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - FW_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(fluxes%evap(i,j) + & + FW_in(i,j) = RZL2_to_kg * dt_in_T*G%areaT(i,j)*(fluxes%evap(i,j) + & (((fluxes%lprec(i,j) + fluxes%vprec(i,j)) + fluxes%lrunoff(i,j)) + & (fluxes%fprec(i,j) + fluxes%frunoff(i,j)))) enddo ; enddo @@ -986,25 +993,26 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - FW_in(i,j) = FW_in(i,j) + dt * G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt(i,j) + FW_in(i,j) = FW_in(i,j) + RZL2_to_kg*dt_in_T * & + G%areaT(i,j) * fluxes%seaice_melt(i,j) enddo ; enddo ; endif salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & + heat_in(i,j) = heat_in(i,j) + dt*US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) + heat_in(i,j) = heat_in(i,j) + dt*US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt_in_T*RZL2_to_kg*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & ! + (fluxes%heat_content_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1012,9 +1020,9 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! enddo ; enddo ; endif ! smg: old code - if (associated(sfc_state%TempxPmE)) then + if (associated(tv%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * sfc_state%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * RZL2_to_kg*G%areaT(i,j)) * tv%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie @@ -1024,25 +1032,26 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. - if (associated(sfc_state%internal_heat)) then + if (associated(tv%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * & - sfc_state%internal_heat(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * US%L_to_m**2*G%areaT(i,j)) * & + tv%internal_heat(i,j) enddo ; enddo endif - if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * sfc_state%frazil(i,j) + if (associated(tv%frazil)) then ; do j=js,je ; do i=is,ie + heat_in(i,j) = heat_in(i,j) + US%L_to_m**2*G%areaT(i,j) * tv%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) + heat_in(i,j) = heat_in(i,j) + dt*US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) enddo ; enddo ; endif ! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) - G%US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) +! heat_in(i,j) = heat_in(i,j) - US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. - salt_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) + salt_in(i,j) = RZL2_to_kg * dt_in_T * & + G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index f8fc9b7cf9..c5915dae67 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -71,29 +71,44 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & ! Local variables real, dimension(SZK_(G)+1) :: & - dRho_dT, dRho_dS, & - pres, T_int, S_int, & + dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + pres, & ! Interface pressure [Pa] + T_int, & ! Temperature interpolated to interfaces [degC] + S_int, & ! Salinity interpolated to interfaces [ppt] gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & - Igl, Igu ! The inverse of the reduced gravity across an interface times - ! the thickness of the layer below (Igl) or above (Igu) it [s2 m-2]. + Igl, Igu, Igd ! The inverse of the reduced gravity across an interface times + ! the thickness of the layer below (Igl) or above (Igu) it. + ! Their sum, Igd, is provided for the tridiagonal solver. [s2 m-2] real, dimension(SZK_(G),SZI_(G)) :: & - Hf, Tf, Sf, Rf + Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] + Tf, & ! Layer temperatures after very thin layers are combined [degC] + Sf, & ! Layer salinities after very thin layers are combined [ppt] + Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] real, dimension(SZK_(G)) :: & - Hc, Tc, Sc, Rc + Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] + Tc, & ! A column of layer temperatures after convective istabilities are removed [degC] + Sc, & ! A column of layer salinites after convective istabilities are removed [ppt] + Rc, & ! A column of layer densities after convective istabilities are removed [R ~> kg m-3] + Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 real :: lam, dlam, lam0 real :: min_h_frac real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses [Z ~> m]. - H_here, HxT_here, HxS_here, HxR_here - real :: speed2_tot - real :: I_Hnew, drxh_sum + htot, hmin, & ! Thicknesses [Z ~> m] + H_here, & ! A thickness [Z ~> m] + HxT_here, & ! A layer integrated temperature [degC Z ~> degC m] + HxS_here, & ! A layer integrated salinity [ppt Z ~> ppt m] + HxR_here ! A layer integrated density [R Z ~> kg m-2] + real :: speed2_tot ! overestimate of the mode-1 speed squared [m2 s-2] + real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] + real :: drxh_sum ! The sum of density diffrences across interfaces times thicknesses [R Z ~> kg m-2] real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 m-2 ~> 1]. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: g_Rho0 ! G_Earth/Rho0 [m2 s-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 @@ -145,8 +160,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & !$OMP Z_to_Pa,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & -!$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & -!$OMP Rc,speed2_tot,Igl,Igu,lam0,lam,lam_it,dlam, & +!$OMP drho_dS,drxh_sum,kc,Hc,Hc_H,Tc,Sc,I_Hnew,gprime,& +!$OMP Rc,speed2_tot,Igl,Igu,Igd,lam0,lam,lam_it,dlam, & !$OMP mode_struct,sum_hc,N2min,gp,hw, & !$OMP ms_min,ms_max,ms_sq, & !$OMP det,ddet,detKm1,ddetKm1,detKm2,ddetKm2,det_it,ddet_it) @@ -214,7 +229,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, 2, & - kf(i)-1, tv%eqn_of_state) + kf(i)-1, tv%eqn_of_state, scale=US%kg_m3_to_R) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. @@ -424,7 +439,10 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & endif if (calc_modal_structure) then - call tdma6(kc, -igu, igu+igl, -igl, lam, mode_struct) + do k = 1,kc + Igd(k) = Igu(k) + Igl(k) + enddo + call tdma6(kc, -Igu, Igd, -Igl, lam, mode_struct) ms_min = mode_struct(1) ms_max = mode_struct(1) ms_sq = mode_struct(1)**2 @@ -456,8 +474,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & endif ! Note that remapping_core_h requires that the same units be used ! for both the source and target grid thicknesses, here [H ~> m or kg m-2]. - call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, & - nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) + do k = 1,kc + Hc_H(k) = GV%Z_to_H * Hc(k) + enddo + call remapping_core_h(CS%remapping_CS, kc, Hc_H(:), mode_struct, & + nz, h(i,j,:), modal_structure(i,j,:), & + 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) endif else cg1(i,j) = 0.0 @@ -528,9 +550,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) !! over the entire computational domain. ! Local variables real, dimension(SZK_(G)+1) :: & - dRho_dT, dRho_dS, & - pres, T_int, S_int, & - gprime ! The reduced gravity across each interface [m s-2] + dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + pres, & ! Interface pressure [Pa] + T_int, & ! Temperature interpolated to interfaces [degC] + S_int, & ! Salinity interpolated to interfaces [ppt] + gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it [s2 m-2]. @@ -539,9 +564,15 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! diagonals of tridiagonal matrix; one value for each ! interface (excluding surface and bottom) real, dimension(SZK_(G),SZI_(G)) :: & - Hf, Tf, Sf, Rf + Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] + Tf, & ! Layer temperatures after very thin layers are combined [degC] + Sf, & ! Layer salinities after very thin layers are combined [ppt] + Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] real, dimension(SZK_(G)) :: & - Hc, Tc, Sc, Rc + Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] + Tc, & ! A column of layer temperatures after convective istabilities are removed [degC] + Sc, & ! A column of layer salinites after convective istabilities are removed [ppt] + Rc ! A column of layer densities after convective istabilities are removed [R ~> kg m-3] real, parameter :: c1_thresh = 0.01 ! if c1 is below this value, don't bother calculating ! cn values for higher modes @@ -564,16 +595,20 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real :: min_h_frac real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses [Z ~> m]. - H_here, HxT_here, HxS_here, HxR_here + htot, hmin, & ! Thicknesses [Z ~> m] + H_here, & ! A thickness [Z ~> m] + HxT_here, & ! A layer integrated temperature [degC Z ~> degC m] + HxS_here, & ! A layer integrated salinity [ppt Z ~> ppt m] + HxR_here ! A layer integrated density [R Z ~> kg m-2] real :: speed2_tot ! overestimate of the mode-1 speed squared [m2 s-2] real :: speed2_min ! minimum mode speed (squared) to consider in root searching real, parameter :: reduct_factor = 0.5 ! factor used in setting speed2_min - real :: I_Hnew, drxh_sum + real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] + real :: drxh_sum ! The sum of density diffrences across interfaces times thicknesses [R Z ~> kg m-2] real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: g_Rho0 ! G_Earth/Rho0 [m2 s-2 Z-1 R-1 ~> m4 s-2 kg-1]. integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. @@ -672,7 +707,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, 2, & - kf(i)-1, tv%eqn_of_state) + kf(i)-1, tv%eqn_of_state, scale=US%kg_m3_to_R) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index ac28a8d012..68667df71b 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -43,10 +43,10 @@ module MOM_wave_structure real, allocatable, dimension(:,:,:) :: W_profile !< Vertical profile of w_hat(z), where !! w(x,y,z,t) = w_hat(z)*exp(i(kx+ly-freq*t)) is the full time- - !! varying vertical velocity with w_hat(z) = W0*w_strct(z) [m s-1]. + !! varying vertical velocity with w_hat(z) = W0*w_strct(z) [Z T-1 ~> m s-1]. real, allocatable, dimension(:,:,:) :: Uavg_profile !< Vertical profile of the magnitude of horizontal velocity, - !! (u^2+v^2)^0.5, averaged over a period [m s-1]. + !! (u^2+v^2)^0.5, averaged over a period [L T-1 ~> m s-1]. real, allocatable, dimension(:,:,:) :: z_depths !< Depths of layer interfaces [m]. real, allocatable, dimension(:,:,:) :: N2 @@ -102,35 +102,48 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(wave_structure_CS), pointer :: CS !< The control structure returned by a !! previous call to wave_structure_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: En !< Internal wave energy density [J m-2]. - logical,optional, intent(in) :: full_halos !< If true, do the calculation + optional, intent(in) :: En !< Internal wave energy density [R Z3 T-2 ~> J m-2] + logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. ! Local variables real, dimension(SZK_(G)+1) :: & - dRho_dT, dRho_dS, & - pres, T_int, S_int, & + dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + pres, & ! Interface pressure [Pa] + T_int, & ! Temperature interpolated to interfaces [degC] + S_int, & ! Salinity interpolated to interfaces [ppt] gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it [s2 m-2]. real, dimension(SZK_(G),SZI_(G)) :: & - Hf, Tf, Sf, Rf + Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] + Tf, & ! Layer temperatures after very thin layers are combined [degC] + Sf, & ! Layer salinities after very thin layers are combined [ppt] + Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] real, dimension(SZK_(G)) :: & - Hc, Tc, Sc, Rc, & + Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] + Tc, & ! A column of layer temperatures after convective istabilities are removed [degC] + Sc, & ! A column of layer salinites after convective istabilities are removed [ppt] + Rc, & ! A column of layer densities after convective istabilities are removed [R ~> kg m-3] det, ddet real, dimension(SZI_(G),SZJ_(G)) :: & - htot + htot ! The vertical sum of the thicknesses [Z ~> m] real :: lam real :: min_h_frac real :: H_to_pres real, dimension(SZI_(G)) :: & - hmin, & ! Thicknesses [Z ~> m]. - H_here, HxT_here, HxS_here, HxR_here + hmin, & ! Thicknesses [Z ~> m] + H_here, & ! A thickness [Z ~> m] + HxT_here, & ! A layer integrated temperature [degC Z ~> degC m] + HxS_here, & ! A layer integrated salinity [ppt Z ~> ppt m] + HxR_here ! A layer integrated density [R Z ~> kg m-2] real :: speed2_tot - real :: I_Hnew, drxh_sum + real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] + real :: drxh_sum ! The sum of density diffrences across interfaces times thicknesses [R Z ~> kg m-2] real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: g_Rho0 ! G_Earth/Rho0 in [m2 s-2 Z-1 R-1 ~> m4 s-2 kg-1]. ! real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector @@ -147,10 +160,14 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(G)+1) :: w_strct2, u_strct2 ! squared values real, dimension(SZK_(G)) :: dz ! thicknesses of merged layers (same as Hc I hope) - real, dimension(SZK_(G)+1) :: dWdz_profile ! profile of dW/dz + ! real, dimension(SZK_(G)+1) :: dWdz_profile ! profile of dW/dz real :: w2avg ! average of squared vertical velocity structure funtion - real :: int_dwdz2, int_w2, int_N2w2, KE_term, PE_term, W0 - ! terms in vertically averaged energy equation + real :: int_dwdz2 + real :: int_w2 + real :: int_N2w2 + real :: KE_term ! terms in vertically averaged energy equation + real :: PE_term ! terms in vertically averaged energy equation + real :: W0 ! A vertical velocity magnitude [Z T-1 ~> m s-1] real :: gp_unscaled ! A version of gprime rescaled to [m s-2]. real, dimension(SZK_(G)-1) :: lam_z ! product of eigen value and gprime(k); one value for each ! interface (excluding surface and bottom) @@ -178,7 +195,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth /GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth / GV%Rho0 cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. use_EOS = associated(tv%eqn_of_state) @@ -260,15 +277,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, 2, & - kf(i)-1, tv%eqn_of_state) + kf(i)-1, tv%eqn_of_state, scale=US%kg_m3_to_R) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. drxh_sum = 0.0 do k=2,kf(i) drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * & - max(0.0,drho_dT(k)*(Tf(k,i)-Tf(k-1,i)) + & - drho_dS(k)*(Sf(k,i)-Sf(k-1,i))) + max(0.0,dRho_dT(k)*(Tf(k,i)-Tf(k-1,i)) + & + dRho_dS(k)*(Sf(k,i)-Sf(k-1,i))) enddo else drxh_sum = 0.0 @@ -287,7 +304,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo kc = 1 Hc(1) = Hf(1,i) ; Tc(1) = Tf(1,i) ; Sc(1) = Sf(1,i) do k=2,kf(i) - if ((drho_dT(k)*(Tf(k,i)-Tc(kc)) + drho_dS(k)*(Sf(k,i)-Sc(kc))) * & + if ((dRho_dT(k)*(Tf(k,i)-Tc(kc)) + dRho_dS(k)*(Sf(k,i)-Sc(kc))) * & (Hc(kc) + Hf(k,i)) < 2.0 * tol2*drxh_sum) then ! Merge this layer with the one above and backtrack. I_Hnew = 1.0 / (Hc(kc) + Hf(k,i)) @@ -298,7 +315,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! that the tolerance is a factor of two larger, to avoid limit how ! far back we go. do k2=kc,2,-1 - if ((drho_dT(k2)*(Tc(k2)-Tc(k2-1)) + drho_dS(k2)*(Sc(k2)-Sc(k2-1))) * & + if ((dRho_dT(k2)*(Tc(k2)-Tc(k2-1)) + dRho_dS(k2)*(Sc(k2)-Sc(k2-1))) * & (Hc(k2) + Hc(k2-1)) < tol2*drxh_sum) then ! Merge the two bottommost layers. At this point kc = k2. I_Hnew = 1.0 / (Hc(kc) + Hc(kc-1)) @@ -317,8 +334,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo enddo ! At this point there are kc layers and the gprimes should be positive. do k=2,kc ! Revisit this if non-Boussinesq. - gprime(k) = g_Rho0 * (drho_dT(k)*(Tc(k)-Tc(k-1)) + & - drho_dS(k)*(Sc(k)-Sc(k-1))) + gprime(k) = g_Rho0 * (dRho_dT(k)*(Tc(k)-Tc(k-1)) + & + dRho_dS(k)*(Sc(k)-Sc(k-1))) enddo else ! .not.use_EOS ! Do the same with density directly... @@ -471,18 +488,18 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo w_strct2(:) = w_strct(1:nzm)**2 ! vertical integration with Trapezoidal rule do k=1,nzm-1 - int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1))*dz(k) - int_w2 = int_w2 + 0.5*(w_strct2(K)+w_strct2(K+1))*dz(k) - int_N2w2 = int_N2w2 + 0.5*(w_strct2(K)*N2(K)+w_strct2(K+1)*N2(K+1))*dz(k) + int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1)) * US%m_to_Z*dz(k) + int_w2 = int_w2 + 0.5*(w_strct2(K)+w_strct2(K+1)) * US%m_to_Z*dz(k) + int_N2w2 = int_N2w2 + 0.5*(w_strct2(K)*N2(K)+w_strct2(K+1)*N2(K+1)) * US%m_to_Z*dz(k) enddo ! Back-calculate amplitude from energy equation - if (Kmag2 > 0.0) then - !### This should be simpified to use a single division. - KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) - PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) + if (present(En) .and. (freq**2*Kmag2 > 0.0)) then + ! Units here are [R + KE_term = 0.25*GV%Rho0*( ((freq**2 + f2) / (freq**2*Kmag2))*int_dwdz2 + int_w2 ) + PE_term = 0.25*GV%Rho0*( int_N2w2 / (US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then - W0 = sqrt( En(i,j)/(KE_term + PE_term) ) + W0 = sqrt( En(i,j) / (KE_term + PE_term) ) else call MOM_error(WARNING, "wave_structure: En < 0.0; setting to W0 to 0.0") print *, "En(i,j)=", En(i,j), " at ig=", ig, ", jg=", jg @@ -490,13 +507,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo endif ! Calculate actual vertical velocity profile and derivative W_profile(:) = W0*w_strct(:) - dWdz_profile(:) = W0*u_strct(:) + ! dWdz_profile(:) = W0*u_strct(:) ! Calculate average magnitude of actual horizontal velocity over a period - !### This should be simpified to use a single division. - Uavg_profile(:) = abs(dWdz_profile(:)) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) + Uavg_profile(:) = US%Z_to_L*abs(W0*u_strct(:)) * sqrt((freq**2 + f2) / (2.0*freq**2*Kmag2)) else W_profile(:) = 0.0 - dWdz_profile(:) = 0.0 + ! dWdz_profile(:) = 0.0 Uavg_profile(:) = 0.0 endif diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 0b966e8549..5d3d33534b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -135,13 +135,15 @@ module MOM_EOS !> Calls the appropriate subroutine to calculate density of sea water for scalar inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref) +subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] - real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] + real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1] if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_scalar called with an unassociated EOS_type EOS.") @@ -163,19 +165,26 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref) "calculate_density_scalar: EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then + rho = scale * rho + endif ; endif + end subroutine calculate_density_scalar !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref) +subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] - real, dimension(:), intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] + real, dimension(:), intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1] + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") @@ -197,17 +206,23 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re "calculate_density_array: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then + do j=start,start+npts-1 ; rho(j) = scale * rho(j) ; enddo + endif ; endif + end subroutine calculate_density_array !> Calls the appropriate subroutine to calculate specific volume of sea water !! for scalar inputs. -subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref) +subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] - real, intent(out) :: specvol !< specific volume (in-situ if pressure is local) [m3 kg-1] + real, intent(out) :: specvol !< In situ? specific volume [m3 kg-1] or [R-1 ~> m3 kg-1] type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific volume + !! from m3 kg-1 to the desired units [kg m-3 R-1] real :: rho @@ -236,24 +251,30 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref) "calculate_spec_vol_scalar: EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then + specvol = scale * specvol + endif ; endif + end subroutine calculate_spec_vol_scalar !> Calls the appropriate subroutine to calculate the specific volume of sea water !! for 1-D array inputs. -subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref) +subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref, scale) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface !! [degC]. real, dimension(:), intent(in) :: S !< salinity [ppt]. real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(out) :: specvol !< in situ specific volume [kg m-3]. + real, dimension(:), intent(out) :: specvol !< in situ specific volume [kg m-3] or [R-1 ~> m3 kg-1]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific volume + !! from m3 kg-1 to the desired units [kg m-3 R-1] real, dimension(size(specvol)) :: rho - + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_array called with an unassociated EOS_type EOS.") @@ -280,6 +301,10 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s "calculate_spec_vol_array: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 + specvol(j) = scale * specvol(j) + enddo ; endif ; endif + end subroutine calculate_spec_vol_array @@ -338,17 +363,20 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) end subroutine calculate_TFreeze_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. -subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS) +subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1]. + !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1]. real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1]. + !! in [kg m-3 ppt-1] or [R degC-1 ~> kg m-3 ppt-1]. integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1] + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -370,26 +398,34 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star "calculate_density_derivs_array: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 + drho_dT(j) = scale * drho_dT(j) + drho_dS(j) = scale * drho_dS(j) + enddo ; endif ; endif + end subroutine calculate_density_derivs_array !> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar !! to a one-element array -subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS) +subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1]. + !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1]. + !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1]. type(EOS_type), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1] + if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_WRIGHT) call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS) case (EOS_TEOS10) @@ -399,27 +435,35 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then + drho_dT = scale * drho_dT + drho_dS = scale * drho_dS + endif ; endif + end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, start, npts, EOS) + drho_dS_dP, drho_dT_dP, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] - real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect - !! to S [kg m-3 ppt-2] - real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with respcct - !! to T [kg m-3 ppt-1 degC-1] - real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect - !! to T [kg m-3 degC-2] - real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect - !! to pressure [kg m-3 ppt-1 Pa-1] - real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect - !! to pressure [kg m-3 degC-1 Pa-1] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S + !! [kg m-3 ppt-2] or [R ppt-2 ~> kg m-3 ppt-2] + real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with respect to T + !! [kg m-3 ppt-1 degC-1] or [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] + real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T + !! [kg m-3 degC-2] or [R degC-2 ~> kg m-3 degC-2] + real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure + !! [kg m-3 ppt-1 Pa-1] or [R ppt-1 Pa-1 ~> kg m-3 ppt-1 Pa-1] + real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1] + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -439,25 +483,35 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 + drho_dS_dS(j) = scale * drho_dS_dS(j) + drho_dS_dT(j) = scale * drho_dS_dT(j) + drho_dT_dT(j) = scale * drho_dT_dT(j) + drho_dS_dP(j) = scale * drho_dS_dP(j) + drho_dT_dP(j) = scale * drho_dT_dP(j) + enddo ; endif ; endif + end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, EOS) + drho_dS_dP, drho_dT_dP, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] - real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect - !! to S [kg m-3 ppt-2] - real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respcct - !! to T [kg m-3 ppt-1 degC-1] - real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect - !! to T [kg m-3 degC-2] - real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect - !! to pressure [kg m-3 ppt-1 Pa-1] - real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect - !! to pressure [kg m-3 degC-1 Pa-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S + !! [kg m-3 ppt-2] or [R ppt-2 ~> kg m-3 ppt-2] + real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respect to T + !! [kg m-3 ppt-1 degC-1] or [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] + real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T + !! [kg m-3 degC-2] or [R degC-2 ~> kg m-3 degC-2] + real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure + !! [kg m-3 ppt-1 Pa-1] or [R ppt-1 Pa-1 ~> kg m-3 ppt-1 Pa-1] + real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] + type(EOS_type), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! from kg m-3 to the desired units [R m3 kg-1] if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -477,20 +531,31 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then + drho_dS_dS = scale * drho_dS_dS + drho_dS_dT = scale * drho_dS_dT + drho_dT_dT = scale * drho_dT_dT + drho_dS_dP = scale * drho_dS_dP + drho_dT_dP = scale * drho_dT_dP + endif ; endif + end subroutine calculate_density_second_derivs_scalar !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. -subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) +subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential - !! temperature [m3 kg-1 degC-1]. + !! temperature [m3 kg-1 degC-1] or [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity - !! [m3 kg-1 ppt-1]. - integer, intent(in) :: start !< Starting index within the array - integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + !! [m3 kg-1 ppt-1] or [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + integer, intent(in) :: start !< Starting index within the array + integer, intent(in) :: npts !< The number of values to calculate + type(EOS_type), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific volume + !! from m3 kg-1 to the desired units [kg m-3 R-1] + ! Local variables real, dimension(size(T)) :: dRho_dT, dRho_dS, rho integer :: j @@ -525,6 +590,12 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select + if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 + dSV_dT(j) = scale * dSV_dT(j) + dSV_dS(j) = scale * dSV_dS(j) + enddo ; endif ; endif + + end subroutine calculate_specific_vol_derivs !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array inputs. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 8f762dedd5..c82f3258b6 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -51,7 +51,7 @@ module MOM_diag_mediator public set_masks_for_axes public post_data_1d_k public safe_alloc_ptr, safe_alloc_alloc -public enable_averaging, disable_averaging, query_averaging_enabled +public enable_averaging, enable_averages, disable_averaging, query_averaging_enabled public diag_mediator_init, diag_mediator_end, set_diag_mediator_grid public diag_mediator_infrastructure_init public diag_mediator_close_registration, get_diag_time_end @@ -1807,8 +1807,7 @@ subroutine enable_averaging(time_int_in, time_end_in, diag_cs) type(time_type), intent(in) :: time_end_in !< The end time of the valid interval type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output -! This subroutine enables the accumulation of time averages over the -! specified time interval. +! This subroutine enables the accumulation of time averages over the specified time interval. ! if (num_file==0) return diag_cs%time_int = time_int_in @@ -1816,6 +1815,26 @@ subroutine enable_averaging(time_int_in, time_end_in, diag_cs) diag_cs%ave_enabled = .true. end subroutine enable_averaging +!> Enable the accumulation of time averages over the specified time interval in time units. +subroutine enable_averages(time_int, time_end, diag_CS, T_to_s) + real, intent(in) :: time_int !< The time interval over which any values + !! that are offered are valid [T ~> s]. + type(time_type), intent(in) :: time_end !< The end time of the valid interval. + type(diag_ctrl), intent(inout) :: diag_CS !< A structure that is used to regulate diagnostic output + real, optional, intent(in) :: T_to_s !< A conversion factor for time_int to [s]. +! This subroutine enables the accumulation of time averages over the specified time interval. + + if (present(T_to_s)) then + diag_cs%time_int = time_int*T_to_s + elseif (associated(diag_CS%US)) then + diag_cs%time_int = time_int*diag_CS%US%T_to_s + else + diag_cs%time_int = time_int + endif + diag_cs%time_end = time_end + diag_cs%ave_enabled = .true. +end subroutine enable_averages + !> Call this subroutine to avoid averaging any offered fields. subroutine disable_averaging(diag_cs) type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 5a84ca0001..829afb851f 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -25,60 +25,72 @@ module MOM_spatial_means contains !> Return the global area mean of a variable. This uses reproducing sums. -function global_area_mean(var,G) +function global_area_mean(var, G, scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to average + real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: global_area_mean + real :: scalefac ! An overall scaling factor for the areas and variable. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + scalefac = G%US%L_to_m**2 ; if (present(scale)) scalefac = G%US%L_to_m**2*scale + tmpForSumming(:,:) = 0. do j=js,je ; do i=is,ie - tmpForSumming(i,j) = var(i,j) * (G%US%L_to_m**2 * G%areaT(i,j) * G%mask2dT(i,j)) + tmpForSumming(i,j) = var(i,j) * (scalefac * G%areaT(i,j) * G%mask2dT(i,j)) enddo ; enddo global_area_mean = reproducing_sum(tmpForSumming) * (G%US%m_to_L**2 * G%IareaT_global) end function global_area_mean !> Return the global area integral of a variable. This uses reproducing sums. -function global_area_integral(var,G) +function global_area_integral(var, G, scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to integrate + real, optional, intent(in) :: scale !< A rescaling factor for the variable real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: global_area_integral + real :: scalefac ! An overall scaling factor for the areas and variable. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + scalefac = G%US%L_to_m**2 ; if (present(scale)) scalefac = G%US%L_to_m**2*scale + tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = var(i,j) * (G%US%L_to_m**2 * G%areaT(i,j) * G%mask2dT(i,j)) + tmpForSumming(i,j) = var(i,j) * (scalefac * G%areaT(i,j) * G%mask2dT(i,j)) enddo ; enddo global_area_integral = reproducing_sum(tmpForSumming) end function global_area_integral !> Return the layerwise global thickness-weighted mean of a variable. This uses reproducing sums. -function global_layer_mean(var, h, G, GV) +function global_layer_mean(var, h, G, GV, scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, optional, intent(in) :: scale !< A rescaling factor for the variable real, dimension(SZK_(GV)) :: global_layer_mean real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: tmpForSumming, weight real, dimension(SZK_(GV)) :: scalarij, weightij real, dimension(SZK_(GV)) :: global_temp_scalar, global_weight_scalar + real :: scalefac ! A scaling factor for the variable. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + scalefac = 1.0 ; if (present(scale)) scalefac = scale tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) - tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k) + tmpForSumming(i,j,k) = scalefac * var(i,j,k) * weight(i,j,k) enddo ; enddo ; enddo global_temp_scalar = reproducing_sum(tmpForSumming,sums=scalarij) @@ -91,25 +103,28 @@ function global_layer_mean(var, h, G, GV) end function global_layer_mean !> Find the global thickness-weighted mean of a variable. This uses reproducing sums. -function global_volume_mean(var, h, G, GV) +function global_volume_mean(var, h, G, GV, scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: var !< The variable being averaged real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, optional, intent(in) :: scale !< A rescaling factor for the variable real :: global_volume_mean !< The thickness-weighted average of var + real :: scalefac ! A scaling factor for the variable. real :: weight_here real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming, sum_weight integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + scalefac = 1.0 ; if (present(scale)) scalefac = scale tmpForSumming(:,:) = 0. ; sum_weight(:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie weight_here = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) - tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * weight_here + tmpForSumming(i,j) = tmpForSumming(i,j) + scalefac * var(i,j,k) * weight_here sum_weight(i,j) = sum_weight(i,j) + weight_here enddo ; enddo ; enddo global_volume_mean = (reproducing_sum(tmpForSumming)) / & @@ -119,7 +134,7 @@ end function global_volume_mean !> Find the global mass-weighted integral of a variable. This uses reproducing sums. -function global_mass_integral(h, G, GV, var, on_PE_only) +function global_mass_integral(h, G, GV, var, on_PE_only, scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -128,25 +143,28 @@ function global_mass_integral(h, G, GV, var, on_PE_only) optional, intent(in) :: var !< The variable being integrated logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only !! done on the local PE, and it is _not_ order invariant. + real, optional, intent(in) :: scale !< A rescaling factor for the variable real :: global_mass_integral !< The mass-weighted integral of var (or 1) in !! kg times the units of var real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: scalefac ! An overall scaling factor for the areas and variable. logical :: global_sum integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + scalefac = G%US%L_to_m**2 ; if (present(scale)) scalefac = G%US%L_to_m**2*scale tmpForSumming(:,:) = 0.0 if (present(var)) then do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (scalefac*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo else do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (scalefac*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo endif global_sum = .true. ; if (present(on_PE_only)) global_sum = .not.on_PE_only @@ -164,15 +182,17 @@ end function global_mass_integral !> Determine the global mean of a field along rows of constant i, returning it !! in a 1-d array using the local indexing. This uses reproducing sums. -subroutine global_i_mean(array, i_mean, G, mask) +subroutine global_i_mean(array, i_mean, G, mask, scale) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged real, dimension(SZJ_(G)), intent(out) :: i_mean !< Global mean of array along its i-axis real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: mask !< An array used for weighting the i-mean + real, optional, intent(in) :: scale !< A rescaling factor for the variable ! Local variables type(EFP_type), allocatable, dimension(:) :: asum, mask_sum + real :: scalefac ! A scaling factor for the variable. real :: mask_sum_r integer :: is, ie, js, je, idg_off, jdg_off integer :: i, j @@ -180,6 +200,7 @@ subroutine global_i_mean(array, i_mean, G, mask) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec idg_off = G%idg_offset ; jdg_off = G%jdg_offset + scalefac = 1.0 ; if (present(scale)) scalefac = scale call reset_EFP_overflow_error() allocate(asum(G%jsg:G%jeg)) @@ -191,7 +212,7 @@ subroutine global_i_mean(array, i_mean, G, mask) enddo do i=is,ie ; do j=js,je - asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(array(i,j)*mask(i,j)) + asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(scalefac*array(i,j)*mask(i,j)) mask_sum(j+jdg_off) = mask_sum(j+jdg_off) + real_to_EFP(mask(i,j)) enddo ; enddo @@ -216,7 +237,7 @@ subroutine global_i_mean(array, i_mean, G, mask) do j=G%jsg,G%jeg ; asum(j) = real_to_EFP(0.0) ; enddo do i=is,ie ; do j=js,je - asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(array(i,j)) + asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(scalefac*array(i,j)) enddo ; enddo if (query_EFP_overflow_error()) call MOM_error(FATAL, & @@ -238,22 +259,25 @@ end subroutine global_i_mean !> Determine the global mean of a field along rows of constant j, returning it !! in a 1-d array using the local indexing. This uses reproducing sums. -subroutine global_j_mean(array, j_mean, G, mask) +subroutine global_j_mean(array, j_mean, G, mask, scale) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged real, dimension(SZI_(G)), intent(out) :: j_mean !< Global mean of array along its j-axis real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: mask !< An array used for weighting the j-mean + real, optional, intent(in) :: scale !< A rescaling factor for the variable ! Local variables type(EFP_type), allocatable, dimension(:) :: asum, mask_sum real :: mask_sum_r + real :: scalefac ! A scaling factor for the variable. integer :: is, ie, js, je, idg_off, jdg_off integer :: i, j is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec idg_off = G%idg_offset ; jdg_off = G%jdg_offset + scalefac = 1.0 ; if (present(scale)) scalefac = scale call reset_EFP_overflow_error() allocate(asum(G%isg:G%ieg)) @@ -265,7 +289,7 @@ subroutine global_j_mean(array, j_mean, G, mask) enddo do i=is,ie ; do j=js,je - asum(i+idg_off) = asum(i+idg_off) + real_to_EFP(array(i,j)*mask(i,j)) + asum(i+idg_off) = asum(i+idg_off) + real_to_EFP(scalefac*array(i,j)*mask(i,j)) mask_sum(i+idg_off) = mask_sum(i+idg_off) + real_to_EFP(mask(i,j)) enddo ; enddo @@ -290,7 +314,7 @@ subroutine global_j_mean(array, j_mean, G, mask) do i=G%isg,G%ieg ; asum(i) = real_to_EFP(0.0) ; enddo do i=is,ie ; do j=js,je - asum(i+idg_off) = asum(i+idg_off) + real_to_EFP(array(i,j)) + asum(i+idg_off) = asum(i+idg_off) + real_to_EFP(scalefac*array(i,j)) enddo ; enddo if (query_EFP_overflow_error()) call MOM_error(FATAL, & @@ -311,22 +335,28 @@ subroutine global_j_mean(array, j_mean, G, mask) end subroutine global_j_mean !> Adjust 2d array such that area mean is zero without moving the zero contour -subroutine adjust_area_mean_to_zero(array, G, scaling) +subroutine adjust_area_mean_to_zero(array, G, scaling, unit_scale) type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: array !< 2D array to be adjusted real, optional, intent(out) :: scaling !< The scaling factor used + real, optional, intent(in) :: unit_scale !< A rescaling factor for the variable ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: posVals, negVals, areaXposVals, areaXnegVals integer :: i,j + real :: scalefac ! A scaling factor for the variable. + real :: I_scalefac ! The Adcroft reciprocal of scalefac real :: areaIntPosVals, areaIntNegVals, posScale, negScale + scalefac = 1.0 ; if (present(unit_scale)) scalefac = unit_scale + I_scalefac = 0.0 ; if (scalefac /= 0.0) I_scalefac = 1.0 / scalefac + areaXposVals(:,:) = 0. areaXnegVals(:,:) = 0. do j=G%jsc,G%jec ; do i=G%isc,G%iec - posVals(i,j) = max(0., array(i,j)) + posVals(i,j) = max(0., scalefac*array(i,j)) areaXposVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * posVals(i,j) - negVals(i,j) = min(0., array(i,j)) + negVals(i,j) = min(0., scalefac*array(i,j)) areaXnegVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * negVals(i,j) enddo ; enddo @@ -338,12 +368,12 @@ subroutine adjust_area_mean_to_zero(array, G, scaling) if (areaIntPosVals>-areaIntNegVals) then ! Scale down positive values posScale = - areaIntNegVals / areaIntPosVals do j=G%jsc,G%jec ; do i=G%isc,G%iec - array(i,j) = (posScale * posVals(i,j)) + negVals(i,j) + array(i,j) = ((posScale * posVals(i,j)) + negVals(i,j)) * I_scalefac enddo ; enddo elseif (areaIntPosVals<-areaIntNegVals) then ! Scale down negative values negScale = - areaIntPosVals / areaIntNegVals do j=G%jsc,G%jec ; do i=G%isc,G%iec - array(i,j) = posVals(i,j) + (negScale * negVals(i,j)) + array(i,j) = (posVals(i,j) + (negScale * negVals(i,j))) * I_scalefac enddo ; enddo endif endif diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index ca174025bf..fe7f95fc79 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -16,8 +16,10 @@ module MOM_unit_scaling real :: Z_to_m !< A constant that translates distances in the units of depth to meters. real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths. real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters. - real :: s_to_T !< A constant that time intervals in seconds to the units of time. - real :: T_to_s !< A constant that the units of time to seconds. + real :: s_to_T !< A constant that translates time intervals in seconds to the units of time. + real :: T_to_s !< A constant that translates the units of time to seconds. + real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. + real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. ! These are useful combinations of the fundamental scale conversion factors above. real :: Z_to_L !< Convert vertical distances to lateral lengths @@ -32,6 +34,7 @@ module MOM_unit_scaling real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. real :: m_to_L_restart = 0.0 !< A copy of the m_to_L that is used in restart files. real :: s_to_T_restart = 0.0 !< A copy of the s_to_T that is used in restart files. + real :: kg_m3_to_R_restart = 0.0 !< A copy of the kg_m3_to_R that is used in restart files. end type unit_scale_type contains @@ -44,8 +47,8 @@ subroutine unit_scaling_init( param_file, US ) ! This routine initializes a unit_scale_type structure (US). ! Local variables - integer :: Z_power, L_power, T_power - real :: Z_rescale_factor, L_rescale_factor, T_rescale_factor + integer :: Z_power, L_power, T_power, R_power + real :: Z_rescale_factor, L_rescale_factor, T_rescale_factor, R_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = "MOM_unit_scaling" @@ -69,12 +72,18 @@ subroutine unit_scaling_init( param_file, US ) "An integer power of 2 that is used to rescale the model's "//& "intenal units of time. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) + call get_param(param_file, mdl, "R_RESCALE_POWER", R_power, & + "An integer power of 2 that is used to rescale the model's "//& + "intenal units of density. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") if (abs(L_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "L_RESCALE_POWER is outside of the valid range of -300 to 300.") if (abs(T_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "T_RESCALE_POWER is outside of the valid range of -300 to 300.") + if (abs(R_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "R_RESCALE_POWER is outside of the valid range of -300 to 300.") Z_rescale_factor = 1.0 if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power @@ -91,6 +100,11 @@ subroutine unit_scaling_init( param_file, US ) US%T_to_s = 1.0 * T_rescale_factor US%s_to_T = 1.0 / T_rescale_factor + R_rescale_factor = 1.0 + if (R_power /= 0) R_rescale_factor = 2.0**R_power + US%R_to_kg_m3 = 1.0 * R_rescale_factor + US%kg_m3_to_R = 1.0 / R_rescale_factor + ! These are useful combinations of the fundamental scale conversion factors set above. US%Z_to_L = US%Z_to_m * US%m_to_L US%L_to_Z = US%L_to_m * US%m_to_Z @@ -111,6 +125,7 @@ subroutine fix_restart_unit_scaling(US) US%m_to_Z_restart = US%m_to_Z US%m_to_L_restart = US%m_to_L US%s_to_T_restart = US%s_to_T + US%kg_m3_to_R_restart = US%kg_m3_to_R end subroutine fix_restart_unit_scaling diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index d07fe42676..d82910df81 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -190,8 +190,9 @@ module MOM_ice_shelf !! formulation (optional to use just two equations). !! See \ref section_ICE_SHELF_equations subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) - type(surface), intent(inout) :: state !< structure containing fields that - !!describe the surface state of the ocean + type(surface), intent(inout) :: state !< A structure containing fields that + !! describe the surface state of the ocean. The + !! intent is only inout to allow for halo updates. type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible !! thermodynamic or mass-flux forcing fields. type(time_type), intent(in) :: Time !< Start time of the fluxes. @@ -336,7 +337,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) do i=is,ie ; p_int(i) = CS%g_Earth * ISS%mass_shelf(i,j) ; enddo ! Calculate insitu densities and expansion coefficients - call calculate_density(state%sst(:,j),state%sss(:,j), p_int, & + call calculate_density(state%sst(:,j), state%sss(:,j), p_int, & Rhoml(:), is, ie-is+1, CS%eqn_of_state) call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, & dR0_dT, dR0_dS, is, ie-is+1, CS%eqn_of_state) @@ -363,15 +364,20 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) v_at_h = state%v(i,j) !### I think that CS%utide**1 should be CS%utide**2 + ! Also I think that if taux_shelf and tauy_shelf have been calculated by the + ! ocean stress calculation, they should be used here or later to set ustar_shelf. - RWH fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s * & sqrt(CS%cdrag*((u_at_h**2 + v_at_h**2) + CS%utide(i,j)**1))) ustar_h = US%Z_to_m*US%s_to_T*fluxes%ustar_shelf(i,j) - if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then - state%taux_shelf(i,j) = ustar_h*ustar_h*CS%Rho0*Isqrt2 - state%tauy_shelf(i,j) = state%taux_shelf(i,j) - endif + ! I think that the following can be deleted without causing any problems. + ! if (allocated(state%taux_shelf) .and. allocated(state%tauy_shelf)) then + ! ! These arrays are supposed to be stress components at C-grid points, which is + ! ! inconsistent with what is coded up here. + ! state%taux_shelf(i,j) = ustar_h*ustar_h*CS%Rho0*Isqrt2 + ! state%tauy_shelf(i,j) = state%taux_shelf(i,j) + ! endif ! Estimate the neutral ocean boundary layer thickness as the minimum of the ! reported ocean mixed layer thickness and the neutral Ekman depth. @@ -913,15 +919,14 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) ! vertical decay scale. if (CS%debug) then - if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then + if (allocated(state%taux_shelf) .and. allocated(state%tauy_shelf)) then call uvchksum("tau[xy]_shelf", state%taux_shelf, state%tauy_shelf, & G%HI, haloshift=0) endif endif - if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then + if (allocated(state%taux_shelf) .and. allocated(state%tauy_shelf)) then call pass_vector(state%taux_shelf, state%tauy_shelf, G%domain, TO_ALL, CGRID_NE) - endif ! GMM: melting is computed using ustar_shelf (and not ustar), which has already ! been passed, I so believe we do not need to update fluxes%ustar. ! Irho0 = 1.0 / CS%Rho0 @@ -941,6 +946,7 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) ! fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s*sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo + endif if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then do j=jsd,jed ; do i=isd,ied @@ -961,10 +967,10 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 if (associated(fluxes%lprec)) then if (ISS%water_flux(i,j) > 0.0) then - fluxes%lprec(i,j) = frac_area*ISS%water_flux(i,j)*CS%flux_factor + fluxes%lprec(i,j) = US%kg_m3_to_R*US%m_to_Z*US%T_to_s*frac_area*ISS%water_flux(i,j)*CS%flux_factor else fluxes%lprec(i,j) = 0.0 - fluxes%evap(i,j) = frac_area*ISS%water_flux(i,j)*CS%flux_factor + fluxes%evap(i,j) = US%kg_m3_to_R*US%m_to_Z*US%T_to_s*frac_area*ISS%water_flux(i,j)*CS%flux_factor endif endif @@ -1054,6 +1060,8 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then fluxes%vprec(i,j) = -mean_melt_flux * CS%density_ice/1000. ! evap is negative fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! W /m^2 + ! Rescale fluxes%vprec to the proper units. + fluxes%vprec(i,j) = US%kg_m3_to_R*US%m_to_Z*US%T_to_s * fluxes%vprec(i,j) fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! kg (salt)/(m^2 s) endif enddo ; enddo diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 16b543387d..4042681803 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -15,6 +15,7 @@ module MOM_marine_ice use MOM_forcing_type, only : forcing, mech_forcing use MOM_grid, only : ocean_grid_type use MOM_time_manager, only : time_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -102,9 +103,10 @@ end subroutine iceberg_forces !> iceberg_fluxes adds ice-area-coverage and modifies various !! thermodynamic fluxes due to the presence of icebergs. -subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & +subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, & time_step, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< A structure containing fields that @@ -113,8 +115,8 @@ subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & real, intent(in) :: time_step !< The coupling time step [s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice - real :: fraz ! refreezing rate [kg m-2 s-1] - real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion [kg J-1 s-1]. + real :: fraz ! refreezing rate [R Z T-1 ~> kg m-2 s-1] + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion [kg J-1 T-1 ~> kg J-1 s-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed @@ -142,7 +144,7 @@ subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & !Zero'ing out other fluxes under the tabular icebergs if (CS%berg_area_threshold >= 0.) then - I_dt_LHF = 1.0 / (time_step * CS%latent_heat_fusion) + I_dt_LHF = 1.0 / (US%s_to_T*time_step * CS%latent_heat_fusion) do j=jsd,jed ; do i=isd,ied if (fluxes%frac_shelf_h(i,j) > CS%berg_area_threshold) then ! Only applying for ice shelf covering most of cell. @@ -153,13 +155,14 @@ subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 ! Add frazil formation diagnosed by the ocean model [J m-2] in the - ! form of surface layer evaporation [kg m-2 s-1]. Update lprec in the + ! form of surface layer evaporation [R Z T-1 ~> kg m-2 s-1]. Update lprec in the ! control structure for diagnostic purposes. if (associated(sfc_state%frazil)) then - fraz = sfc_state%frazil(i,j) * I_dt_LHF - if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz - !CS%lprec(i,j)=CS%lprec(i,j) - fraz + fraz = US%kg_m3_to_R*US%m_to_Z*sfc_state%frazil(i,j) * I_dt_LHF + if (associated(fluxes%evap)) & + fluxes%evap(i,j) = fluxes%evap(i,j) - fraz + ! fluxes%lprec(i,j) = fluxes%lprec(i,j) - fraz sfc_state%frazil(i,j) = 0.0 endif diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index fd77676008..b2519d47ad 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -97,17 +97,17 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept case ("file") call set_coord_from_file(GV%Rlay, GV%g_prime, GV, US, PF) case ("USER") - call user_set_coord(GV%Rlay, GV%g_prime, GV, PF, eos) + call user_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) case ("BFB") - call BFB_set_coord(GV%Rlay, GV%g_prime, GV, PF, eos) + call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) case ("none", "ALE") call set_coord_to_none(GV%Rlay, GV%g_prime, GV, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize_coord: "// & "Unrecognized coordinate setup"//trim(config)) end select - if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) + if (debug) call chksum(US%R_to_kg_m3*GV%Rlay(:), "MOM_initialize_coord: Rlay ", 1, nz) if (debug) call chksum(US%m_to_Z*US%L_to_m**2*US%s_to_T**2*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) - call setVerticalGridAxes( GV%Rlay, GV ) + call setVerticalGridAxes( GV%Rlay, GV, scale=US%R_to_kg_m3 ) ! Copy the maximum depth across from the input argument GV%max_depth = max_depth @@ -124,7 +124,7 @@ end subroutine MOM_initialize_coord !> Sets the layer densities (Rlay) and the interface reduced gravities (g). subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -158,7 +158,7 @@ end subroutine set_coord_from_gprime !> Sets the layer densities (Rlay) and the interface reduced gravities (g). subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -179,10 +179,10 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & - units="kg m-3", default=GV%Rho0) + units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DENSITY_RANGE", Rlay_range, & "The range of reference potential densities in the layers.", & - units="kg m-3", default=2.0) + units="kg m-3", default=2.0, scale=US%kg_m3_to_R) g_prime(1) = g_fs Rlay(1) = Rlay_Ref @@ -191,7 +191,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -201,7 +201,7 @@ end subroutine set_coord_from_layer_density subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -240,7 +240,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state ! The uppermost layer's density is set here. Subsequent layers' ! ! densities are determined from this value and the g values. ! ! T0 = 28.228 ; S0 = 34.5848 ; Pref = P_Ref - call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) + call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state, scale=US%kg_m3_to_R) ! These statements set the layer densities. ! do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo @@ -252,7 +252,7 @@ end subroutine set_coord_from_TS_ref subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -290,17 +290,17 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo - call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + call calculate_density(T0, S0, Pref, Rlay, 1, nz, eqn_of_state, scale=US%kg_m3_to_R) + do k=2,nz; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a linear T-S profile. subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & - eqn_of_state, P_Ref) + eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -370,12 +370,12 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo - call calculate_density(T0, S0, Pref, Rlay, k_light,nz-k_light+1,eqn_of_state) + call calculate_density(T0, S0, Pref, Rlay, k_light, nz-k_light+1, eqn_of_state, scale=US%kg_m3_to_R) ! Extrapolate target densities for the variable density mixed and buffer layers. do k=k_light-1,1,-1 - Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) + Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz ; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -383,7 +383,7 @@ end subroutine set_coord_from_TS_range ! Sets the layer densities (Rlay) and the interface reduced gravities (g) from data in file. subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -416,8 +416,9 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) " set_coord_from_file: Unable to open "//trim(filename)) call read_axis_data(filename, coord_var, Rlay) + do k=1,nz ; Rlay(k) = US%kg_m3_to_R*Rlay(k) ; enddo g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -434,7 +435,7 @@ end subroutine set_coord_from_file !! (defaulting to 2.0 if not defined) subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -450,10 +451,10 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for the surface interface.", & - units="kg m-3", default=GV%Rho0) + units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DENSITY_RANGE", Rlay_range, & "The range of reference potential densities across all interfaces.", & - units="kg m-3", default=2.0) + units="kg m-3", default=2.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) @@ -467,7 +468,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -478,7 +479,7 @@ end subroutine set_coord_linear !! might be used. subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density) [kg m-3]. + !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -525,7 +526,7 @@ subroutine write_vertgrid_file(GV, US, param_file, directory) call create_file(unit, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) - call write_field(unit, fields(1), GV%Rlay) + call write_field(unit, fields(1), US%R_to_kg_m3*GV%Rlay(:)) call write_field(unit, fields(2), US%L_T_to_m_s**2*US%m_to_Z*GV%g_prime(:)) call close_file(unit) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 96447c4212..da0b986303 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -318,7 +318,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("soliton"); call soliton_initialize_thickness(h, G, GV, US) case ("phillips"); call Phillips_initialize_thickness(h, G, GV, US, PF, & just_read_params=just_read) - case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, & + case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) case ("USER"); call user_initialize_thickness(h, G, GV, PF, & just_read_params=just_read) @@ -351,12 +351,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & fail_if_missing=new_sim, do_not_log=just_read) ! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& select case (trim(config)) - case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, PF, & + case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, & eos, tv%P_Ref, just_read_params=just_read) case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, & PF, just_read_params=just_read) case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & - G, GV, PF, eos, tv%P_Ref, just_read_params=just_read) + G, GV, US, PF, eos, tv%P_Ref, just_read_params=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & G, PF, just_read_params=just_read) case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, PF, & @@ -364,7 +364,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, US, PF, eos, just_read_params=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & @@ -544,7 +544,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("RGC"); call RGC_initialize_sponges(G, GV, tv, u, v, PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, US, tv, u, v, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & @@ -952,7 +952,7 @@ subroutine convert_thickness(h, G, GV, US, tv) max_itt = 10 Boussinesq = GV%Boussinesq I_gEarth = 1.0 / (GV%mks_g_Earth) - Hm_rho_to_Pa = GV%mks_g_Earth * GV%H_to_m ! = GV%H_to_Pa / GV%Rho0 + Hm_rho_to_Pa = GV%mks_g_Earth * GV%H_to_m ! = GV%H_to_Pa / (US%R_to_kg_m3*GV%Rho0) if (Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") @@ -993,9 +993,7 @@ subroutine convert_thickness(h, G, GV, US, tv) enddo else do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = (h(i,j,k) * GV%Rlay(k)) * Hm_rho_to_Pa * GV%kg_m2_to_H**2 - ! This is mathematically equivalent to - ! h(i,j,k) = h(i,j,k) * (GV%Rlay(k) / GV%Rho0) + h(i,j,k) = h(i,j,k) * (GV%Rlay(k) / GV%Rho0) enddo ; enddo ; enddo endif endif @@ -1154,7 +1152,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, GV%mks_g_Earth*US%Z_to_m, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, US, GV%mks_g_Earth*US%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*US%m_to_Z) @@ -1165,11 +1163,12 @@ end subroutine trim_for_ice !> Adjust the layer thicknesses by removing the top of the water column above the !! depth where the hydrostatic pressure matches p_surf -subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & +subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, & T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS, z_tol) integer, intent(in) :: nk !< Number of layers type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: G_earth !< Gravitational acceleration [m2 Z-1 s-2 ~> m s-2] real, intent(in) :: depth !< Depth of ocean column [Z ~> m]. real, intent(in) :: min_thickness !< Smallest thickness allowed [Z ~> m]. @@ -1203,7 +1202,7 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & + P_t, p_surf, US%R_to_kg_m3*GV%Rho0, G_earth, tv%eqn_of_state, & P_b, z_out, z_tol=z_tol) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell @@ -1530,13 +1529,14 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para end subroutine initialize_temp_salt_from_profile !> Initializes temperature and salinity by fitting to density -subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref, just_read_params) +subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is !! being initialized [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being !! initialized [ppt]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the equatio of state. @@ -1550,9 +1550,9 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref real :: T_Ref ! Reference Temperature [degC] real :: S_Ref ! Reference Salinity [ppt] real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_fit" ! This subroutine's name. @@ -1581,8 +1581,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref T0(k) = T_Ref enddo - call calculate_density(T0(1),S0(1),pres(1),rho_guess(1),eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) + call calculate_density(T0(1),S0(1),pres(1),rho_guess(1),eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state, scale=US%kg_m3_to_R) if (fit_salin) then ! A first guess of the layers' temperatures. @@ -1591,8 +1591,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref enddo ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS(k)) enddo @@ -1603,8 +1603,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT(1) enddo do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -1851,7 +1851,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C do j=js,je call calculate_density(tmp(:,j,1), tmp2(:,j,1), pres, tmp_2d(:,j), & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo call set_up_sponge_ML_density(tmp_2d, G, CSp) @@ -1967,6 +1967,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param integer :: kd, inconsistent integer :: nkd ! number of levels to use for regridding input arrays real :: eps_Z ! A negligibly thin layer thickness [Z ~> m]. + real :: eps_rho ! A negligibly small density difference [R ~> kg m-3]. real :: PI_180 ! for conversion from degrees to radians real, dimension(:,:), pointer :: shelf_area => NULL() @@ -1986,9 +1987,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param logical :: debug = .false. ! manually set this to true for verbose output ! data arrays - real, dimension(:), allocatable :: z_edges_in, z_in, Rb + real, dimension(:), allocatable :: z_edges_in, z_in + real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z - real, dimension(:,:,:), allocatable :: rho_z + real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press ! Pressures [Pa]. @@ -2113,6 +2115,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param !### Change this to GV%Angstrom_Z eps_z = 1.0e-10*US%m_to_Z + eps_rho = 1.0e-10*US%kg_m3_to_R ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the @@ -2152,7 +2155,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param call convert_temp_salt_for_TEOS10(temp_z, salt_z, press, G, kd, mask_z, eos) do k=1,kd ; do j=js,je - call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, & + eos, scale=US%kg_m3_to_R) enddo ; enddo call pass_var(temp_z,G%Domain) @@ -2284,11 +2288,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Rb contains the layer interface densities allocate(Rb(nz+1)) - do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo + do k=2,nz ; Rb(k) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & - nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z) + nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z, & + eps_rho=eps_rho) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, US, zi, h) @@ -2359,7 +2364,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param if (adjust_temperature .and. .not. useALEremapping) then call determine_temperature(tv%T(is:ie,js:je,:), tv%S(is:ie,js:je,:), & - GV%Rlay(1:nz), tv%p_ref, niter, missing_value, h(is:ie,js:je,:), ks, eos) + US%R_to_kg_m3*GV%Rlay(1:nz), tv%p_ref, niter, missing_value, h(is:ie,js:je,:), ks, eos) endif @@ -2405,15 +2410,15 @@ subroutine MOM_state_init_tests(G, GV, US, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%mks_g_Earth*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -US%R_to_kg_m3*GV%Rho0*GV%mks_g_Earth*z(k), & rho(k), tv%eqn_of_state) P_tot = P_tot + GV%mks_g_Earth * rho(k) * h(k) enddo P_t = 0. do k = 1, nk - call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, GV%mks_g_Earth, tv%eqn_of_state, P_b, z_out) + call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), P_t, 0.5*P_tot, & + US%R_to_kg_m3*GV%Rho0, GV%mks_g_Earth, tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2423,8 +2428,8 @@ subroutine MOM_state_init_tests(G, GV, US, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV, GV%mks_g_Earth, -e(nk+1), GV%Angstrom_H, & - T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) + call cut_off_column_top(nk, tv, GV, US, GV%mks_g_Earth, -e(nk+1), GV%Angstrom_H, & + T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h end subroutine MOM_state_init_tests diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index a985cf2982..f33d476cf0 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -559,12 +559,12 @@ function find_limited_slope(val, e, k) result(slope) end function find_limited_slope !> Find interface positions corresponding to density profile -function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z) result(zi) +function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z, eps_rho) result(zi) real, dimension(:,:,:), & - intent(in) :: rho !< potential density in z-space [kg m-3] + intent(in) :: rho !< potential density in z-space [kg m-3 or R ~> kg m-3] real, dimension(size(rho,3)), & - intent(in) :: zin !< Input data levels [Z ~> m or m]. - real, dimension(:), intent(in) :: Rb !< target interface densities [kg m-3] + intent(in) :: zin !< Input data levels [m or Z ~> m]. + real, dimension(:), intent(in) :: Rb !< target interface densities [kg m-3 or R ~> kg m-3] real, dimension(size(rho,1),size(rho,2)), & intent(in) :: depth !< ocean depth [Z ~> m]. real, dimension(size(rho,1),size(rho,2)), & @@ -573,11 +573,12 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps integer, optional, intent(in) :: nkml !< number of mixed layer pieces integer, optional, intent(in) :: nkbl !< number of buffer layer pieces real, optional, intent(in) :: hml !< mixed layer depth [Z ~> m]. - real, optional, intent(in) :: eps_z !< A negligibly small layer thickness [Z ~> m or m]. + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness [m or Z ~> m]. + real, optional, intent(in) :: eps_rho !< A negligibly small density difference [kg m-3 or R ~> kg m-3]. real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. ! Local variables - real, dimension(size(rho,1),size(rho,3)) :: rho_ + real, dimension(size(rho,1),size(rho,3)) :: rho_ ! A slice of densities [R ~> kg m-3] real, dimension(size(rho,1)) :: depth_ logical :: unstable integer :: dir @@ -589,8 +590,8 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps integer :: n,i,j,k,l,nx,ny,nz,nt integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. - real :: epsln_Z ! A negligibly thin layer thickness [Z ~> m]. - real :: epsln_rho ! A negligibly small density change [kg m-3]. + real :: epsln_Z ! A negligibly thin layer thickness [m or Z ~> m]. + real :: epsln_rho ! A negligibly small density change [kg m-3 or R ~> kg m-3]. real, parameter :: zoff=0.999 nlay=size(Rb)-1 @@ -606,7 +607,7 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps nkbl_ = 0 ; if (PRESENT(nkbl)) nkbl_ = max(0, nkbl) hml_ = 0.0 ; if (PRESENT(hml)) hml_ = hml epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z - epsln_rho = 1.0e-10 + epsln_rho = 1.0e-10 ; if (PRESENT(eps_rho)) epsln_rho = eps_rho if (PRESENT(nlevs)) then nlevs_data(:,:) = nlevs(:,:) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index bd3da3c2b7..55a9a71304 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -108,20 +108,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. - real, intent(in) :: dt !< Model(baroclinic) time-step [s]. + real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - mass, & ! The total mass of the water column [kg m-2]. - I_mass, & ! The inverse of mass [m2 kg-1]. + mass, & ! The total mass of the water column [R Z ~> kg m-2]. + I_mass, & ! The inverse of mass [R-1 Z-1 ~> m2 kg-1]. src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3). MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. - ! MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. - ! MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. - ! MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. drag_rate_J15, & ! The MEKE spindown timescale due to bottom drag with the Jansen 2015 scheme. @@ -154,9 +151,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real :: cdrag2 real :: advFac ! The product of the advection scaling factor and some unit conversion ! factors divided by the timestep [m H-1 T-1 ~> s-1 or m3 kg-1 s-1] - real :: mass_neglect ! A negligible mass [kg m-2]. + real :: mass_neglect ! A negligible mass [R Z ~> kg m-2]. real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. - real :: Rho0 ! A density used to convert mass to distance [kg m-3]. + real :: Rho0 ! A density used to convert mass to distance [R ~> kg m-3]. real :: sdt ! dt to use locally [T ~> s] (could be scaled to accelerate) real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite @@ -185,19 +182,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%debug) then if (associated(MEKE%mom_src)) & - call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3) if (associated(MEKE%GME_snk)) & - call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3) if (associated(MEKE%GM_src)) & - call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3) if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif - sdt = US%s_to_T*dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping - Rho0 = GV%H_to_kg_m2 * GV%m_to_H - mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff + sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + Rho0 = GV%Rho0 + mass_neglect = GV%H_to_RZ * GV%H_subroundoff cdrag2 = CS%cdrag**2 ! With a depth-dependent (and possibly strong) damping, it seems @@ -265,7 +262,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js-1,je+1 do i=is-1,ie+1 ; mass(i,j) = 0.0 ; enddo do k=1,nz ; do i=is-1,ie+1 - mass(i,j) = mass(i,j) + G%mask2dT(i,j) * (GV%H_to_kg_m2 * h(i,j,k)) + mass(i,j) = mass(i,j) + G%mask2dT(i,j) * (GV%H_to_RZ * h(i,j,k)) enddo ; enddo do i=is-1,ie+1 I_mass(i,j) = 0.0 @@ -282,11 +279,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, scale=US%Z_to_m*US%s_to_T) - call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) - call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI, scale=US%L_T_to_m_s) - call hchksum(bottomFac2, 'MEKE bottomFac2',G%HI) - call hchksum(barotrFac2, 'MEKE barotrFac2',G%HI) - call hchksum(LmixScale, 'MEKE LmixScale',G%HI,scale=US%L_to_m) + call hchksum(mass, 'MEKE mass',G%HI,haloshift=1, scale=US%R_to_kg_m3*US%Z_to_m) + call hchksum(drag_rate_visc, 'MEKE drag_rate_visc', G%HI, scale=US%L_T_to_m_s) + call hchksum(bottomFac2, 'MEKE bottomFac2', G%HI) + call hchksum(barotrFac2, 'MEKE barotrFac2', G%HI) + call hchksum(LmixScale, 'MEKE LmixScale', G%HI,scale=US%L_to_m) endif ! Aggregate sources of MEKE (background, frictional and GM) @@ -314,7 +311,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & - MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant (1 m?). + (GV%Rho0 * MAX(1.0*US%m_to_Z, G%bathyT(i,j))) enddo ; enddo else !$OMP parallel do default(shared) @@ -334,7 +331,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (US%L_to_m*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & + drag_rate(i,j) = (US%L_to_Z*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo endif @@ -364,6 +361,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Here the units of MEKE_uflux are [L2 T-2]. MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + ! This would have units of [R Z L2 T-2] ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) @@ -373,6 +371,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Here the units of MEKE_vflux are [L2 T-2]. MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + ! This would have units of [R Z L2 T-2] ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) @@ -395,7 +394,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h max(G%IareaT(i,j), G%IareaT(i+1,j)))**2 if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max - ! Here the units of MEKE_uflux are [kg m-2 L4 T-3]. + ! Here the units of MEKE_uflux are [R Z L4 T-3]. MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) @@ -437,7 +436,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. + ! Here the units of MEKE_uflux and MEKE_vflux are [R Z L4 T-3]. MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) @@ -452,15 +451,15 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. + ! Here the units of MEKE_uflux and MEKE_vflux are [R Z L4 T-3]. MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then !### I think that for dimensional consistency, this should be: - ! advFac = GV%H_to_kg_m2 * CS%MEKE_advection_factor / (US%s_to_T*dt) - advFac = GV%H_to_m * CS%MEKE_advection_factor / (US%s_to_T*dt) + ! advFac = GV%H_to_RZ * CS%MEKE_advection_factor / sdt + advFac = US%kg_m3_to_R*GV%H_to_Z * CS%MEKE_advection_factor / dt !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. @@ -506,7 +505,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (use_drag_rate) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (US%L_to_m*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & + drag_rate(i,j) = (US%L_to_Z*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo !$OMP parallel do default(shared) @@ -640,7 +639,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution !! to the MEKE drag rate [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [R-1 Z-1 ~> m2 kg-1]. ! Local variables real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] real :: SN ! The local Eady growth rate [T-1 ~> s-1] @@ -658,7 +657,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: FatH ! Coriolis parameter at h points; to compute topographic beta [T-1 ~> s-1] real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je, n1, n2 - real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. + real :: tolerance ! Width of EKE bracket [L2 T-2 ~> m2 s-2]. logical :: useSecant, debugIteration is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -667,6 +666,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m KhCoeff = CS%MEKE_KhCoeff Ubg2 = CS%MEKE_Uscale**2 cd2 = CS%cdrag**2 + tolerance = 1.0e-12*US%m_s_to_L_T**2 !$OMP do do j=js,je ; do i=is,ie @@ -697,7 +697,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + & (G%dF_dy(i,j) + beta_topo_y)**2 ) - I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) + I_H = US%L_to_Z*GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then ! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E @@ -732,7 +732,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m EKEmax = 10. * EKE ! and guess again for the right bracket if (resid 2.e17) then + if (EKEmax > 2.e17*US%m_s_to_L_T**2) then if (debugIteration) stop 'Something has gone very wrong' debugIteration = .true. resid = 1. ; n1 = 0 @@ -746,7 +746,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! Bisect the bracket n2 = 0 ; EKEerr = EKEmax - EKEmin - do while (US%L_T_to_m_s**2*EKEerr>tolerance) + do while (EKEerr > tolerance) n2 = n2 + 1 if (useSecant) then EKE = EKEmin + (EKEmax - EKEmin) * (ResMin / (ResMin - ResMax)) @@ -778,7 +778,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m EKE = 0. endif if (CS%MEKE_equilibrium_alt) then - MEKE%MEKE(i,j) = (US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 + MEKE%MEKE(i,j) = (US%Z_to_L*G%bathyT(i,j) * SN / (8*CS%cdrag))**2 else MEKE%MEKE(i,j) = EKE endif @@ -1178,13 +1178,16 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & 'MEKE decay rate', 's-1', conversion=US%s_to_T) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & - 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) + 'MEKE energy available from thickness mixing', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & - 'MEKE energy available from momentum', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) + 'MEKE energy available from momentum', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & - 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) + 'MEKE energy lost to GME backscatter', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 33f8f5d1b2..01a602157a 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -9,9 +9,9 @@ module MOM_MEKE_types ! Variables real, dimension(:,:), pointer :: & MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [kg m-2 L2 T-3 ~> W m-2]. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. - GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [R Z L2 T-3 ~> W m-2]. + mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [R Z L2 T-3 ~> W m-2]. + GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [R Z L2 T-3 ~> W m-2]. Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse !! MEKE [L2 T-1 ~> m2 s-1]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 40f70575d9..3c5b25d12d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -247,10 +247,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] - bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] - FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [kg m-2 L2 T-3 ~> W m-2] - Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [L2 T-1 ~> m2 s-1] - Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [L4 T-1 ~> m4 s-1] + bhstr_xx, & ! A copy of str_xx that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] + FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [R L2 T-3 ~> W m-2] + ! Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [L2 T-1 ~> m2 s-1] + ! Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [L4 T-1 ~> m4 s-1] grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] @@ -295,12 +295,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] - diss_rate, & ! MKE dissipated by parameterized shear production [L2 T-3 ~> m2 s-3] max_diss_rate_h, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] - target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated - ! by friction [L2 T-3 ~> m2 s-3] - FrictWork, & ! work done by MKE dissipation mechanisms [W m-2] - FrictWork_GME, & ! work done by GME [W m-2] + FrictWork, & ! work done by MKE dissipation mechanisms [R L2 T-3 ~> W m-2] + FrictWork_GME, & ! work done by GME [R L2 T-3 ~> W m-2] div_xx_h ! horizontal divergence [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] @@ -467,8 +464,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP use_MEKE_Ku, use_MEKE_Au, boundary_mask_h, boundary_mask_q, & !$OMP backscat_subround, GME_coeff_limiter, & !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI5, H0_GME, & - !$OMP diffu, diffv, diss_rate, max_diss_rate_h, max_diss_rate_q, & - !$OMP target_diss_rate_GME, & + !$OMP diffu, diffv, max_diss_rate_h, max_diss_rate_q, & !$OMP Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & !$OMP div_xx_h, vort_xy_q, GME_coeff_h, GME_coeff_q & !$OMP ) & @@ -1064,23 +1060,41 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo if (CS%use_GME) then + if (CS%answers_2018) then + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = boundary_mask_h(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*((dvdx(I,J) + dvdx(I-1,J-1)) + (dvdx(I,J-1) + dvdx(I-1,J))) )**2 + & + (0.25*((dudy(I,J) + dudy(I-1,J-1)) + (dudy(I,J-1) + dudy(I-1,J))) )**2) + max_diss_rate_h(i,j,k) = 2.0 * MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + enddo ; enddo + else ! This form is invariant to 90-degree rotations. + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = boundary_mask_h(i,j) * ((dudx(i,j)**2 + dvdy(i,j)**2) + & + ((0.25*((dvdx(I,J) + dvdx(I-1,J-1)) + (dvdx(I,J-1) + dvdx(I-1,J))) )**2 + & + (0.25*((dudy(I,J) + dudy(I-1,J-1)) + (dudy(I,J-1) + dudy(I-1,J))) )**2)) + max_diss_rate_h(i,j,k) = 2.0 * MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + enddo ; enddo + endif - do j = js, je ; do i = is, ie - grad_vel_mag_h(i,j) = boundary_mask_h(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*((dvdx(I,J)+dvdx(I-1,J-1))+(dvdx(I,J-1)+dvdx(I-1,J))))**2 + & - (0.25*((dudy(I,J)+dudy(I-1,J-1))+(dudy(I,J-1)+dudy(I-1,J))))**2) - max_diss_rate_h(i,j,k) = 2.0 * MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) - enddo ; enddo - - - do J = G%JscB, G%JecB ; do I = G%IscB, G%IecB - grad_vel_mag_q(I,J) = boundary_mask_q(I,J) * (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*((dvdx(I,J)+dvdx(I-1,J-1))+(dvdx(I,J-1)+dvdx(I-1,J))))**2 + & - (0.25*((dudy(I,J)+dudy(I-1,J-1))+(dudy(I,J-1)+dudy(I-1,J))))**2) + if (CS%answers_2018) then + do J = G%JscB, G%JecB ; do I = G%IscB, G%IecB + grad_vel_mag_q(I,J) = boundary_mask_q(I,J) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*((dvdx(I,J)+dvdx(I-1,J-1)) + (dvdx(I,J-1)+dvdx(I-1,J))) )**2 + & + (0.25*((dudy(I,J)+dudy(I-1,J-1)) + (dudy(I,J-1)+dudy(I-1,J))) )**2) - max_diss_rate_q(I,J,k) = 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)+ & - MEKE%MEKE(i,j+1)+MEKE%MEKE(i+1,j+1)) * sqrt(grad_vel_mag_q(I,J)) - enddo ; enddo + max_diss_rate_q(I,J,k) = 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)+ & + MEKE%MEKE(i,j+1)+MEKE%MEKE(i+1,j+1)) * sqrt(grad_vel_mag_q(I,J)) + enddo ; enddo + else ! This form is rotationally invariant + do J = G%JscB, G%JecB ; do I = G%IscB, G%IecB + grad_vel_mag_q(I,J) = boundary_mask_q(I,J) * ((dudx(i,j)**2 + dvdy(i,j)**2) + & + ((0.25*((dvdx(I,J)+dvdx(I-1,J-1)) + (dvdx(I,J-1)+dvdx(I-1,J))) )**2 + & + (0.25*((dudy(I,J)+dudy(I-1,J-1)) + (dudy(I,J-1)+dudy(I-1,J))) )**2)) + + max_diss_rate_q(I,J,k) = 0.5*((MEKE%MEKE(i,j) + MEKE%MEKE(i+1,j+1)) + & + (MEKE%MEKE(i+1,j) + MEKE%MEKE(i,j+1))) * sqrt(grad_vel_mag_q(I,J)) + enddo ; enddo + endif do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((grad_vel_mag_bt_h(i,j)>0) .and. (max_diss_rate_h(i,j,k)>0)) then @@ -1136,7 +1150,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) + FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_RZ * grad_vel_mag_bt_h(i,j) enddo ; enddo endif @@ -1201,7 +1215,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then ; do j=js,je ; do i=is,ie ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) ! This is the old formulation that includes energy diffusion - FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & + FrictWork(i,j,k) = GV%H_to_RZ * ( & (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & @@ -1256,7 +1270,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) endif endif - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & + + + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_RZ * ( & ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & @@ -1265,26 +1281,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, +(str_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1))*( & (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & - +((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J))*( & + +((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J))*( & (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & +(str_xy(I,J-1)-RoScl*bhstr_xy(I,J-1))*( & (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) enddo ; enddo - endif ! MEKE%backscatter + endif ! MEKE%backscatter_Ro_c do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork(i,j,k) enddo ; enddo - if (CS%use_GME .and. associated(MEKE)) then - if (associated(MEKE%GME_snk)) then - do j=js,je ; do i=is,ie - MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) - enddo ; enddo - endif - endif + if (CS%use_GME .and. associated(MEKE)) then ; if (associated(MEKE%GME_snk)) then + do j=js,je ; do i=is,ie + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) + enddo ; enddo + endif ; endif endif ; endif ! find_FrictWork and associated(mom_src) @@ -1356,8 +1370,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! [T2 L-2 ~> s2 m-2] real :: Ah_Limit ! coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit biharmonic viscosity - real :: Kh ! Lapacian horizontal viscosity [L2 s-1] - real :: Ah ! biharmonic horizontal viscosity [L4 s-1] + real :: Kh ! Lapacian horizontal viscosity [L2 T-1 ~> m2 s-1] + real :: Ah ! biharmonic horizontal viscosity [L4 T-1 ~> m4 s-1] real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] @@ -2080,14 +2094,16 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', & - 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T**3*US%L_to_m**2) endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& - 'Integral work done by lateral friction terms', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) + 'Integral work done by lateral friction terms', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T**3*US%L_to_m**2) CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & - 'Depth integrated work done by lateral friction', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2, & + 'Depth integrated work done by lateral friction', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 9014cb1dbb..d6616a5ee0 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -67,28 +67,29 @@ module MOM_internal_tides real, allocatable, dimension(:,:,:,:) :: cp !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss - !< energy lost due to misc background processes [W m-2] + !< energy lost due to misc background processes [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_quad_loss - !< energy lost due to quadratic bottom drag [W m-2] + !< energy lost due to quadratic bottom drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_Froude_loss - !< energy lost due to wave breaking [W m-2] + !< energy lost due to wave breaking [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed - !< fixed part of the energy lost due to small-scale drag - !! [kg m L-2 Z-1 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] + !< Fixed part of the energy lost due to small-scale drag [R L-2 Z3 ~> kg m-2] here; + !! This will be multiplied by N and the squared near-bottom velocity to get + !! the energy losses in [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss - !< energy lost due to small-scale wave drag [W m-2] + !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, - !! summed over angle, frequency and mode [W m-2] + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, - !! summed over angle, frequency and mode [W m-2] + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_itidal_loss !< Energy loss rates due to small-scale drag, - !! summed over angle, frequency and mode [W m-2] + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking, - !! summed over angle, frequency and mode [W m-2] + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, - !! summed over angle, frequency and mode [W m-2] + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real :: q_itides !< fraction of local dissipation [nondim] - real :: En_sum !< global sum of energy for use in debugging + real :: En_sum !< global sum of energy for use in debugging [R Z3 T-2 ~> J m-2] type(time_type), pointer :: Time => NULL() !< A pointer to the model's clock. character(len=200) :: inputdir !< directory to look for coastline angle file real :: decay_rate !< A constant rate at which internal tide energy is @@ -104,6 +105,7 @@ module MOM_internal_tides !< If true, apply wave breaking as a sink. real, dimension(:,:,:,:,:), pointer :: En => NULL() !< The internal wave energy density as a function of (i,j,angle,frequency,mode) + !! integrated within an angular and frequency band [R Z3 T-2 ~> J m-2] real, dimension(:,:,:), pointer :: En_restart => NULL() !< The internal wave energy density as a function of (i,j,angle); temporary for restart real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1]. @@ -157,12 +159,12 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables !! (needed for wave structure). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input !< The energy input to the - !! internal waves [W m-2]. + !! internal waves [R Z3 T-3 ~> W m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read - !! from file [m s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [s-1]. - real, intent(in) :: dt !< Length of time over which these fluxes - !! will be applied [s]. + !! from file [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. + real, intent(in) :: dt !< Length of time over which to advance + !! the internal tides [T ~> s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & @@ -172,28 +174,30 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real, dimension(SZI_(G),SZJ_(G),2) :: & test real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & - tot_En_mode, & ! energy summed over angles only + tot_En_mode, & ! energy summed over angles only [R Z3 T-2 ~> J m-2] Ub, & ! near-bottom horizontal velocity of wave (modal) [m s-1] Umax ! Maximum horizontal velocity of wave (modal) [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & flux_heat_y, & flux_prec_y real, dimension(SZI_(G),SZJ_(G)) :: & - tot_En, & ! energy summed over angles, modes, frequencies + tot_En, & ! energy summed over angles, modes, frequencies [R Z3 T-2 ~> J m-2] tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_allprocesses_loss, & - ! energy loss rates summed over angle, freq, and mode - drag_scale, & ! bottom drag scale, s-1 + ! energy loss rates summed over angle, freq, and mode [R Z3 T-3 ~> W m-2] + drag_scale, & ! bottom drag scale [T-1 ~> s-1] itidal_loss_mode, allprocesses_loss_mode - ! energy loss rates for a given mode and frequency (summed over angles) - real :: frac_per_sector, f2, I_rho0, I_D_here, Kmag2 + ! energy loss rates for a given mode and frequency (summed over angles) [R Z3 T-3 ~> W m-2] + real :: frac_per_sector, f2, Kmag2 + real :: I_D_here ! The inverse of the local depth [Z-1 ~> m-1] + real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] real :: freq2 ! The frequency squared [T-2 ~> s-2] real :: c_phase ! The phase speed [m s-1] - real :: loss_rate, Fr2_max + real :: loss_rate ! An energy loss rate [T-1 ~> s-1] + real :: Fr2_max real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] - real :: dt_in_T ! The timestep [T ~> s] - real :: En_new, En_check ! for debugging - real :: En_initial, Delta_E_check ! for debugging - real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! for debugging + real :: En_new, En_check ! Energies for debugging [R Z3 T-2 ~> J m-2] + real :: En_initial, Delta_E_check ! Energies for debugging [R Z3 T-2 ~> J m-2] + real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [R Z3 T-3 ~> W m-2] character(len=160) :: mesg ! The text of an error message integer :: a, m, fr, i, j, is, ie, js, je, isd, ied, jsd, jed, nAngle, nzm integer :: id_g, jd_g ! global (decomp-invar) indices (for debugging) @@ -203,7 +207,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 - dt_in_T = US%s_to_T*dt cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** @@ -220,8 +223,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & - dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * & + TKE_itidal_input(i,j) enddo ; enddo ; enddo ; enddo ; enddo elseif (CS%energized_angle <= CS%nAngle) then frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) @@ -230,8 +233,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & - dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * & + TKE_itidal_input(i,j) enddo ; enddo ; enddo ; enddo else call MOM_error(WARNING, "Internal tide energy is being put into a angular "//& @@ -248,7 +251,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, & G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo @@ -275,7 +278,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt_in_T, & + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, & G, US, CS, CS%NAngle) enddo ; enddo @@ -297,7 +300,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, & G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo @@ -334,8 +337,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied ! Calculate loss rate and apply loss over the time step ; apply the same drag timescale ! to each En component (technically not correct; fix later) - CS%TKE_leak_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%decay_rate ! loss rate [Wm-2] - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt *CS%decay_rate) ! implicit update + CS%TKE_leak_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%decay_rate ! loss rate [R Z3 T-3 ~> W m-2] + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%decay_rate) ! implicit update enddo ; enddo ; enddo ; enddo ; enddo endif ! Check for En<0 - for debugging, delete later @@ -356,15 +359,15 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_bottom_drag) then do j=jsd,jed ; do i=isd,ied ! Note the 1 m dimensional scale here. Should this be a parameter? - I_D_here = 1.0 / (US%Z_to_m*max(G%bathyT(i,j), 1.0*US%m_to_Z)) - drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + & + I_D_here = 1.0 / (max(G%bathyT(i,j), 1.0*US%m_to_Z)) + drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied ! Calculate loss rate and apply loss over the time step ; apply the same drag timescale ! to each En component (technically not correct; fix later) CS%TKE_quad_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * drag_scale(i,j) ! loss rate - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt *drag_scale(i,j)) ! implicit update + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * drag_scale(i,j)) ! implicit update enddo ; enddo ; enddo ; enddo ; enddo endif ! Check for En<0 - for debugging, delete later @@ -394,8 +397,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = US%m_s_to_L_T * CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = US%m_s_to_L_T * maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -439,7 +442,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (Fr2_max > 1.0) then En_initial = sum(CS%En(i,j,:,fr,m)) ! for debugging ! Calculate effective decay rate [s-1] if breaking occurs over a time step - loss_rate = (1/Fr2_max - 1.0)/dt + loss_rate = (1.0 - Fr2_max) / (Fr2_max * dt) do a=1,CS%nAngle ! Determine effective dissipation rate (Wm-2) CS%TKE_Froude_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * abs(loss_rate) @@ -449,7 +452,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Re-scale (reduce) energy due to breaking CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m)/Fr2_max ! Check (for debugging only) - if (abs(En_new - En_check) > 1e-10) then + if (abs(En_new - En_check) > 1e-10*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**2) then call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr-breaking.", & all_print=.true.) write(mesg,*) "En_new=", En_new , "En_check=", En_check @@ -592,13 +595,15 @@ subroutine sum_En(G, CS, En, label) type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), & - intent(in) :: En !< The energy density of the internal tides [J m-2]. + intent(in) :: En !< The energy density of the internal tides [R Z3 T-2 ~> J m-2]. character(len=*), intent(in) :: label !< A label to use in error messages ! Local variables + real :: En_sum ! The total energy [R Z3 T-2 ~> J m-2] + real :: tmpForSumming integer :: m,fr,a - real :: En_sum, tmpForSumming, En_sum_diff, En_sum_pdiff - character(len=160) :: mesg ! The text of an error message - real :: days + ! real :: En_sum_diff, En_sum_pdiff + ! character(len=160) :: mesg ! The text of an error message + ! real :: days En_sum = 0.0 tmpForSumming = 0.0 @@ -606,13 +611,13 @@ subroutine sum_En(G, CS, En, label) tmpForSumming = global_area_mean(En(:,:,a),G)*G%areaT_global En_sum = En_sum + tmpForSumming enddo - En_sum_diff = En_sum - CS%En_sum - if (CS%En_sum /= 0.0) then - En_sum_pdiff= (En_sum_diff/CS%En_sum)*100.0 - else - En_sum_pdiff= 0.0 - endif CS%En_sum = En_sum + !En_sum_diff = En_sum - CS%En_sum + !if (CS%En_sum /= 0.0) then + ! En_sum_pdiff= (En_sum_diff/CS%En_sum)*100.0 + !else + ! En_sum_pdiff= 0.0 + !endif !! Print to screen !if (is_root_pe()) then ! days = time_type_to_real(CS%Time) / 86400.0 @@ -633,35 +638,36 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: Nb !< Near-bottom stratification [s-1]. + intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal !! mode velocity [L T-1 ~> m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg m L-2 Z-1 ~> kg m-2] + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [R L-2 Z3 ~> kg m-2] !! (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & - intent(inout) :: En !< Energy density of the internal waves [J m-2]. + intent(inout) :: En !< Energy density of the internal waves [R Z3 T-2 ~> J m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & - intent(out) :: TKE_loss !< Energy loss rate [W m-2] + intent(out) :: TKE_loss !< Energy loss rate [R Z3 T-3 ~> W m-2] !! (q*rho*kappa*h^2*N*U^2). - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. logical,optional, intent(in) :: full_halos !< If true, do the calculation over the !! entirecomputational domain. ! Local variables integer :: j,i,m,fr,a, is, ie, js, je - real :: En_tot ! energy for a given mode, frequency, and point summed over angles - real :: TKE_loss_tot ! dissipation for a given mode, frequency, and point summed over angles + real :: En_tot ! energy for a given mode, frequency, and point summed over angles [R Z3 T-2 ~> J m-2] + real :: TKE_loss_tot ! dissipation for a given mode, frequency, and point summed over angles [R Z3 T-3 ~> W m-2] real :: TKE_sum_check ! temporary for check summing real :: frac_per_sector ! fraction of energy in each wedge real :: q_itides ! fraction of energy actually lost to mixing (remainder, 1-q, is ! assumed to stay in propagating mode for now - BDM) - real :: loss_rate ! approximate loss rate for implicit calc [s-1] - real, parameter :: En_negl = 1e-30 ! negilibly small number to prevent division by zero + real :: loss_rate ! approximate loss rate for implicit calc [T-1 ~> s-1] + real :: En_negl ! negilibly small number to prevent division by zero is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec q_itides = CS%q_itides + En_negl = 1e-30*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**2 if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed @@ -675,9 +681,8 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, En_tot = En_tot + En(i,j,a,fr,m) enddo - ! Calculate TKE loss rate; units of [W m-2] here. - TKE_loss_tot = q_itides * US%Z_to_m**3*US%s_to_T**3 * TKE_loss_fixed(i,j) * & - US%T_to_s*Nb(i,j) * Ub(i,j,fr,m)**2 + ! Calculate TKE loss rate; units of [R Z3 T-3 ~> W m-2] here. + TKE_loss_tot = q_itides * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 ! Update energy remaining (this is a pseudo implicit calc) ! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero @@ -685,7 +690,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, do a=1,CS%nAngle frac_per_sector = En(i,j,a,fr,m)/En_tot TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! Wm-2 - loss_rate = TKE_loss(i,j,a,fr,m) / (En(i,j,a,fr,m) + En_negl) ! s-1 + loss_rate = TKE_loss(i,j,a,fr,m) / (En(i,j,a,fr,m) + En_negl) ! [T-1 ~> s-1] En(i,j,a,fr,m) = En(i,j,a,fr,m) / (1.0 + dt*loss_rate) enddo else @@ -727,7 +732,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) !! previous call to int_tide_init. character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified - !! mechanism [W m-2]. + !! mechanism [R Z3 T-3 ~> W m-2]. if (mechanism == 'LeakDrag') TKE_loss_sum = CS%tot_leak_loss(i,j) ! not used for mixing yet if (mechanism == 'QuadDrag') TKE_loss_sum = CS%tot_quad_loss(i,j) ! not used for mixing yet @@ -737,18 +742,18 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution, - !! [J m-2 radian-1]. + !! [R Z3 T-2 ~> J m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. - real, intent(in) :: dt_in_T !< Time step [T ~> s]. + real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. @@ -781,7 +786,7 @@ subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) Ifreq = 1.0 / freq cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. Angle_size = (8.0*atan(1.0)) / (real(NAngle)) - dt_Angle_size = dt_in_T / Angle_size + dt_Angle_size = dt / Angle_size do A=asd,aed angle = (real(A) - 0.5) * Angle_size @@ -851,7 +856,7 @@ subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) else ! Use PPM do i=is,ie - call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt_in_T,stencil) + call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt,stencil) enddo endif @@ -867,18 +872,18 @@ end subroutine refract !> This subroutine calculates the 1-d flux for advection in angular space using a monotonic !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. -subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) +subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a - !! function of angular resolution [J m-2 radian-1]. + !! function of angular resolution [R Z3 T-2 ~> J m-2]. real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: CFL_ang !< The CFL number of the energy advection across angles real, dimension(0:NAngle), intent(out) :: Flux_En !< The time integrated internal wave energy flux - !! across angles [J m-2 radian-1]. + !! across angles [R Z3 T-2 ~> J m-2]. ! Local variables real :: flux real :: u_ang @@ -888,7 +893,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) integer :: a real :: aR, aL, dMx, dMn, Ep, Ec, Em, dA, mA, a6 - I_dt = 1 / dt_in_T + I_dt = 1 / dt Angle_size = (8.0*atan(1.0)) / (real(NAngle)) I_Angle_size = 1 / Angle_size Flux_En(:) = 0 @@ -917,7 +922,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aR - 0.5 * CFL_ang(A) * ( ( aR - aL ) - a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt_in_T * flux + Flux_En(A) = dt * flux !Flux_En(A) = (dt * I_Angle_size) * flux else ! Implementation of PPM-H3 @@ -941,25 +946,25 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aL + 0.5 * CFL_ang(A) * ( ( aR - aL ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt_in_T * flux + Flux_En(A) = dt * flux !Flux_En(A) = (dt * I_Angle_size) * flux endif enddo end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution, - !! [J m-2 radian-1]. + !! [R Z3 T-2 ~> J m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. - real, intent(in) :: dt_in_T !< Time step [T ~> s]. + real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. @@ -1018,7 +1023,7 @@ subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) do a=1,na ! Apply the propagation WITH CORNER ADVECTION/FINITE VOLUME APPROACH. LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie - call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt_in_T, G, CS, LB) + call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt, G, CS, LB) enddo ! a-loop else ! IMPLEMENT PPM ADVECTION IN HORIZONTAL----------------------- @@ -1053,7 +1058,7 @@ subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt_in_T, G, US, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1064,7 +1069,7 @@ subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt_in_T, G, US, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') @@ -1075,18 +1080,18 @@ end subroutine propagate !> This subroutine does first-order corner advection. It was written with the hopes !! of smoothing out the garden sprinkler effect, but is too numerically diffusive to !! be of much use as of yet. It is not yet compatible with reflection schemes (BDM). -subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, G, CS, LB) +subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(inout) :: En !< The energy density integrated over an angular - !! band [W m-2], intent in/out. + !! band [R Z3 T-2 ~> J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & intent(in) :: speed !< The magnitude of the group velocity at the cell !! corner points [L T-1 ~> m s-1]. integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous !! call to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1112,8 +1117,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: x,y ! coordinates of cell corners real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: Idx,Idy ! inverse of dx,dy at cell corners real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: dx,dy ! dx,dy at cell corners - real, dimension(2) :: E_new ! energy in cell after advection for subray; set size here to - ! define Nsubrays - this should be made an input option later! + real, dimension(2) :: E_new ! Energy in cell after advection for subray [R Z3 T-2 ~> J m-2]; set size + ! here to define Nsubrays - this should be made an input option later! ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh TwoPi = (8.0*atan(1.0)) @@ -1141,8 +1146,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, elseif (theta > TwoPi) then theta = theta - TwoPi endif - cos_thetaDT = cos(theta)*dt_in_T - sin_thetaDT = sin(theta)*dt_in_T + cos_thetaDT = cos(theta)*dt + sin_thetaDT = sin(theta)*dt ! corner point coordinates of advected fluid parcel ---------- xg = x(I,J); yg = y(I,J) @@ -1340,27 +1345,27 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: En !< The energy density integrated over an angular - !! band [J m-2], intent in/out. + !! band [R Z3 T-2 ~> J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the !! Cu points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - EnL, EnR ! Left and right face energy densities [J m-2]. + EnL, EnR ! Left and right face energy densities [R Z3 T-2 ~> J m-2]. real, dimension(SZIB_(G),SZJ_(G)) :: & flux_x ! The internal wave energy flux [J s-1]. real, dimension(SZIB_(G)) :: & @@ -1387,13 +1392,13 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt_in_T, G, US, j, ish, ieh, CS%vol_CFL) + dt, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt_in_T*flux_x(I-1,j) ! left face influx (J) - Fdt_p(i,j,a) = -dt_in_T*flux_x(I,j) ! right face influx (J) + Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx (J) + Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx (J) enddo ; enddo enddo ! a-loop @@ -1415,27 +1420,27 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt_in_T, G, US, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: En !< The energy density integrated over an angular - !! band [J m-2], intent in/out. + !! band [R Z3 T-2 ~> J m-2], intent in/out. real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & intent(in) :: speed_y !< The magnitude of the group velocity at the !! Cv points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - EnL, EnR ! South and north face energy densities [J m-2]. + EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & flux_y ! The internal wave energy flux [J s-1]. real, dimension(SZI_(G)) :: & @@ -1463,13 +1468,13 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt_in_T, G, US, Nangle, CS, LB cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt_in_T, G, US, J, ish, ieh, CS%vol_CFL) + dt, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt_in_T*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt_in_T*flux_y(i,J) ! north face influx (J) + Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) + Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & @@ -1501,12 +1506,12 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes - !! [J m-2]. + !! [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction - !! [J m-2]. + !! [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction - !! [J m-2]. - real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [L2 T-1 J m-2 ~> J s-1]. + !! [R Z3 T-2 ~> J m-2]. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [R Z3 L2 T-3 ~> J s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. @@ -1545,12 +1550,12 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the - !! fluxes [J m-2]. + !! fluxes [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the - !! reconstruction [J m-2]. + !! reconstruction [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the - !! reconstruction [J m-2]. - real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [L2 T-1 J m-2 ~> J s-1]. + !! reconstruction [R Z3 T-2 ~> J m-2]. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [R Z3 L2 T-3 ~> J s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. @@ -1592,7 +1597,7 @@ subroutine reflect(En, NAngle, CS, G, LB) real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution - !! [J m-2 radian-1]. + !! [R Z3 T-2 ~> J m-2]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1706,7 +1711,7 @@ subroutine teleport(En, NAngle, CS, G, LB) real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution - !! [J m-2 radian-1]. + !! [R Z3 T-2 ~> J m-2]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1724,7 +1729,7 @@ subroutine teleport(En, NAngle, CS, G, LB) real :: Angle_size ! size of beam wedge (rad) real, dimension(1:NAngle) :: angle_i ! angle of incident ray wrt equator real, dimension(1:NAngle) :: cos_angle, sin_angle - real :: En_tele ! energy to be "teleported" + real :: En_tele ! energy to be "teleported" [R Z3 T-2 ~> J m-2] character(len=160) :: mesg ! The text of an error message integer :: i, j, a !integer :: isd, ied, jsd, jed ! start and end local indices on data domain @@ -1805,7 +1810,7 @@ subroutine correct_halo_rotation(En, test, G, NAngle) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(:,:,:,:,:), intent(inout) :: En !< The internal gravity wave energy density as a !! function of space, angular orientation, frequency, - !! and vertical mode [J m-2 radian-1]. + !! and vertical mode [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJ_(G),2), & intent(in) :: test !< An x-unit vector that has been passed through !! the halo updates, to enable the rotation of the @@ -2220,7 +2225,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_DECAY_RATE", CS%decay_rate, & "The rate at which internal tide energy is lost to the "//& - "interior ocean internal wave field.", units="s-1", default=0.0) + "interior ocean internal wave field.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "INTERNAL_TIDE_VOLUME_BASED_CFL", CS%vol_CFL, & "If true, use the ratio of the open face lengths to the "//& "tracer cell areas when estimating CFL numbers in the "//& @@ -2305,8 +2311,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) - ! Compute the fixed part; units are [kg m-2] here - ! will be multiplied by N and En to get into [W m-2] + ! Compute the fixed part; units are [R L-2 Z3 ~> kg m-2] here + ! will be multiplied by N and the squared near-bottom velocity to get into [R Z3 T-3 ~> W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) enddo ; enddo @@ -2420,25 +2426,32 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Register 2-D energy density (summed over angles, freq, modes) CS%id_tot_En = register_diag_field('ocean_model', 'ITide_tot_En', diag%axesT1, & - Time, 'Internal tide total energy density', 'J m-2') + Time, 'Internal tide total energy density', & + 'J m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**2) ! Register 2-D drag scale used for quadratic bottom drag CS%id_itide_drag = register_diag_field('ocean_model', 'ITide_drag', diag%axesT1, & - Time, 'Interior and bottom drag internal tide decay timescale', 's-1') + Time, 'Interior and bottom drag internal tide decay timescale', 's-1', conversion=US%s_to_T) !Register 2-D energy input into internal tides CS%id_TKE_itidal_input = register_diag_field('ocean_model', 'TKE_itidal_input', diag%axesT1, & Time, 'Conversion from barotropic to baroclinic tide, '//& - 'a fraction of which goes into rays', 'W m-2') + 'a fraction of which goes into rays', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) ! Register 2-D energy losses (summed over angles, freq, modes) CS%id_tot_leak_loss = register_diag_field('ocean_model', 'ITide_tot_leak_loss', diag%axesT1, & - Time, 'Internal tide energy loss to background drag', 'W m-2') + Time, 'Internal tide energy loss to background drag', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) CS%id_tot_quad_loss = register_diag_field('ocean_model', 'ITide_tot_quad_loss', diag%axesT1, & - Time, 'Internal tide energy loss to bottom drag', 'W m-2') + Time, 'Internal tide energy loss to bottom drag', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) CS%id_tot_itidal_loss = register_diag_field('ocean_model', 'ITide_tot_itidal_loss', diag%axesT1, & - Time, 'Internal tide energy loss to wave drag', 'W m-2') + Time, 'Internal tide energy loss to wave drag', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) CS%id_tot_Froude_loss = register_diag_field('ocean_model', 'ITide_tot_Froude_loss', diag%axesT1, & - Time, 'Internal tide energy loss to wave breaking', 'W m-2') + Time, 'Internal tide energy loss to wave breaking', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) CS%id_tot_allprocesses_loss = register_diag_field('ocean_model', 'ITide_tot_allprocesses_loss', diag%axesT1, & - Time, 'Internal tide energy loss summed over all processes', 'W m-2') + Time, 'Internal tide energy loss summed over all processes', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) allocate(CS%id_En_mode(CS%nFreq,CS%nMode)) ; CS%id_En_mode(:,:) = -1 allocate(CS%id_En_ang_mode(CS%nFreq,CS%nMode)) ; CS%id_En_ang_mode(:,:) = -1 @@ -2461,14 +2474,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_En_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy density in frequency ",i1," mode ",i1)') fr, m CS%id_En_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'J m-2') + diag%axesT1, Time, var_descript, 'J m-2', conversion=US%R_to_kg_m3*US%Z_to_m**2*US%s_to_T**3) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 3-D (i,j,a) energy density for each freq and mode write(var_name, '("Itide_En_ang_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide angular energy density in frequency ",i1," mode ",i1)') fr, m CS%id_En_ang_mode(fr,m) = register_diag_field('ocean_model', var_name, & - axes_ang, Time, var_descript, 'J m-2 band-1') + axes_ang, Time, var_descript, 'J m-2 band-1', conversion=US%R_to_kg_m3*US%Z_to_m**2*US%s_to_T**3) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 2-D energy loss (summed over angles) for each freq and mode @@ -2476,13 +2489,13 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_wavedrag_loss_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to wave-drag from frequency ",i1," mode ",i1)') fr, m CS%id_itidal_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'W m-2') + diag%axesT1, Time, var_descript, 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! all loss processes write(var_name, '("Itide_allprocesses_loss_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to all processes from frequency ",i1," mode ",i1)') fr, m CS%id_allprocesses_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'W m-2') + diag%axesT1, Time, var_descript, 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 3-D (i,j,a) energy loss for each freq and mode @@ -2490,7 +2503,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_wavedrag_loss_ang_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to wave-drag from frequency ",i1," mode ",i1)') fr, m CS%id_itidal_loss_ang_mode(fr,m) = register_diag_field('ocean_model', var_name, & - axes_ang, Time, var_descript, 'W m-2 band-1') + axes_ang, Time, var_descript, 'W m-2 band-1', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 2-D period-averaged near-bottom horizonal velocity for each freq and mode diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index c3c88b4795..2fc6934de4 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -401,13 +401,13 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [T-2 ~> s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") @@ -415,7 +415,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%calculate_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, US%s_to_T*dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 62fb3b6732..3ef9bd308a 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -50,7 +50,7 @@ module MOM_mixed_layer_restrat !! based on the parameter MLE_DENSITY_DIFF. real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. - real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kg m-3]. + real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [R ~> kg m-3]. real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer restratification !! depth used for a smoother stream function at the base of !! the mixed-layer [nondim]. @@ -99,7 +99,7 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! PBL scheme [H ~> m or kg m-2] type(VarMix_CS), pointer :: VarMix !< Container for derived fields @@ -109,15 +109,15 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, "Module must be initialized before it is used.") if (GV%nkml>0) then - call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, G, GV, US, CS) + call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, MLD, VarMix, G, GV, US, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -129,7 +129,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt_in_T !< Time increment [T ~> s] + real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields @@ -147,8 +147,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av_slow ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] - real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [kg m-3] + real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] + real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). @@ -174,11 +174,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK + real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities [R ~> kg m-3] real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 - real :: aFac, bFac, ddRho + real :: aFac, bFac ! Nondimensional ratios [nondim] + real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel, zpa, zpb, dh, res_scaling_fac real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: proper_averaging, line_is_empty, keep_going, res_upscale @@ -205,7 +206,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in pRef_MLD(:) = 0. do j = js-1, je+1 dK(:) = 0.5 * h(:,j,1) ! Depth of center of surface layer - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is-1, ie-is+3, tv%eqn_of_state) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is-1, ie-is+3, & + tv%eqn_of_state, scale=US%kg_m3_to_R) deltaRhoAtK(:) = 0. MLD_fast(:,j) = 0. do k = 2, nz @@ -213,8 +215,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in dK(:) = dK(:) + 0.5 * ( h(:,j,k) + h(:,j,k-1) ) ! Depth of center of layer K ! Mixed-layer depth, using sigma-0 (surface reference pressure) deltaRhoAtKm1(:) = deltaRhoAtK(:) ! Store value from previous iteration of K - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, is-1, ie-is+3, tv%eqn_of_state) - deltaRhoAtK(:) = deltaRhoAtK(:) - rhoSurf(:) ! Density difference between layer K and surface + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, is-1, ie-is+3, & + tv%eqn_of_state, scale=US%kg_m3_to_R) + do i = is-1,ie+1 + deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface + enddo do i = is-1, ie+1 ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) if ((MLD_fast(i,j)==0.) .and. (ddRho>0.) .and. & @@ -247,8 +252,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in call hchksum(CS%MLD_filtered,'mixed_layer_restrat: MLD_filtered',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_in,'mixed_layer_restrat: MLD in',G%HI,haloshift=1) endif - aFac = CS%MLE_MLD_decay_time / ( dt_in_T + CS%MLE_MLD_decay_time ) - bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time ) + aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time ) + bFac = dt / ( dt + CS%MLE_MLD_decay_time ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -264,8 +269,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in call hchksum(CS%MLD_filtered_slow,'mixed_layer_restrat: MLD_filtered_slow',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_fast,'mixed_layer_restrat: MLD fast',G%HI,haloshift=1,scale=GV%H_to_m) endif - aFac = CS%MLE_MLD_decay_time2 / ( dt_in_T + CS%MLE_MLD_decay_time2 ) - bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time2 ) + aFac = CS%MLE_MLD_decay_time2 / ( dt + CS%MLE_MLD_decay_time2 ) + bFac = dt / ( dt + CS%MLE_MLD_decay_time2 ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -281,7 +286,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 - I4dt = 0.25 / (dt_in_T) + I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z @@ -295,7 +300,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in p0(:) = 0.0 !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& -!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt_in_T,vhml,vhtr, & +!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & !$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & !$OMP res_upscale, & @@ -316,7 +321,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) + call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state, scale=US%kg_m3_to_R) line_is_empty = .true. do i=is-1,ie+1 if (htot_fast(i,j) < MLD_fast(i,j)) then @@ -423,7 +428,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt enddo endif @@ -499,7 +504,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt enddo endif @@ -509,7 +514,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -556,7 +561,7 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. -subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, CS) +subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -567,7 +572,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt_in_T !< Time increment [T ~> s] + real, intent(in) :: dt !< Time increment [T ~> s] type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -578,8 +583,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] - real :: Rho0(SZI_(G)) ! Potential density relative to the surface [kg m-3] + real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] + real :: Rho0(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) @@ -615,7 +620,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 - I4dt = 0.25 / (dt_in_T) + I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff @@ -628,7 +633,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, p0(:) = 0.0 !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot,Rml_av,tv,p0,h,h_avail, & -!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt_in_T,vhml,vhtr, & +!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & !$OMP uDml_diag,vDml_diag,nkml) & !$OMP private(Rho0,h_vel,u_star,absf,mom_mixrate,timescale, & @@ -640,7 +645,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, htot(i,j) = 0.0 ; Rml_av(i,j) = 0.0 enddo do k=1,nkml - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,Rho0(:),is-1,ie-is+3,tv%eqn_of_state) + call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,Rho0(:),is-1,ie-is+3,tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) @@ -696,7 +701,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt enddo endif @@ -742,7 +747,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt enddo endif @@ -752,7 +757,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -821,7 +826,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, ! Nonsense values to cause problems when these parameters are not used CS%MLE_MLD_decay_time = -9.e9*US%s_to_T - CS%MLE_density_diff = -9.e9 + CS%MLE_density_diff = -9.e9*US%kg_m3_to_R CS%MLE_tail_dh = -9.e9 CS%MLE_use_PBL_MLD = .false. CS%MLE_MLD_stretch = -9.e9 @@ -867,7 +872,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer "//& "depth used for the mixed-layer eddy parameterization "//& - "by Fox-Kemper et al. (2010)", units="kg/m3", default=0.03) + "by Fox-Kemper et al. (2010)", units="kg/m3", default=0.03, scale=US%kg_m3_to_R) endif call get_param(param_file, mdl, "MLE_TAIL_DH", CS%MLE_tail_dh, & "Fraction by which to extend the mixed-layer restratification "//& diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index ce6c29c7e3..ddaf61e397 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -36,7 +36,7 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] - real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [m2 s-1] + real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [nondim] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max @@ -73,7 +73,7 @@ module MOM_thickness_diffuse logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [W m-2] + real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] @@ -106,7 +106,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation @@ -122,13 +122,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct - ! slopes occur at 0, while 1 is used for numerical closures. + ! slopes occur at 0, while 1 is used for numerical closures [nondim]. real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct - ! slopes occur at 0, while 1 is used for numerical closures. + ! slopes occur at 0, while 1 is used for numerical closures [nondim]. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] @@ -141,7 +141,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] - real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz @@ -158,7 +157,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff - dt_in_T = US%s_to_T*dt if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -182,15 +180,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif -!$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt_in_T,G,CS) +!$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt_in_T * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt_in_T,G,CS) +!$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt_in_T * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -384,7 +382,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP end parallel if (CS%detangle_interfaces) then - call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, & + call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, & CS, int_slope_u, int_slope_v) endif @@ -405,10 +403,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v) endif @@ -477,18 +475,18 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif - !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt_in_T,vhtr,CDp,vhD,h,G,GV) + !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T + uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T + vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -512,7 +510,7 @@ end subroutine thickness_diffuse !> Calculates parameterized layer transports for use in the continuity equation. !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). -subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, & +subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -522,24 +520,24 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] - real, intent(in) :: dt_in_T !< Time increment [T ~> s] + real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of - !! density gradients. + !! density gradients [nondim]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of - !! density gradients. + !! density gradients [nondim]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points ! Local variables @@ -548,8 +546,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, ! in massless layers filled vertically by diffusion. S, & ! The filled salinity [ppt], with the values in ! in massless layers filled vertically by diffusion. - Rho, & ! Density itself [kg m-3], when a nonlinear equation of state is - ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom @@ -566,11 +562,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, pres, & ! The pressure at an interface [Pa]. h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & - drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1] - drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. + drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1] + drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & - drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1] - drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. + drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1] + drho_dS_v ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & @@ -582,27 +578,27 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, S_v, & ! Salinity on the interface at the v-point [ppt]. pres_v ! Pressure on the interface at the v-point [Pa]. real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness - real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [W]. - real :: Work_h ! The work averaged over an h-cell [W m-2]. + real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W ] + real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2]. real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the - ! interface times the grid spacing [kg m-3]. - real :: drdkL, drdkR ! Vertical density differences across an interface [kg m-3]. - real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points [kg m-3]. - real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points [kg m-3]. + ! interface times the grid spacing [R ~> kg m-3]. + real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. + real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points [R ~> kg m-3]. + real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points [R ~> kg m-3]. real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points - ! [Z kg m-3 ~> kg m-2]. + ! [Z R ~> kg m-2]. real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points - ! [Z kg m-3 ~> kg m-2]. + ! [Z R ~> kg m-2]. real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. - real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4]. + real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. @@ -620,20 +616,20 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. - real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors [m3 T Z-1 H-1 s-3 ~> m s-2 or m4 kg-1 s-2]. + real :: G_scale ! The gravitational acceleration times a unit conversion + ! factor [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. - real :: G_rho0 ! g/Rho0 [L2 m3 Z-1 T-2 ~> m4 s-2]. + real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics @@ -644,9 +640,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB - I4dt = 0.25 / (dt_in_T) + I4dt = 0.25 / dt I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**3 * GV%H_to_m + G_scale = GV%g_Earth * GV%H_to_Z + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z G_rho0 = GV%g_Earth / GV%Rho0 @@ -670,7 +667,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt_in_T, T, S, G, GV, 1, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, 1, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -718,7 +715,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & !$OMP I_slope_max2,h_neglect2,present_int_slope_u, & !$OMP int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & -!$OMP uhD,h_avail,G_scale,work_u,CS,slope_x,cg1, & +!$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1, & !$OMP diag_sfn_x, diag_sfn_unlim_x,N2_floor, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & @@ -732,7 +729,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, do K=nz,2,-1 if (find_work .and. .not.(use_EOS)) then drdiA = 0.0 ; drdiB = 0.0 - drdkL = GV%Rlay(k)-GV%Rlay(k-1) ; drdkR = drdkL + drdkL = GV%Rlay(k) - GV%Rlay(k-1) ; drdkR = drdkL endif calc_derivatives = use_EOS .and. (k >= nk_linear) .and. & @@ -746,7 +743,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, S_u(I) = 0.25*((S(i,j,k) + S(i+1,j,k)) + (S(i,j,k-1) + S(i+1,j,k-1))) enddo call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, & - drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) + drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do I=is-1,ie @@ -984,7 +981,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, do K=nz,2,-1 if (find_work .and. .not.(use_EOS)) then drdjA = 0.0 ; drdjB = 0.0 - drdkL = GV%Rlay(k)-GV%Rlay(k-1) ; drdkR = drdkL + drdkL = GV%Rlay(k) - GV%Rlay(k-1) ; drdkR = drdkL endif calc_derivatives = use_EOS .and. (k >= nk_linear) .and. & @@ -997,7 +994,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, S_v(i) = 0.25*((S(i,j,k) + S(i,j+1,k)) + (S(i,j,k-1) + S(i,j+1,k-1))) enddo call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, & - drho_dS_v, is, ie-is+1, tv%eqn_of_state) + drho_dS_v, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=is,ie if (calc_derivatives) then @@ -1229,7 +1226,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, S_u(I) = 0.5*(S(i,j,1) + S(i+1,j,1)) enddo call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, & - drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) + drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do I=is-1,ie uhD(I,j,1) = -uhtot(I,j) @@ -1254,7 +1251,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, S_v(i) = 0.5*(S(i,j,1) + S(i,j+1,1)) enddo call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, & - drho_dS_v, is, ie-is+1, tv%eqn_of_state) + drho_dS_v, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=is,ie vhD(i,J,1) = -vhtot(i,J) @@ -1270,26 +1267,25 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, enddo endif - if (find_work) then - do j=js,je ; do i=is,ie - Work_h = 0.5 * G%IareaT(i,j) * & - ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) - if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h - if (associated(MEKE) .and. associated(MEKE%GM_src) .and. .not. CS%GM_src_alt ) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3* Work_h - endif - enddo ; enddo - - if (associated(MEKE) .and. associated(MEKE%GM_src) .and. CS%GM_src_alt) then - do j=js,je ; do i=is,ie ; do k=nz,1,-1 - PE_release_h = -0.25*(Kh_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & - Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & - Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & - Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_m**2*US%m_to_Z*PE_release_h - enddo ; enddo ; enddo - endif - endif + if (find_work) then ; do j=js,je ; do i=is,ie + ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. + Work_h = 0.5 * G%IareaT(i,j) * & + ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) + if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h + if (associated(MEKE) .and. .not.CS%GM_src_alt) then ; if (associated(MEKE%GM_src)) then + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h + endif ; endif + enddo ; enddo ; endif + + if (find_work .and. CS%GM_src_alt .and. associated(MEKE)) then ; if (associated(MEKE%GM_src)) then + do j=js,je ; do i=is,ie ; do k=nz,1,-1 + PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & + Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & + Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & + Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_Z**2 * GV%Rho0 * PE_release_h + enddo ; enddo ; enddo + endif ; endif if (CS%id_slope_x > 0) call post_data(CS%id_slope_x, CS%diagSlopeX, CS%diag) if (CS%id_slope_y > 0) call post_data(CS%id_slope_y, CS%diagSlopeY, CS%diag) @@ -1334,7 +1330,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures -subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, CS, & +subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1350,7 +1346,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt_in_T !< Time increment [T ~> s] + real, intent(in) :: dt !< Time increment [T ~> s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from @@ -1448,7 +1444,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, ! distributing the diffusivities more effectively (with wt1 & wt2), but this ! means that the additions to a single interface can be up to twice as large. Kh_scale = 0.5 - if (CS%detangle_time > dt_in_T) Kh_scale = 0.5 * dt_in_T / CS%detangle_time + if (CS%detangle_time > dt) Kh_scale = 0.5 * dt / CS%detangle_time do j=js-1,je+1 ; do i=is-1,ie+1 de_top(i,j,k_top) = 0.0 ; de_bot(i,j) = 0.0 @@ -1497,7 +1493,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, ! Limit the diffusivities - I_4t = Kh_scale / (4.0 * dt_in_T) + I_4t = Kh_scale / (4.0 * dt) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1889,11 +1885,11 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) x_cell_method='sum', v_extensive=.true.) if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,G%ke) - CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & - 'Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection', & - 'W m-2', cmor_field_name='tnkebto', & - cmor_long_name='Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection',& - cmor_standard_name='tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection') + CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & + 'Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%L_to_m**2*US%s_to_T**3, cmor_field_name='tnkebto', & + cmor_long_name='Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection', & + cmor_standard_name='tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection') if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & @@ -1902,13 +1898,13 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) CS%id_KH_v = register_diag_field('ocean_model', 'KHTH_v', diag%axesCvi, Time, & 'Parameterized mesoscale eddy advection diffusivity at V-point', & 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - CS%id_KH_t = register_diag_field('ocean_model', 'KHTH_t', diag%axesTL, Time, & - 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & - 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & - cmor_field_name='diftrblo', & - cmor_long_name='Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & - cmor_units='m2 s-1', & - cmor_standard_name='ocean_tracer_diffusivity_due_to_parameterized_mesoscale_advection') + CS%id_KH_t = register_diag_field('ocean_model', 'KHTH_t', diag%axesTL, Time, & + 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & + cmor_field_name='diftrblo', & + cmor_long_name='Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & + cmor_units='m2 s-1', & + cmor_standard_name='ocean_tracer_diffusivity_due_to_parameterized_mesoscale_advection') CS%id_KH_u1 = register_diag_field('ocean_model', 'KHTH_u1', diag%axesCu1, Time, & 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', & @@ -1916,7 +1912,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) CS%id_KH_v1 = register_diag_field('ocean_model', 'KHTH_v1', diag%axesCv1, Time, & 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', & 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - CS%id_KH_t1 = register_diag_field('ocean_model', 'KHTH_t1', diag%axesT1, Time,& + CS%id_KH_t1 = register_diag_field('ocean_model', 'KHTH_t1', diag%axesT1, Time, & 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', & 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 17b601427c..dd58368bd3 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -110,9 +110,9 @@ module MOM_ALE_sponge integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indicies of each v-columns being damped. integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indicies of each v-columns being damped. - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [s-1]. - real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [s-1]. - real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column [s-1]. + real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [T-1 ~> s-1]. + real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [T-1 ~> s-1]. + real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column [T-1 ~> s-1]. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -217,7 +217,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) then CS%col_i(col) = i ; CS%col_j(col) = j - CS%Iresttime_col(col) = Iresttime(i,j) + CS%Iresttime_col(col) = G%US%T_to_s*Iresttime(i,j) col = col +1 endif enddo ; enddo @@ -265,7 +265,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then CS%col_i_u(col) = i ; CS%col_j_u(col) = j - CS%Iresttime_col_u(col) = Iresttime_u(i,j) + CS%Iresttime_col_u(col) = G%US%T_to_s*Iresttime_u(i,j) col = col +1 endif enddo ; enddo @@ -302,7 +302,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then CS%col_i_v(col) = i ; CS%col_j_v(col) = j - CS%Iresttime_col_v(col) = Iresttime_v(i,j) + CS%Iresttime_col_v(col) = G%US%T_to_s*Iresttime_v(i,j) col = col +1 endif enddo ; enddo @@ -455,7 +455,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) then CS%col_i(col) = i ; CS%col_j(col) = j - CS%Iresttime_col(col) = Iresttime(i,j) + CS%Iresttime_col(col) = G%US%T_to_s*Iresttime(i,j) col = col +1 endif enddo ; enddo @@ -494,7 +494,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then CS%col_i_u(col) = i ; CS%col_j_u(col) = j - CS%Iresttime_col_u(col) = Iresttime_u(i,j) + CS%Iresttime_col_u(col) = G%US%T_to_s*Iresttime_u(i,j) col = col +1 endif enddo ; enddo @@ -526,7 +526,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then CS%col_i_v(col) = i ; CS%col_j_v(col) = j - CS%Iresttime_col_v(col) = Iresttime_v(i,j) + CS%Iresttime_col_v(col) = G%US%T_to_s*Iresttime_v(i,j) col = col +1 endif enddo ; enddo @@ -859,14 +859,13 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] (in) - real, intent(in) :: dt !< The amount of time covered by this call [s]. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). type(time_type), optional, intent(in) :: Time !< The current model date real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim]. - real :: Idt ! 1.0/dt [s-1]. real :: m_to_Z ! A unit conversion factor from m to Z. real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid real, dimension(SZK_(G)) :: tmp_val1 ! data values remapped to model grid @@ -934,7 +933,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) ! c is an index for the next 3 lines but a multiplier for the rest of the loop ! Therefore we use c as per C code and increment the index where necessary. i = CS%col_i(c) ; j = CS%col_j(c) - damp = dt*CS%Iresttime_col(c) + damp = dt * CS%Iresttime_col(c) I1pdamp = 1.0 / (1.0 + damp) tmp_val2(1:nz_data) = CS%Ref_val(m)%p(1:nz_data,c) if (CS%new_sponges) then @@ -1012,7 +1011,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) do c=1,CS%num_col_u i = CS%col_i_u(c) ; j = CS%col_j_u(c) - damp = dt*CS%Iresttime_col_u(c) + damp = dt * CS%Iresttime_col_u(c) I1pdamp = 1.0 / (1.0 + damp) if (CS%new_sponges) nz_data = CS%Ref_val(m)%nz_data tmp_val2(1:nz_data) = CS%Ref_val_u%p(1:nz_data,c) @@ -1034,7 +1033,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) do c=1,CS%num_col_v i = CS%col_i_v(c) ; j = CS%col_j_v(c) - damp = dt*CS%Iresttime_col_v(c) + damp = dt * CS%Iresttime_col_v(c) I1pdamp = 1.0 / (1.0 + damp) tmp_val2(1:nz_data) = CS%Ref_val_v%p(1:nz_data,c) if (CS%new_sponges) then diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 2ff0b3efe1..f5ee25c743 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -953,7 +953,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF #endif ! some constants - GoRho = GV%mks_g_Earth / GV%Rho0 + GoRho = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 1fbbc15120..19a71116f3 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -172,7 +172,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) real :: pref, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = GV%mks_g_Earth / GV%Rho0 + g_o_rho0 = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 3ab0567db1..68081a97d9 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -82,7 +82,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = GV%mks_g_Earth / GV%Rho0 + GoRho = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) do j = G%jsc, G%jec do i = G%isc, G%iec diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 2a17bfbd6f..2625867849 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -131,9 +131,9 @@ module MOM_bulk_mixed_layer diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer - !! detrainment [kg T-3 Z m-1 ~> W m-2]. + !! detrainment [R Z L2 T-3 ~> W m-2]. diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only - !! detrainment [kg T-3 Z m-1 ~> W m-2]. + !! detrainment [R Z L2 T-3 ~> W m-2]. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -184,7 +184,7 @@ module MOM_bulk_mixed_layer !! For a traditional Kraus-Turner mixed layer, the values are: !! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, !! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, US, CS, & +subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -203,7 +203,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to @@ -244,8 +244,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, h, & ! The layer thickness [H ~> m or kg m-2]. T, & ! The layer temperatures [degC]. S, & ! The layer salinities [ppt]. - R0, & ! The potential density referenced to the surface [kg m-3]. - Rcv ! The coordinate variable potential density [kg m-3]. + R0, & ! The potential density referenced to the surface [R ~> kg m-3]. + Rcv ! The coordinate variable potential density [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity [L T-1 ~> m s-1]. v, & ! The meridional velocity [L T-1 ~> m s-1]. @@ -269,9 +269,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, htot, & ! The total depth of the layers being considered for ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface - ! of the layers which are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! of the layers which are fully entrained [H R ~> kg m-2 or kg2 m-5]. Rcv_tot, & ! The integrated coordinate value potential density of the - ! layers that are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! layers that are fully entrained [H R ~> kg m-2 or kg2 m-5]. Ttot, & ! The integrated temperature of layers which are fully ! entrained [degC H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained @@ -293,13 +293,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, p_ref_cv, & ! Reference pressure for the potential density which defines ! the coordinate variable, set to P_Ref [Pa]. dR0_dT, & ! Partial derivative of the mixed layer potential density with - ! temperature [kg m-3 degC-1]. + ! temperature [R degC-1 ~> kg m-3 degC-1]. dRcv_dT, & ! Partial derivative of the coordinate variable potential - ! density in the mixed layer with temperature [kg m-3 degC-1]. + ! density in the mixed layer with temperature [R degC-1 ~> kg m-3 degC-1]. dR0_dS, & ! Partial derivative of the mixed layer potential density with - ! salinity [kg m-3 ppt-1]. + ! salinity [R ppt-1 ~> kg m-3 ppt-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential - ! density in the mixed layer with salinity [kg m-3 ppt-1]. + ! density in the mixed layer with salinity [R ppt-1 ~> kg m-3 ppt-1]. TKE_river ! The source of turbulent kinetic energy available for mixing ! at rivermouths [Z L2 T-3 ~> m3 s-3]. @@ -312,7 +312,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the ! denominator of MKE_rate; the two elements have differing ! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. - real :: Irho0 ! 1.0 / rho_0 [m3 kg-1] + real :: Irho0 ! 1.0 / rho_0 [R-1 ~> m3 kg-1] real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1]. @@ -347,7 +347,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. real :: kU_star ! Ustar times the Von Karmen constant [Z T-1 ~> m s-1]. -! real :: dt_in_T ! Time increment in time units [T ~> s]. real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. @@ -370,10 +369,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) -! dt_in_T = dt * US%s_to_T - - Irho0 = 1.0 / GV%Rho0 - dt__diag = dt_in_T ; if (present(dt_diag)) dt__diag = dt_diag + Irho0 = 1.0 / (GV%Rho0) + dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call @@ -406,7 +403,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! Determine whether to zero out diagnostics before accumulation. reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt_in_T)) & + if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then @@ -468,14 +465,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, p_ref(i) = p_ref(i) + 0.5*GV%H_to_Pa*h(i,k) enddo ; enddo call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), is, ie-is+1, & - tv%eqn_of_state) + tv%eqn_of_state, scale=US%kg_m3_to_R) call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & - ie-is+1, tv%eqn_of_state) + ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo if (id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) @@ -514,10 +511,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * GV%g_Earth * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & - US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) + (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) enddo else do i=is,ie ; TKE_river(i) = 0.0 ; enddo @@ -533,7 +530,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, US%T_to_s*dt_in_T, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -545,7 +542,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & nsw, Pen_SW_bnd, opacity_band, Conv_En, & - dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt, & aggregate_FW_forcing) if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) @@ -559,7 +556,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & - TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) ! Here the mechanically driven entrainment occurs. @@ -568,7 +565,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, US, CS) - call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, optics, j, dt_in_T, & + call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, optics, j, dt, & CS%H_limit_fluxes, CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) @@ -606,7 +603,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, if (CS%ML_resort) then if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) - call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), GV%Rlay, eps, & + call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), GV%Rlay(:), eps, & d_ea, d_eb, ksort, G, GV, CS, dR0_dT, dR0_dS, dRcv_dT, dRcv_dS) if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) endif @@ -642,11 +639,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt_in_T, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & + GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & dRcv_dT, dRcv_dS, max_BL_det) elseif (CS%nkbl == 2) then call mixedlayer_detrain_2(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt_in_T, dt__diag, d_ea, j, G, GV, US, CS, & + GV%Rlay(:), dt, dt__diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) else ! CS%nkbl not = 1 or 2 ! This code only works with 1 or 2 buffer layers. @@ -814,9 +811,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure [kg m-3]. + !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential - !! density [kg m-3]. + !! density [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer !! in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by @@ -845,9 +842,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & htot, & ! The total depth of the layers being considered for ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface - ! of the layers which are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! of the layers which are fully entrained [H R ~> kg m-2 or kg2 m-5]. Rcv_tot, & ! The integrated coordinate value potential density of the - ! layers that are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! layers that are fully entrained [H R ~> kg m-2 or kg2 m-5]. Ttot, & ! The integrated temperature of layers which are fully ! entrained [degC H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained @@ -861,7 +858,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! in [L2 Z T-3 H-2 R-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke @@ -938,7 +935,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & nsw, Pen_SW_bnd, opacity_band, Conv_En, & - dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt, & aggregate_FW_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -959,9 +956,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced - !! to 0 pressure [H kg m-2 ~> kg m-1 or kg2 m-4]. + !! to 0 pressure [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate - !! variable potential density [H kg m-2 ~> kg m-1 or kg2 m-4]. + !! variable potential density [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & @@ -972,21 +969,21 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(in) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: R0 !< Potential density referenced to - !! surface pressure [kg m-3]. + !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Rcv !< The coordinate defining potential - !! density [kg m-3]. + !! density [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to - !! temperature [kg m-3 degC-1]. + !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to - !! temperature [kg m-3 degC-1]. + !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of R0 with respect to - !! salinity [kg m-3 ppt-1]. + !! salinity [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of Rcv with respect to - !! salinity [kg m-3 ppt-1]. + !! salinity [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq) !! or volume flux (if Boussinesq) into the ocean !! within a time step [H ~> m or kg m-2]. (I.e. P+R-E.) @@ -1019,7 +1016,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -1043,9 +1040,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: T_precip ! The temperature of the precipitation [degC]. real :: C1_3, C1_6 ! 1/3 and 1/6. real :: En_fn, Frac, x1 ! Nondimensional temporary variables. - real :: dr, dr0 ! Temporary variables [kg m-3 H ~> kg m-2 or kg2 m-5]. - real :: dr_ent, dr_comp ! Temporary variables [kg m-3 H ~> kg m-2 or kg2 m-5]. - real :: dr_dh ! The partial derivative of dr_ent with h_ent [kg m-3]. + real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. + real :: dr_ent, dr_comp ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. + real :: dr_dh ! The partial derivative of dr_ent with h_ent [R ~> kg m-3]. real :: h_min, h_max ! The minimum, maximum, and previous estimates for real :: h_prev ! h_ent [H ~> m or kg m-2]. real :: h_evap ! The thickness that is evaporated [H ~> m or kg m-2]. @@ -1053,23 +1050,23 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! [L2 Z T-3 H-2 R-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1] real :: sum_Pen_En ! The potential energy change due to penetrating ! shortwave radiation, integrated over a layer - ! [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! [H R ~> kg m-2 or kg2 m-5]. real :: Idt ! 1.0/dt [T-1 ~> s-1] real :: netHeatOut ! accumulated heat content of mass leaving ocean integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & - C2, & ! Temporary variable [kg m-3 H-1 ~> kg m-4 or m-1]. - r_SW_top ! Temporary variables [H kg m-3 ~> kg m-2 or kg2 m-5]. + C2, & ! Temporary variable R H-1 ~> kg m-4 or m-1]. + r_SW_top ! Temporary variables [H R ~> kg m-2 or kg2 m-5]. Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) - Idt = 1.0 / dt_in_T + Idt = 1.0 / dt is = G%isc ; ie = G%iec ; nz = GV%ke do i=is,ie ; if (ksort(i,1) > 0) then @@ -1121,11 +1118,11 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & (dRcv_dT(i)*(Net_heat(i) + Pen_absorbed) - & dRcv_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i))) Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 - if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + US%s_to_T * & - T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massin)) & + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & + T_precip * netMassIn(i) * GV%H_to_RZ * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & - T_precip * netMassIn(i) * GV%H_to_kg_m2 + T_precip * netMassIn(i) * GV%H_to_RZ endif ; enddo ! Now do netMassOut case in this block. @@ -1171,14 +1168,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & d_eb(i,k) = d_eb(i,k) - h_evap ! smg: when resolve the A=B code, we will set - ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_kg_m2*fluxes%C_p*Idt + ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_RZ*fluxes%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. if (associated(fluxes%heat_content_massout)) & - fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) - US%s_to_T * & - T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt + fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) - & + T(i,k)*h_evap*GV%H_to_RZ * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & - T(i,k)*h_evap*GV%H_to_kg_m2 + T(i,k)*h_evap*GV%H_to_RZ endif @@ -1306,7 +1303,7 @@ end subroutine mixedlayer_convection !> This subroutine determines the TKE available at the depth of free !! convection to drive mechanical entrainment. subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & - TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1341,7 +1338,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. - real, intent(in) :: dt_in_T !< The time step [T ~> s]. + real, intent(in) :: dt !< The time step [T ~> s]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic !! time interval [T-1 ~> s-1]. integer, intent(in) :: j !< The j-index to work on. @@ -1374,7 +1371,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, integer :: is, ie, nz, i is = G%isc ; ie = G%iec ; nz = GV%ke - diag_wt = dt_in_T * Idt_diag + diag_wt = dt * Idt_diag if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie @@ -1405,7 +1402,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! scales contribute to mixed layer deepening at similar rates, even though ! small scales are dissipated more rapidly (implying they are less efficient). ! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_Z/(3.0*0.41*U_star*dt_in_T) + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then @@ -1424,7 +1421,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1434,7 +1431,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) > 0.0) then totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1442,7 +1439,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1464,11 +1461,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_L**2*(U_star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt*CS%mstar)*((US%Z_to_L**2*(U_star*U_Star*U_Star))*exp_kh) + & (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) if (CS%do_rivermix) then ! Add additional TKE at river mouths - TKE(i) = TKE(i) + TKE_river(i)*dt_in_T*exp_kh + TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh endif if (CS%TKE_diagnostics) then @@ -1514,9 +1511,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density - !! referenced to 0 pressure [H kg m-3 ~> kg m-2 or kg2 m-5]. + !! referenced to 0 pressure [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable - !! potential density [H kg m-3 ~> kg m-2 or kg2 m-5]. + !! potential density [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1527,17 +1524,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(in) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: R0 !< Potential density referenced to - !! surface pressure [kg m-3]. + !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Rcv !< The coordinate defining potential - !! density [kg m-3]. + !! density [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to - !! temperature [kg m-3 degC-1]. + !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to - !! temperature [kg m-3 degC-1]. + !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating the !! denominator of MKE_rate; the two elements have differing !! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. @@ -1577,7 +1574,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, - ! in [L2 m3 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! in [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer @@ -1837,7 +1834,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: R0 !< The potential density used to sort - !! the layers [kg m-3]. + !! the layers [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a @@ -1893,11 +1890,11 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure [kg m-3]. + !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining - !! potential density [kg m-3]. + !! potential density [R ~> kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each - !! layer [kg m-3]. + !! layer [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a @@ -1915,19 +1912,19 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential - !! temperature [kg m-3 degC-1]. + !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of !! cpotential density referenced !! to the surface with salinity, - !! [kg m-3 ppt-1]. + !! [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential !! density with potential - !! temperature [kg m-3 degC-1]. + !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential !! density with salinity, - !! [kg m-3 ppt-1]. + !! [R ppt-1 ~> kg m-3 ppt-1]. ! If there are no massive light layers above the deepest of the mixed- and ! buffer layers, do nothing (except perhaps to reshuffle these layers). @@ -2204,7 +2201,7 @@ end subroutine resort_ML !> This subroutine moves any water left in the former mixed layers into the !! two buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, j, G, GV, US, CS, & +subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -2213,12 +2210,12 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure [kg m-3]. + !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential - !! density [kg m-3]. + !! density [R ~> kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each - !! layer [kg m-3]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + !! layer [R ~> kg m-3]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, intent(in) :: dt_diag !< The diagnostic time step [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above @@ -2231,18 +2228,18 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, - !! [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of !! cpotential density referenced to the !! surface with salinity - !! [kg m-3 ppt-1]. + !! [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature, - !! [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential density - !! with salinity [kg m-3 ppt-1]. + !! with salinity [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. @@ -2255,9 +2252,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: h_to_bl ! The total thickness detrained to the buffer ! layers [H ~> m or kg m-2]. real :: R0_to_bl ! The depth integrated amount of R0 that is detrained to the - ! buffer layer [H kg m-3 ~> kg m-2 or kg2 m-5] + ! buffer layer [H R ~> kg m-2 or kg2 m-5] real :: Rcv_to_bl ! The depth integrated amount of Rcv that is detrained to the - ! buffer layer [H kg m-3 ~> kg m-2 or kg2 m-5] + ! buffer layer [H R ~> kg m-2 or kg2 m-5] real :: T_to_bl ! The depth integrated amount of T that is detrained to the ! buffer layer [degC H ~> degC m or degC kg m-2] real :: S_to_bl ! The depth integrated amount of S that is detrained to the @@ -2282,7 +2279,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! layer that remains [H ~> m or kg m-2]. real :: stays_min_merge ! The minimum allowed value of stays_merge [H ~> m or kg m-2]. - real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0 and Rcv [kg m-3 H-1 ~> kg m-4 or m-1] + real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0 and Rcv [R H-1 ~> kg m-4 or m-1] ! real :: dT_2dz, dS_2dz ! Half the vertical gradients of T and S, in degC H-1, and ppt H-1. real :: scale_slope ! A nondimensional number < 1 used to scale down ! the slope within the upper buffer layer when @@ -2293,7 +2290,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers [kg H2 Z T-2 L-2 m-1 ~> J m-2 or J kg2 m-8]. + ! buffer layers [R H2 L2 Z-1 T-2 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. @@ -2308,18 +2305,18 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! interior layers that are just lighter and ! just denser than the lower buffer layer. - real :: R0_det, T_det, S_det ! Detrained values of R0 [kg m-3], T [degC], and S [ppt]. + real :: R0_det, T_det, S_det ! Detrained values of R0 [R ~> kg m-3], T [degC], and S [ppt]. real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer. real :: T_stays, S_stays ! Values of T and S that stay in a layer. real :: dSpice_det, dSpice_stays! The spiciness difference between an original ! buffer layer and the water that moves into ! an interior layer or that stays in that - ! layer [kg m-3]. + ! layer [R ~> kg m-3]. real :: dSpice_lim, dSpice_lim2 ! Limits to the spiciness difference between ! the lower buffer layer and the water that - ! moves into an interior layer [kg m-3]. + ! moves into an interior layer [R ~> kg m-3]. real :: dSpice_2dz ! The vertical gradient of spiciness used for - ! advection [kg m-3 H-1 ~> kg m-4 or m-1]. + ! advection [R H-1 ~> kg m-4 or m-1]. real :: dPE_ratio ! Multiplier of dPE_det at which merging is ! permitted - here (detrainment_per_day/dt)*30 @@ -2330,11 +2327,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in ! [degC ppt-1] and [ppt degC-1]. - real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. + real :: I_denom ! A work variable with units of [ppt2 R-2 ~> ppt2 m6 kg-2]. real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg L2 m-3 Z-1 T-2 ~> kg m-2 s-2]. - real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. + real :: Rho0xG ! Rho0 times G_Earth [R L2 Z-1 T-2 ~> kg m-2 s-2]. + real :: I2Rho0 ! 1 / (2 Rho0) [R-1 ~> m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z ! divided by the time step [Z2 H-2 T-1 ~> s-1 or m6 kg-2 s-1]. logical :: stable_Rcv ! If true, the buffer layers are stable with @@ -2349,7 +2346,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables, real :: Ihk0, Ihk1, Ih12 ! all in [H-1 ~> m-1 or m2 kg-1]. real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, - real :: dR0, dR21, dRcv ! all in [kg m-3]. + real :: dR0, dR21, dRcv ! all in [R ~> kg m-3]. real :: dRcv_stays, dRcv_det, dRcv_lim real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. @@ -2364,7 +2361,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea g_2 = 0.5 * GV%g_Earth Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag - I2Rho0 = 0.5 / GV%Rho0 + I2Rho0 = 0.5 / (GV%Rho0) Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. @@ -2374,7 +2371,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") - if (dt_in_T < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (dt_in_T) + if (dt < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (dt) else ; dPE_time_ratio = 1.0 ; endif do i=is,ie @@ -3095,7 +3092,7 @@ end subroutine mixedlayer_detrain_2 !> This subroutine moves any water left in the former mixed layers into the !! single buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, d_eb, & +subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, & j, G, GV, US, CS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -3104,12 +3101,12 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure [kg m-3]. + !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential - !! density [kg m-3]. + !! density [R ~> kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each - !! layer [kg m-3]. - real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + !! layer [R ~> kg m-3]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, intent(in) :: dt_diag !< The accumulated time interval for !! diagnostics [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in @@ -3127,10 +3124,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature - !! [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential density - !! with salinity [kg m-3 ppt-1]. + !! with salinity [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. @@ -3143,12 +3140,12 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 - real :: I_denom ! A work variable [ppt2 m6 kg-2]. + real :: I_denom ! A work variable [ppt2 R-2 ~> ppt2 m6 kg-2]. real :: Sdown, Tdown real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time - ! step [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [L2 Z T-3 H-2 R-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: g_H2_2dt ! Half the gravitational acceleration times the square of the ! conversion from H to Z divided by the diagnostic time step ! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. @@ -3162,7 +3159,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & "CS%nkbl must be 1 in mixedlayer_detrain_1.") - dt_Time = dt_in_T / CS%BL_detrain_time + dt_Time = dt / CS%BL_detrain_time g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) @@ -3606,10 +3603,10 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3)) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer detrainment', & - 'W m-2', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3)) + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3)) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3)) + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3)) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1431956a89..3e2588db8c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -79,7 +79,7 @@ module MOM_diabatic_aux ! Optional diagnostic arrays real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to - !! avoid grounding [m s-1] + !! avoid grounding [H T-1 ~> m s-1] real, allocatable, dimension(:,:,:) :: penSW_diag !< Heating in a layer from convergence of !! penetrative SW [W m-2] real, allocatable, dimension(:,:,:) :: penSWflux_diag !< Penetrative SW flux at base of grid @@ -334,9 +334,9 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) integer, optional, intent(in) :: halo !< Halo width over which to work ! local variables - real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement [gSalt m-2] + real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement [ppt R Z ~> gSalt m-2] real :: S_min !< The minimum salinity [ppt]. - real :: mc !< A layer's mass [kg m-2]. + real :: mc !< A layer's mass [R Z ~> kg m-2]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -355,7 +355,7 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) do k=nz,1,-1 ; do i=is,ie if ( (G%mask2dT(i,j) > 0.0) .and. & ((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0)) ) then - mc = GV%H_to_kg_m2 * h(i,j,k) + mc = GV%H_to_RZ * h(i,j,k) if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be adjusted by the salt flux if (tv%S(i,j,k) < S_min) then @@ -382,44 +382,48 @@ end subroutine adjust_salt !> Insert salt from brine rejection into the first layer below the mixed layer !! which both contains mass and in which the change in layer density remains !! stable after the addition of salt via brine rejection. -subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) +subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes integer, intent(in) :: nkmb !< The number of layers in the mixed and buffer layers type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init - real, intent(in) :: dt !< The thermodynamic time step [s]. + real, intent(in) :: dt !< The thermodynamic time step [T ~> s]. integer, intent(in) :: id_brine_lay !< The handle for a diagnostic of !! which layer receivees the brine. ! local variables - real :: salt(SZI_(G)) ! The amount of salt rejected from - ! sea ice. [grams] - real :: dzbr(SZI_(G)) ! cumulative depth over which brine is distributed + real :: salt(SZI_(G)) ! The amount of salt rejected from sea ice [ppt R Z ~> gramSalt m-2] + real :: dzbr(SZI_(G)) ! Cumulative depth over which brine is distributed [H ~> m to kg m-2] real :: inject_layer(SZI_(G),SZJ_(G)) ! diagnostic real :: p_ref_cv(SZI_(G)) real :: T(SZI_(G),SZK_(G)) real :: S(SZI_(G),SZK_(G)) - real :: h_2d(SZI_(G),SZK_(G)) + real :: h_2d(SZI_(G),SZK_(G)) ! A 2-d slice of h with a minimum thickness [H ~> m to kg m-2] real :: Rcv(SZI_(G),SZK_(G)) - real :: mc ! A layer's mass [kg m-2]. real :: s_new,R_new,t0,scale, cdz integer :: i, j, k, is, ie, js, je, nz, ks - real, parameter :: brine_dz = 1.0 ! minumum thickness over which to distribute brine + real :: brine_dz ! minumum thickness over which to distribute brine [H ~> m or kg m-2] real, parameter :: s_max = 45.0 ! salinity bound is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(fluxes%salt_flux)) return + !### Injecting the brine into a single layer with a prescribed thickness seems problematic, + ! because it is not convergent when resolution becomes very fine. I think that this whole + ! subroutine needs to be revisited.- RWH + p_ref_cv(:) = tv%P_ref + brine_dz = 1.0*GV%m_to_H inject_layer(:,:) = nz @@ -433,9 +437,9 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do k=1,nz do i=is,ie - T(i,k)=tv%T(i,j,k); S(i,k)=tv%S(i,j,k) + T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) ! avoid very small thickness - h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom_H) + h_2d(i,k) = MAX(h(i,j,k), GV%Angstrom_H) enddo call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & @@ -448,12 +452,11 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do k=nkmb+1,nz-1 ; do i=is,ie if ((G%mask2dT(i,j) > 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then - mc = GV%H_to_kg_m2 * h_2d(i,k) - s_new = S(i,k) + salt(i)/mc + s_new = S(i,k) + salt(i) / (GV%H_to_RZ * h_2d(i,k)) t0 = T(i,k) - call calculate_density(t0,s_new,tv%P_Ref,R_new,tv%eqn_of_state) + call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state) if (R_new < 0.5*(Rcv(i,k)+Rcv(i,k+1)) .and. s_new 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then - mc = GV%H_to_kg_m2 * h_2d(i,k) - dzbr(i)=dzbr(i)+h_2d(i,k) - inject_layer(i,j) = min(inject_layer(i,j),real(k)) + dzbr(i) = dzbr(i) + h_2d(i,k) + inject_layer(i,j) = min(inject_layer(i,j), real(k)) endif enddo ; enddo @@ -472,9 +474,8 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do k=1,GV%nkml ; do i=is,ie if ((G%mask2dT(i,j) > 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then - mc = GV%H_to_kg_m2 * h_2d(i,k) - dzbr(i)=dzbr(i)+h_2d(i,k) - inject_layer(i,j) = min(inject_layer(i,j),real(k)) + dzbr(i) = dzbr(i) + h_2d(i,k) + inject_layer(i,j) = min(inject_layer(i,j), real(k)) endif enddo ; enddo @@ -482,14 +483,15 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do i=is,ie if ((G%mask2dT(i,j) > 0.0) .and. salt(i) > 0.) then ! if (dzbr(i)< brine_dz) call MOM_error(FATAL,"insert_brine: failed") - ks=inject_layer(i,j) - cdz=0.0 + ks = inject_layer(i,j) + cdz = 0.0 do k=ks,nz - mc = GV%H_to_kg_m2 * h_2d(i,k) - scale = h_2d(i,k)/dzbr(i) - cdz=cdz+h_2d(i,k) - if (cdz > 1.0) exit - tv%S(i,j,k) = tv%S(i,j,k) + scale*salt(i)/mc + scale = h_2d(i,k) / dzbr(i) + cdz = cdz + h_2d(i,k) + !### I think that the logic of this line is wrong. Moving it down a line + ! would seem to make more sense. - RWH + if (cdz > brine_dz) exit + tv%S(i,j,k) = tv%S(i,j,k) + scale*salt(i) / (GV%H_to_RZ * h_2d(i,k)) enddo endif enddo @@ -556,15 +558,15 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u_h !< Zonal velocity interpolated to h points [m s-1]. + intent(out) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: v_h !< Meridional velocity interpolated to h points [m s-1]. + intent(out) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: ea !< The amount of fluid entrained from the layer !! above within this time step [H ~> m or kg m-2]. @@ -720,7 +722,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. - real, intent(in) :: densityDiff !< Density difference to determine MLD [kg m-3] + real, intent(in) :: densityDiff !< Density difference to determine MLD [R ~> kg m-3] type(diag_ctrl), pointer :: diagPtr !< Diagnostics structure integer, optional, intent(in) :: id_N2subML !< Optional handle (ID) of subML stratification integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD @@ -728,29 +730,30 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, !! or 50 m if missing [Z ~> m] ! Local variables - real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [kg m-3]. + real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [R ~> kg m-3]. real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [Pa]. real, dimension(SZI_(G)) :: H_subML, dH_N2 ! Summed thicknesses used in N2 calculation [H ~> m]. real, dimension(SZI_(G)) :: T_subML, T_deeper ! Temperatures used in the N2 calculation [degC]. real, dimension(SZI_(G)) :: S_subML, S_deeper ! Salinities used in the N2 calculation [ppt]. - real, dimension(SZI_(G)) :: rho_subML, rho_deeper ! Densities used in the N2 calculation [kg m-3]. + real, dimension(SZI_(G)) :: rho_subML, rho_deeper ! Densities used in the N2 calculation [R ~> kg m-3]. real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. - real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [kg m-3]. + real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [T-2 ~> s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. logical, dimension(SZI_(G)) :: N2_region_set ! If true, all necessary values for calculating N2 ! have been stored already. - real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [Z T-2 R-1 ~> m4 s-2 kg-1]. real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m]. + real :: aFac ! A nondimensional factor [nondim] + real :: ddRho ! A density difference [R ~> kg m-3] integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ - real :: aFac, ddRho id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%L_to_Z**2*GV%g_Earth / GV%Rho0 + gE_rho0 = US%L_to_Z**2*GV%g_Earth / (GV%Rho0) dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -758,7 +761,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, pRef_MLD(:) = 0.0 do j=js,je do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, tv%eqn_of_state) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie deltaRhoAtK(i) = 0. MLD(i,j) = 0. @@ -799,7 +803,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! Mixed-layer depth, using sigma-0 (surface reference pressure) do i=is,ie ; deltaRhoAtKm1(i) = deltaRhoAtK(i) ; enddo ! Store value from previous iteration of K - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, is, ie-is+1, tv%eqn_of_state) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, is, ie-is+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R) do i = is, ie deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) @@ -822,8 +827,10 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! T_deeper(i) = tv%T(i,j,nz) ; S_deeper(i) = tv%S(i,j,nz) ! N2_region_set(i) = .true. ! endif - call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, is, ie-is+1, tv%eqn_of_state) - call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, is, ie-is+1, tv%eqn_of_state) + call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, is, ie-is+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, is, ie-is+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie ; if ((G%mask2dT(i,j)>0.5) .and. N2_region_set(i)) then subMLN2(i,j) = gE_rho0 * (rho_deeper(i) - rho_subML(i)) / (GV%H_to_z * dH_N2(i)) endif ; enddo @@ -847,7 +854,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: dt !< Time-step over which forcing is applied [s] + real, intent(in) :: dt !< Time-step over which forcing is applied [T ~> s] type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container integer, intent(in) :: nsw !< The number of frequency bands of penetrating @@ -863,23 +870,26 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !! heat and freshwater fluxes is applied [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix - !! forcing through each layer [kg m-3 Z3 T-2 ~> J m-2] + !! forcing through each layer [R Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with - !! potential temperature [m3 kg-1 degC-1]. + !! potential temperature [R-1 degC-1 ~> m3 kg-1 degC-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with - !! salinity [m3 kg-1 ppt-1]. + !! salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) - real :: H_limit_fluxes, IforcingDepthScale, Idt + real :: H_limit_fluxes + real :: IforcingDepthScale + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: dThickness, dTemp, dSalt real :: fractionOfForcing, hOld, Ithickness - real :: RivermixConst ! A constant used in implementing river mixing [Pa s]. + real :: RivermixConst ! A constant used in implementing river mixing [R Z2 T-1 ~> Pa s]. + real, dimension(SZI_(G)) :: & d_pres, & ! pressure change across a layer [Pa] p_lay, & ! average pressure in a layer [Pa] @@ -894,37 +904,38 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t nonpenSW, & ! non-downwelling SW, which is absorbed at ocean surface ! [degC H ~> degC m or degC kg m-2] SurfPressure, & ! Surface pressure (approximated as 0.0) [Pa] - dRhodT, & ! change in density per change in temperature [kg m-3 degC-1] - dRhodS, & ! change in density per change in salinity [kg m-3 ppt-1] - netheat_rate, & ! netheat but for dt=1 [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + dRhodT, & ! change in density per change in temperature [R degC-1 ~> kg m-3 degC-1] + dRhodS, & ! change in density per change in salinity [R ppt-1 ~> kg m-3 ppt-1] + netheat_rate, & ! netheat but for dt=1 [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) - ! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] - netMassInOut_rate! netmassinout but for dt=1 [H s-1 ~> m s-1 or kg m-2 s-1] + ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + netMassInOut_rate! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G), SZK_(G)) :: & h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] T2d, & ! A 2-d copy of the layer temperatures [degC] pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within - ! a layer [kg m-3 Z3 T-2 ~> J m-2] - dSV_dT_2d ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] - real, dimension(SZI_(G),SZK_(G)+1) :: netPen + ! a layer [R Z3 T-2 ~> J m-2] + dSV_dT_2d ! The partial derivative of specific volume with temperature [R-1 degC-1] + real, dimension(SZI_(G)) :: & + netPen_rate ! The surface penetrative shortwave heating rate summed over all bands + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1),SZI_(G)) :: & Pen_SW_bnd, & ! The penetrative shortwave heating integrated over a timestep by band ! [degC H ~> degC m or degC kg m-2] Pen_SW_bnd_rate ! The penetrative shortwave heating rate by band - ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1),SZI_(G),SZK_(G)) :: & opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency ! band of shortwave radation in each layer [H-1 ~> m-1 or m2 kg-1] real, dimension(maxGroundings) :: hGrounding real :: Temp_in, Salin_in -! real :: I_G_Earth ! The inverse of the gravitational acceleration with conversion factors [s2 m-1]. - real :: dt_in_T ! The time step converted to T units [T ~> s] - real :: g_Hconv2 + real :: g_Hconv2 ! A conversion factor for use in the TKE calculation + ! in units of [Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. real :: GoRho ! g_Earth times a unit conversion factor divided by density - ! [Z3 m T-2 kg-1 ~> m4 s-2 kg-1] + ! [Z T-2 R-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy - integer :: i, j, is, ie, js, je, k, nz, n + integer :: i, j, is, ie, js, je, k, nz, n, nb integer :: start, npts character(len=45) :: mesg @@ -934,14 +945,12 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (.not.associated(fluxes%sw)) return #define _OLD_ALG_ - dt_in_T = dt * US%s_to_T - Idt = 1.0/dt + Idt = 1.0 / dt calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 -! I_G_Earth = US%Z_to_m / (US%L_T_to_m_s**2 * GV%g_Earth) - g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 + g_Hconv2 = (US%L_to_Z**2*GV%g_Earth * GV%H_to_RZ) * GV%H_to_RZ if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then @@ -962,11 +971,11 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (CS%id_createdH>0) CS%createdH(:,:) = 0. numberOfGroundings = 0 - !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,tv,nsw,G,GV,US,optics,fluxes,dt, & + !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,tv,nsw,G,GV,US,optics,fluxes, & !$OMP H_limit_fluxes,numberOfGroundings,iGround,jGround,& !$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, & - !$OMP minimum_forcing_depth,evap_CFL_limit,dt_in_T, & - !$OMP calculate_buoyancy,netPen,SkinBuoyFlux,GoRho, & + !$OMP minimum_forcing_depth,evap_CFL_limit,dt, & + !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, & !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2) & !$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & !$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & @@ -999,12 +1008,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t pres(i) = pres(i) + d_pres(i) enddo call calculate_specific_vol_derivs(T2d(:,k), tv%S(:,j,k), p_lay(:),& - dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) + dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state, scale=US%R_to_kg_m3) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo -! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) -! enddo enddo pen_TKE_2d(:,:) = 0.0 endif @@ -1053,14 +1058,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! but do change answers. !----------------------------------------------------------------------------------------- if (calculate_buoyancy) then - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW, & net_Heat_rate=netheat_rate, net_salt_rate=netsalt_rate, & netmassinout_rate=netmassinout_rate, pen_sw_bnd_rate=pen_sw_bnd_rate) else - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW) @@ -1110,29 +1115,32 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Diagnostics of heat content associated with mass fluxes if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T2d(i,k) * max(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt + T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - T2d(i,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt + T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & - T2d(i,k) * dThickness * GV%H_to_kg_m2 + T2d(i,k) * dThickness * GV%H_to_RZ ! Determine the energetics of river mixing before updating the state. if (calculate_energetics .and. associated(fluxes%lrunoff) .and. CS%do_rivermix) then ! Here we add an additional source of TKE to the mixed layer where river - ! is present to simulate unresolved estuaries. The TKE input is diagnosed - ! as follows: - ! TKE_river[m3 s-3] = 0.5*rivermix_depth*g*(1/rho)*drho_ds* - ! River*(Samb - Sriver) = CS%mstar*U_star^3 - ! where River is in units of [m s-1]. + ! is present to simulate unresolved estuaries. The TKE input, TKE_river in + ! [Z3 T-3 ~> m3 s-3], is diagnosed as follows: + ! TKE_river = 0.5*rivermix_depth*g*(1/rho)*drho_ds* + ! River*(Samb - Sriver) = CS%mstar*U_star^3 + ! where River is in units of [Z T-1 ~> m s-1]. ! Samb = Ambient salinity at the mouth of the estuary ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*(US%m_to_Z**3 * US%T_to_s**2) * GV%Z_to_H*GV%H_to_Pa - + if (GV%Boussinesq) then + RivermixConst = -0.5*(CS%rivermix_depth*dt) * ( US%L_to_Z**2*GV%g_Earth ) * GV%Rho0 + else + RivermixConst = -0.5*(CS%rivermix_depth*dt) * GV%Rho0 * ( US%L_to_Z**2*GV%g_Earth ) + endif cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & - (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) + (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) endif ! Update state @@ -1188,14 +1196,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t dTemp = dTemp + dThickness*T2d(i,k) ! Diagnostics of heat content associated with mass fluxes - if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T2d(i,k) * max(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt - if (associated(fluxes%heat_content_massout)) & + if (associated(fluxes%heat_content_massin)) & + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & + T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - T2d(i,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt + T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & - T2d(i,k) * dThickness * GV%H_to_kg_m2 + T2d(i,k) * dThickness * GV%H_to_RZ ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand @@ -1274,14 +1282,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t endif if (calculate_energetics) then - call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd, TKE=pen_TKE_2d, dSV_dT=dSV_dT_2d) k = 1 ! For setting break-points. do k=1,nz ; do i=is,ie cTKE(i,j,k) = cTKE(i,j,k) + pen_TKE_2d(i,k) enddo ; enddo else - call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd) endif @@ -1299,7 +1307,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! convergence of SW into a layer do k=1,nz ; do i=is,ie - CS%penSW_diag(i,j,k) = (T2d(i,k)-CS%penSW_diag(i,j,k))*h(i,j,k) * Idt * tv%C_p * GV%H_to_kg_m2 + CS%penSW_diag(i,j,k) = (T2d(i,k)-CS%penSW_diag(i,j,k))*h(i,j,k) * US%s_to_T*Idt * tv%C_p * GV%H_to_kg_m2 enddo ; enddo ! Perform a cumulative sum upwards from bottom to @@ -1331,23 +1339,27 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (Calculate_Buoyancy) then drhodt(:) = 0.0 drhods(:) = 0.0 - netPen(:,:) = 0.0 - ! Sum over bands and attenuate as a function of depth - ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, US, h2d(:,:), optics_nbands(optics), optics, j, dt_in_T, & - H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) + netPen_rate(:) = 0.0 + ! Sum over bands and attenuate as a function of depth. + ! netPen_rate is the netSW as a function of depth, but only the surface value is used here, + ! in which case the values of dt, h, optics and H_limit_fluxes are irrelevant. Consider + ! writing a shorter and simpler variant to handle this very limited case. + ! call sumSWoverBands(G, GV, US, h2d(:,:), optics_nbands(optics), optics, j, dt, & + ! H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) + do i=is,ie ; do nb=1,nsw ; netPen_rate(i) = netPen_rate(i) + pen_SW_bnd_rate(nb,i) ; enddo ; enddo + ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, & - dRhodT, dRhodS, start, npts, tv%eqn_of_state) + dRhodT, dRhodS, start, npts, tv%eqn_of_state, scale=US%kg_m3_to_R) ! 1. Adjust netSalt to reflect dilution effect of FW flux ! 2. Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%T_to_s * & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * & (dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & - dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 + dRhodT(i) * ( netHeat_rate(i) + netPen_rate(i)) ) ! [Z2 T-3 ~> m2 s-3] enddo endif @@ -1475,7 +1487,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori if (useALEalgorithm) then CS%id_createdH = register_diag_field('ocean_model',"created_H",diag%axesT1, & Time, "The volume flux added to stop the ocean from drying out and becoming negative in depth", & - "m s-1") + "m s-1", conversion=GV%H_to_m*US%s_to_T) if (CS%id_createdH>0) allocate(CS%createdH(isd:ied,jsd:jed)) ! diagnostic for heating of a grid cell from convergence of SW heat into the cell diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 369ee5da40..f7dcc5fd4f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -17,7 +17,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids -use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end use MOM_diag_mediator, only : diag_copy_diag_to_storage, diag_copy_storage_to_diag use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids @@ -163,7 +163,7 @@ module MOM_diabatic_driver !< vertical diffusion of T and S logical :: debug_energy_req !< If true, test the mixing energy requirement code. type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output - real :: MLDdensityDifference !< Density difference used to determine MLD_user + real :: MLDdensityDifference !< Density difference used to determine MLD_user [R ~> kg m-3] real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the !! average stratification at the base of the mixed layer [Z ~> m]. @@ -272,7 +272,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [s] + real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves @@ -283,14 +283,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn_IGW ! baroclinic internal gravity wave speeds real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) - real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree if (G%ke == 1) return - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -313,7 +311,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call post_data(CS%id_e_predia, eta, CS%diag) endif - dt_in_T = dt * US%s_to_T if (CS%debug) then call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) @@ -321,7 +318,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) @@ -332,7 +329,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) + call enable_averages(0.5*dt, Time_end - real_to_time(0.5*US%T_to_s*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -393,7 +390,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! make_frazil is deliberately called at both the beginning and at ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) + call enable_averages(0.5*dt, Time_end, CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -419,13 +416,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Diagnose mixed layer depths. - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03*US%kg_m3_to_R, G, GV, US, CS%diag, & id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) endif if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125*US%kg_m3_to_R, G, GV, US, CS%diag) endif if (CS%id_MLD_user > 0) then call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) @@ -462,7 +459,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [s] + real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves @@ -483,9 +480,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] - dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] - dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. + dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -508,10 +505,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] - Sadv_flx ! advective diapycnal salt flux across interfaces [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that @@ -539,7 +536,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] real :: Idt ! The inverse time step [s-1] - real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree @@ -558,10 +554,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (showCallTree) call callTree_enter("diabatic_ALE_legacy(), MOM_diabatic_driver.F90") ! if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") - dt_in_T = dt * US%s_to_T - ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if (CS%use_geothermal) then halo = CS%halo_TS_diff @@ -573,7 +567,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -608,7 +602,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & - visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) + visc, dt, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -719,8 +713,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & + US%T_to_s*dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & + US%T_to_s*dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -738,7 +734,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim (CS%use_legacy_diabatic .or. .not.CS%use_CVMix_ddiff)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -788,7 +784,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_int(i,j,K) eb_s(i,j,k-1) = ea_s(i,j,k) ea_t(i,j,k-1) = ea_s(i,j,k-1) ; eb_t(i,j,k-1) = eb_s(i,j,k-1) enddo ; enddo ; enddo @@ -835,13 +831,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call hchksum(eb_t, "after applyBoundaryFluxes eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after applyBoundaryFluxes ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after applyBoundaryFluxes eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE", G%HI, haloshift=0, & + scale=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**2) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, scale=US%kg_m3_to_R) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, scale=US%kg_m3_to_R) endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -866,7 +863,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%use_legacy_diabatic) then - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int ea_s(i,j,k) = ea_s(i,j,k) + Ent_int @@ -1008,9 +1005,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1081,7 +1078,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -1100,7 +1097,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_int, ! perhaps a molecular diffusivity. - add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -1119,10 +1116,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then if (CS%use_legacy_diabatic) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + h_neglect) else - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) endif @@ -1136,7 +1133,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) @@ -1150,10 +1147,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then if (CS%use_legacy_diabatic) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + h_neglect) else - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) endif @@ -1165,13 +1162,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo ; enddo ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug,& evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) else ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) @@ -1195,7 +1192,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call disable_averaging(CS%diag) ! Diagnose the diapycnal diffusivities and other related quantities. - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) @@ -1245,7 +1242,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [s] + real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves @@ -1266,9 +1263,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] - dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] - dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. + dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1291,10 +1288,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] - Sadv_flx ! advective diapycnal salt flux across interfaces [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that @@ -1322,7 +1319,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] real :: Idt ! The inverse time step [s-1] - real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree @@ -1343,10 +1339,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (.not. (CS%useALEalgorithm)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "The ALE algorithm must be enabled when using MOM_diabatic_driver.") - dt_in_T = dt * US%s_to_T - ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if (CS%use_geothermal) then halo = CS%halo_TS_diff @@ -1358,7 +1352,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -1393,7 +1387,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & - visc, dt_in_T, G, GV, US,CS%set_diff_CSp, Kd_lay, Kd_int) + visc, dt, G, GV, US,CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1484,8 +1478,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & + US%T_to_s*dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & + US%T_to_s*dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -1503,7 +1499,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, (.not.CS%use_CVMix_ddiff)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -1565,13 +1561,14 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call hchksum(eb_t, "after applyBoundaryFluxes eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after applyBoundaryFluxes ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after applyBoundaryFluxes eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0, & + scale=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**2) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0, scale=US%kg_m3_to_R) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0, scale=US%kg_m3_to_R) endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -1673,9 +1670,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1760,7 +1757,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -1779,7 +1776,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_int, ! perhaps a molecular diffusivity. - add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -1797,7 +1794,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -1810,7 +1807,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) @@ -1823,7 +1820,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1834,13 +1831,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, enddo ; enddo ; enddo ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug,& evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) else ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) @@ -1878,7 +1875,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call disable_averaging(CS%diag) ! Diagnose the diapycnal diffusivities and other related quantities. - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) @@ -1924,7 +1921,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [s] + real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves @@ -1940,9 +1937,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] - dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] - dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. + dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1966,10 +1962,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] - Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] - Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & @@ -2013,7 +2009,6 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] real :: Idt ! The inverse time step [s-1] real :: Idt_accel ! The inverse time step times rescaling factors [T-1 ~> s-1] - real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree @@ -2034,10 +2029,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! set equivalence between the same bits of memory for these arrays eaml => eatr ; ebml => ebtr - dt_in_T = dt * US%s_to_T ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then halo = CS%halo_TS_diff @@ -2049,7 +2043,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -2081,17 +2075,17 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T*CS%ML_mix_first, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.false.) + Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & + call insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS%diabatic_aux_CSp, & dt*CS%ML_mix_first, CS%id_brine_lay) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T, eaml, ebml, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) endif ! Keep salinity from falling below a small but positive threshold. @@ -2136,7 +2130,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & - visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) + visc, dt, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -2245,8 +2239,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & + US%T_to_s*dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & + US%T_to_s*dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -2263,7 +2259,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) @@ -2288,7 +2284,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_entrain) ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(h, tv, fluxes, dt_in_T, G, GV, US, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -2471,15 +2467,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, US, haloshift=0) - dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) + dt_mix = min(dt, dt*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, US%T_to_s*dt_mix, & + call insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & CS%id_brine_lay) ! Keep salinity from falling below a small but positive threshold. @@ -2536,7 +2532,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! the bulk mixed layer scheme, so tendencies should be posted on hold. if (CS%diabatic_diff_tendency_diag) then call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) - if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h=hold) endif call cpu_clock_end(id_clock_tridiag) @@ -2555,7 +2551,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) + call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers_CSp) call cpu_clock_end(id_clock_remap) if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) @@ -2599,7 +2595,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2618,7 +2614,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2635,7 +2631,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2646,7 +2642,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug) elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -2657,7 +2653,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else @@ -2667,11 +2663,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug) else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, US%T_to_s*dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug) endif ! (CS%mix_boundary_tracers) @@ -2687,11 +2683,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !$OMP parallel do default(shared) do j=js,je call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) + call apply_sponge(h, dt, G, GV, US, ea, eb, CS%sponge_CSp, Rcv_ml) else - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) + call apply_sponge(h, dt, G, GV, US, ea, eb, CS%sponge_CSp) endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then @@ -2705,7 +2701,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !$OMP parallel do default(shared) do j=js,je do K=2,nz ; do i=is,ie - CDp%diapyc_vel(i,j,K) = Idt * (ea(i,j,k) - eb(i,j,k-1)) + CDp%diapyc_vel(i,j,K) = US%s_to_T*Idt * (ea(i,j,k) - eb(i,j,k-1)) enddo ; enddo do i=is,ie CDp%diapyc_vel(i,j,1) = 0.0 @@ -2768,7 +2764,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) endif call cpu_clock_begin(id_clock_tridiag) - Idt_accel = 1.0 / dt_in_T + Idt_accel = 1.0 / dt !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq @@ -2837,7 +2833,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call disable_averaging(CS%diag) ! Diagnose the diapycnal diffusivities and other related quantities. - call enable_averaging(dt, Time_end, CS%diag) + call enable_averages(dt, Time_end, CS%diag) if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) @@ -2919,13 +2915,13 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to diabatic physics real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics [ppt] - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt !< time step [T ~> s] type(diabatic_CS), pointer :: CS !< module control structure ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep [s-1] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz logical :: do_saln_tend ! Calculate salinity-based tendency diagnosics @@ -2941,7 +2937,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt enddo ; enddo ; enddo if (CS%id_diabatic_diff_temp_tend > 0) then - call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h = h) + call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h=h) endif ! heat tendency @@ -2950,7 +2946,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) enddo ; enddo ; enddo if (CS%id_diabatic_diff_heat_tend > 0) then - call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h = h) + call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h=h) endif if (CS%id_diabatic_diff_heat_tend_2d > 0) then do j=js,je ; do i=is,ie @@ -3016,13 +3012,13 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, intent(in) :: saln_old !< salinity prior to boundary flux application [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_old !< thickness prior to boundary flux application [H ~> m or kg m-2] - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt !< time step [T ~> s] type(diabatic_CS), pointer :: CS !< module control structure ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep [s-1] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz @@ -3036,7 +3032,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (h(i,j,k) - h_old(i,j,k))*Idt enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_h_tendency, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_boundary_forcing_h_tendency, work_3d, CS%diag, alt_h=h_old) endif ! temperature tendency @@ -3044,7 +3040,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag, alt_h=h_old) endif ! heat tendency @@ -3107,10 +3103,10 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation [degC] - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt !< time step [T ~> s] real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -3407,16 +3403,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (use_temperature) then CS%id_Tdif = register_diag_field('ocean_model',"Tflx_dia_diff",diag%axesTi, & Time, "Diffusive diapycnal temperature flux across interfaces", & - "degC m s-1", conversion=GV%H_to_m) + "degC m s-1", conversion=GV%H_to_m*US%s_to_T) CS%id_Tadv = register_diag_field('ocean_model',"Tflx_dia_adv",diag%axesTi, & Time, "Advective diapycnal temperature flux across interfaces", & - "degC m s-1", conversion=GV%H_to_m) + "degC m s-1", conversion=GV%H_to_m*US%s_to_T) CS%id_Sdif = register_diag_field('ocean_model',"Sflx_dia_diff",diag%axesTi, & Time, "Diffusive diapycnal salnity flux across interfaces", & - "psu m s-1", conversion=GV%H_to_m) + "psu m s-1", conversion=GV%H_to_m*US%s_to_T) CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, & Time, "Advective diapycnal salnity flux across interfaces", & - "psu m s-1", conversion=GV%H_to_m) + "psu m s-1", conversion=GV%H_to_m*US%s_to_T) CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=US%Z_to_m, & cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & @@ -3436,7 +3432,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "The density difference used to determine a diagnostic mixed "//& "layer depth, MLD_user, following the definition of Levitus 1982. "//& "The MLD is the depth at which the density is larger than the "//& - "surface density by the specified amount.", units='kg/m3', default=0.1) + "surface density by the specified amount.", & + units='kg/m3', default=0.1, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DIAG_DEPTH_SUBML_N2", CS%dz_subML_N2, & "The distance over which to calculate a diagnostic of the "//& "stratification at the base of the mixed layer.", & @@ -3516,19 +3513,19 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! available only for ALE algorithm. ! diagnostics for tendencies of temp and heat due to frazil CS%id_diabatic_diff_h = register_diag_field('ocean_model', 'diabatic_diff_h', diag%axesTL, Time, & - long_name = 'Cell thickness used during diabatic diffusion', units='m', & + long_name='Cell thickness used during diabatic diffusion', units='m', & conversion=GV%H_to_m, v_extensive=.true.) if (CS%useALEalgorithm) then CS%id_diabatic_diff_temp_tend = register_diag_field('ocean_model', & 'diabatic_diff_temp_tendency', diag%axesTL, Time, & - 'Diabatic diffusion temperature tendency', 'degC s-1') + 'Diabatic diffusion temperature tendency', 'degC s-1', conversion=US%s_to_T) if (CS%id_diabatic_diff_temp_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif CS%id_diabatic_diff_saln_tend = register_diag_field('ocean_model',& 'diabatic_diff_saln_tendency', diag%axesTL, Time, & - 'Diabatic diffusion salinity tendency', 'psu s-1') + 'Diabatic diffusion salinity tendency', 'psu s-1', conversion=US%s_to_T) if (CS%id_diabatic_diff_saln_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif @@ -3536,11 +3533,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & 'diabatic_heat_tendency', diag%axesTL, Time, & 'Diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff', & + 'W m-2', conversion=US%s_to_T, cmor_field_name='opottempdiff', & cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'// & 'due_to_parameterized_dianeutral_mixing', & cmor_long_name='Tendency of sea water potential temperature expressed as heat content '// & - 'due to parameterized dianeutral mixing',& + 'due to parameterized dianeutral mixing', & v_extensive=.true.) if (CS%id_diabatic_diff_heat_tend > 0) then CS%diabatic_diff_tendency_diag = .true. @@ -3549,7 +3546,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & 'diabatic_salt_tendency', diag%axesTL, Time, & 'Diabatic diffusion of salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff', & + 'kg m-2 s-1', conversion=US%s_to_T, cmor_field_name='osaltdiff', & cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & 'due_to_parameterized_dianeutral_mixing', & cmor_long_name='Tendency of sea water salinity expressed as salt content '// & @@ -3563,7 +3560,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & 'diabatic_heat_tendency_2d', diag%axesT1, Time, & 'Depth integrated diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff_2d', & + 'W m-2', conversion=US%s_to_T, cmor_field_name='opottempdiff_2d', & cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'//& 'due_to_parameterized_dianeutral_mixing_depth_integrated', & cmor_long_name='Tendency of sea water potential temperature expressed as heat content '//& @@ -3576,7 +3573,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & 'diabatic_salt_tendency_2d', diag%axesT1, Time, & 'Depth integrated diabatic diffusion salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & + 'kg m-2 s-1', conversion=US%s_to_T, cmor_field_name='osaltdiff_2d', & cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & 'due_to_parameterized_dianeutral_mixing_depth_integrated', & cmor_long_name='Tendency of sea water salinity expressed as salt content '// & @@ -3589,11 +3586,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! available only for ALE algorithm. ! diagnostics for tendencies of temp and heat due to frazil CS%id_boundary_forcing_h = register_diag_field('ocean_model', 'boundary_forcing_h', diag%axesTL, Time, & - long_name = 'Cell thickness after applying boundary forcing', units='m', & + long_name='Cell thickness after applying boundary forcing', units='m', & conversion=GV%H_to_m, v_extensive=.true.) CS%id_boundary_forcing_h_tendency = register_diag_field('ocean_model', & 'boundary_forcing_h_tendency', diag%axesTL, Time, & - 'Cell thickness tendency due to boundary forcing', 'm s-1', & + 'Cell thickness tendency due to boundary forcing', 'm s-1', conversion=US%s_to_T, & v_extensive = .true.) if (CS%id_boundary_forcing_h_tendency > 0) then CS%boundary_forcing_tendency_diag = .true. @@ -3601,21 +3598,21 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_boundary_forcing_temp_tend = register_diag_field('ocean_model',& 'boundary_forcing_temp_tendency', diag%axesTL, Time, & - 'Boundary forcing temperature tendency', 'degC s-1') + 'Boundary forcing temperature tendency', 'degC s-1', conversion=US%s_to_T) if (CS%id_boundary_forcing_temp_tend > 0) then CS%boundary_forcing_tendency_diag = .true. endif CS%id_boundary_forcing_saln_tend = register_diag_field('ocean_model',& 'boundary_forcing_saln_tendency', diag%axesTL, Time, & - 'Boundary forcing saln tendency', 'psu s-1') + 'Boundary forcing saln tendency', 'psu s-1', conversion=US%s_to_T) if (CS%id_boundary_forcing_saln_tend > 0) then CS%boundary_forcing_tendency_diag = .true. endif CS%id_boundary_forcing_heat_tend = register_diag_field('ocean_model',& 'boundary_forcing_heat_tendency', diag%axesTL, Time, & - 'Boundary forcing heat tendency','W m-2', & + 'Boundary forcing heat tendency', 'W m-2', conversion=US%s_to_T, & v_extensive = .true.) if (CS%id_boundary_forcing_heat_tend > 0) then CS%boundary_forcing_tendency_diag = .true. @@ -3623,7 +3620,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_boundary_forcing_salt_tend = register_diag_field('ocean_model',& 'boundary_forcing_salt_tendency', diag%axesTL, Time, & - 'Boundary forcing salt tendency','kg m-2 s-1', & + 'Boundary forcing salt tendency', 'kg m-2 s-1', conversion=US%s_to_T, & v_extensive = .true.) if (CS%id_boundary_forcing_salt_tend > 0) then CS%boundary_forcing_tendency_diag = .true. @@ -3632,7 +3629,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! This diagnostic should equal to surface heat flux if all is working well. CS%id_boundary_forcing_heat_tend_2d = register_diag_field('ocean_model',& 'boundary_forcing_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated boundary forcing of ocean heat','W m-2') + 'Depth integrated boundary forcing of ocean heat', 'W m-2', conversion=US%s_to_T) if (CS%id_boundary_forcing_heat_tend_2d > 0) then CS%boundary_forcing_tendency_diag = .true. endif @@ -3640,7 +3637,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! This diagnostic should equal to surface salt flux if all is working well. CS%id_boundary_forcing_salt_tend_2d = register_diag_field('ocean_model',& 'boundary_forcing_salt_tendency_2d', diag%axesT1, Time, & - 'Depth integrated boundary forcing of ocean salt','kg m-2 s-1') + 'Depth integrated boundary forcing of ocean salt','kg m-2 s-1', conversion=US%s_to_T) if (CS%id_boundary_forcing_salt_tend_2d > 0) then CS%boundary_forcing_tendency_diag = .true. endif @@ -3648,13 +3645,13 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostics for tendencies of temp and heat due to frazil CS%id_frazil_h = register_diag_field('ocean_model', 'frazil_h', diag%axesTL, Time, & - long_name = 'Cell Thickness', standard_name='cell_thickness', units='m', & + long_name='Cell Thickness', standard_name='cell_thickness', units='m', & conversion=GV%H_to_m, v_extensive=.true.) ! diagnostic for tendency of temp due to frazil CS%id_frazil_temp_tend = register_diag_field('ocean_model',& 'frazil_temp_tendency', diag%axesTL, Time, & - 'Temperature tendency due to frazil formation', 'degC s-1') + 'Temperature tendency due to frazil formation', 'degC s-1', conversion=US%s_to_T) if (CS%id_frazil_temp_tend > 0) then CS%frazil_tendency_diag = .true. endif @@ -3662,7 +3659,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostic for tendency of heat due to frazil CS%id_frazil_heat_tend = register_diag_field('ocean_model',& 'frazil_heat_tendency', diag%axesTL, Time, & - 'Heat tendency due to frazil formation','W m-2', v_extensive = .true.) + 'Heat tendency due to frazil formation', 'W m-2', conversion=US%s_to_T, v_extensive=.true.) if (CS%id_frazil_heat_tend > 0) then CS%frazil_tendency_diag = .true. endif @@ -3670,7 +3667,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! if all is working propertly, this diagnostic should equal to hfsifrazil CS%id_frazil_heat_tend_2d = register_diag_field('ocean_model',& 'frazil_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated heat tendency due to frazil formation','W m-2') + 'Depth integrated heat tendency due to frazil formation', 'W m-2', conversion=US%s_to_T) if (CS%id_frazil_heat_tend_2d > 0) then CS%frazil_tendency_diag = .true. endif @@ -3692,7 +3689,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! initialize the geothermal heating module if (CS%use_geothermal) & - call geothermal_init(Time, G, GV, param_file, diag, CS%geothermal_CSp) + call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal_CSp) ! initialize module for internal tide induced mixing if (CS%use_int_tides) then diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5527866793..8ae83ca615 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -37,7 +37,7 @@ module MOM_energetic_PBL !/ Constants real :: VonKar = 0.41 !< The von Karman coefficient. This should be runtime, but because !! it is runtime in KPP and set to 0.4 it might change answers. - real :: omega !< The Earth's rotation rate [T-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as !! sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. @@ -165,16 +165,16 @@ module MOM_energetic_PBL real, allocatable, dimension(:,:) :: & ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m]. - ! These are terms in the mixed layer TKE budget, all in [kg m-3 Z3 T-2 ~> J m-2] = [kg s-2]. + ! These are terms in the mixed layer TKE budget, all in [R Z3 T-3 ~> W m-2 = kg s-3]. real, allocatable, dimension(:,:) :: & - diag_TKE_wind, & !< The wind source of TKE [kg m-3 Z3 T-3 ~> W m-2]. - diag_TKE_MKE, & !< The resolved KE source of TKE [kg m-3 Z3 T-3 ~> W m-2]. - diag_TKE_conv, & !< The convective source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_wind, & !< The wind source of TKE [R Z3 T-3 ~> W m-2]. + diag_TKE_MKE, & !< The resolved KE source of TKE [R Z3 T-3 ~> W m-2]. + diag_TKE_conv, & !< The convective source of TKE [R Z3 T-3 ~> W m-2]. diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating - !! [kg m-3 Z3 T-2 ~> W m-2]. - diag_TKE_mech_decay, & !< The decay of mechanical TKE [kg m-3 Z3 T-3 ~> W m-2]. - diag_TKE_conv_decay, & !< The decay of convective TKE [kg m-3 Z3 T-3 ~> W m-2]. - diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [kg m-3 Z3 T-3 ~> W m-2]. + !! [R Z3 T-3 ~> W m-2]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [R Z3 T-3 ~> W m-2]. + diag_TKE_conv_decay, & !< The decay of convective TKE [R Z3 T-3 ~> W m-2]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [R Z3 T-3 ~> W m-2]. ! These additional diagnostics are also 2d. MSTAR_MIX, & !< Mstar used in EPBL [nondim] MSTAR_LT, & !< Mstar due to Langmuir turbulence [nondim] @@ -219,7 +219,7 @@ module MOM_energetic_PBL !> A type for conveniently passing around ePBL diagnostics for a column. type, public :: ePBL_column_diags ; private - !>@{ Local column copies of energy change diagnostics, all in [kg m-3 Z3 T-3 ~> W m-2]. + !>@{ Local column copies of energy change diagnostics, all in [R Z3 T-3 ~> W m-2]. real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !!@} @@ -254,14 +254,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature - !! [m3 kg-1 degC-1]. + !! [R-1 degC-1 ~> m3 kg-1 degC-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dS !< The partial derivative of in-situ specific - !! volume with salinity [m3 kg-1 ppt-1]. + !! volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the !! forcing that has been applied to each layer - !! [kg m-3 Z3 T-2 ~> J m-2]. + !! [R Z3 T-2 ~> J m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -320,9 +320,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. T_2d, & ! A 2-d slice of the layer temperatures [degC]. S_2d, & ! A 2-d slice of the layer salinities [ppt]. - TKE_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. - dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. - dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. + TKE_forced_2d, & ! A 2-d slice of TKE_forced [R Z3 T-2 ~> J m-2]. + dSV_dT_2d, & ! A 2-d slice of dSV_dT [R-1 degC-1 ~> m3 kg-1 degC-1]. + dSV_dS_2d, & ! A 2-d slice of dSV_dS [R-1 ppt-1 ~> m3 kg-1 ppt-1]. u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1]. v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -331,9 +331,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h, & ! The layer thickness [H ~> m or kg m-2]. T0, & ! The initial layer temperatures [degC]. S0, & ! The initial layer salinities [ppt]. - dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. - dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. - TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. + dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1]. + dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [R Z3 T-2 ~> J m-2]. u, & ! The zonal velocity [L T-1 ~> m s-1]. v ! The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZK_(GV)+1) :: & @@ -343,7 +343,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: absf ! The absolute value of f [T-1]. + real :: absf ! The absolute value of f [T-1 ~> s-1]. real :: U_star ! The surface friction velocity [Z T-1 ~> m s-1]. real :: U_Star_Mean ! The surface friction without gustiness [Z T-1 ~> m s-1]. real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3] @@ -539,20 +539,20 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [degC]. real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [ppt]. real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature - !! [m3 kg-1 degC-1]. + !! [R-1 degC-1 ~> m3 kg-1 degC-1]. real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific - !! volume with salinity [m3 kg-1 ppt-1]. + !! volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the !! forcing that has been applied to each layer - !! [kg m-3 Z3 T-2 ~> J m-2]. + !! [R Z3 T-2 ~> J m-2]. real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1]. real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. @@ -595,15 +595,15 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! mixing. ! Local variables - real, dimension(SZK_(GV)+1) :: & + real, dimension(SZK_(GV)+1) :: & pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [kg m-3 Z2 T-2 ~> kg m-1 s-2]. + ! movements into changes in column potential energy [R Z2 T-2 ~> kg m-1 s-2]. hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. real :: mech_TKE ! The mechanically generated turbulent kinetic energy - ! available for mixing over a time step [kg m-3 Z3 T-2 ~> J m-2]. + ! available for mixing over a time step [R Z3 T-2 ~> J m-2]. real :: conv_PErel ! The potential energy that has been convectively released - ! during this timestep [kg m-3 Z3 T-2 ~> J m-2]. A portion nstar_FC + ! during this timestep [R Z3 T-2 ~> J m-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. real :: uhtot ! The depth integrated zonal and meridional velocities in the @@ -617,9 +617,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes ! within a layer [Z ppt-1 ~> m ppt-1]. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - ! changes within a layer, in [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + ! changes within a layer, in [R Z3 T-2 degC-1 ~> J m-2 degC-1]. dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes - ! within a layer, in [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + ! within a layer, in [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes ! within a layer, including the implicit effects of mixing with layers higher ! in the water column [Z degC-1 ~> m degC-1]. @@ -628,10 +628,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! in the water column [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes ! within a layer, including the implicit effects of mixing with layers higher - ! in the water column [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + ! in the water column [R Z3 T-2 degC-1 ~> J m-2 degC-1]. dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes ! within a layer, including the implicit effects of mixing with layers higher - ! in the water column [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + ! in the water column [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. c1, & ! c1 is used by the tridiagonal solver [nondim]. Te, & ! Estimated final values of T in the column [degC]. Se, & ! Estimated final values of S in the column [ppt]. @@ -657,12 +657,12 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! in the denominator of b1 in a downward-oriented tridiagonal solver. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: dMass ! The mass per unit area within a layer [Z kg m-3 ~> kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [kg m-3 Z2 T-2 ~> kg m-1 s-2 = Pa]. + real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2]. + real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> kg m-1 s-2 = Pa = J m-3]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface [kg m-3 Z3 T-2 ~> J m-2]. + ! the water above the interface [R Z3 T-2 ~> J m-2]. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! of a layer and the thickness of the water above, used in ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. @@ -679,7 +679,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. real :: C1_3 ! = 1/3. - real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m6 Z-3 kg-1 T2 s-3 ~> m3 kg-1 s-1]. + real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1]. ! This is used convert TKE back into ustar^3. real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] @@ -692,8 +692,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing [nondim]. between 0 and 1. - real :: tot_TKE ! The total TKE available to support mixing at interface K [kg m-3 Z3 T-2 ~> J m-2]. - real :: TKE_here ! The total TKE at this point in the algorithm [kg m-3 Z3 T-2 ~> J m-2]. + real :: tot_TKE ! The total TKE available to support mixing at interface K [R Z3 T-2 ~> J m-2]. + real :: TKE_here ! The total TKE at this point in the algorithm [R Z3 T-2 ~> J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature ! change in the layer above the interface [degC]. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity @@ -704,24 +704,26 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. - real :: dPE_conv ! The convective change in column potential energy [kg m-3 Z3 T-2 ~> J m-2]. - real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. - real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. + real :: dPE_conv ! The convective change in column potential energy [R Z3 T-2 ~> J m-2]. + real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [R Z3 T-2 ~> J m-2]. + real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. - real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [kg m-3 Z3 T-2 ~> J m-2] - real :: dPEa_dKd_g0 + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [R Z3 T-2 ~> J m-2] + !### The following might be unused. + real :: dPEa_dKd_g0 ! The derivative of the change in the potential energy of the column above an interface + ! with the diffusivity when the Kd is Kd_guess0 [R Z T-1 ~> J s m-4] real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided ! by the average thicknesses around a layer [H ~> m or kg m-2]. - real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. + real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K) [R Z3 T-2 ~> J m-2]. real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) - ! for very small values of Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. + ! for very small values of Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. real :: PE_chg ! The change in potential energy due to mixing at an - ! interface [kg m-3 Z3 T-2 ~> J m-2], positive for the column increasing + ! interface [R Z3 T-2 ~> J m-2], positive for the column increasing ! in potential energy (i.e., consuming TKE). real :: TKE_left ! The amount of turbulent kinetic energy left for the most - ! recent guess at Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. - real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [kg m-3 Z3 T-2 ~> J m-2]. + ! recent guess at Kddt_h(K) [R Z3 T-2 ~> J m-2]. + real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. + real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [R Z3 T-2 ~> J m-2]. real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. @@ -738,7 +740,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! from the surface. ! The following are only used for diagnostics. - real :: dt__diag ! A copy of dt_diag (if present) or dt [T]. + real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s]. real :: I_dtdiag ! = 1.0 / dt__diag [T-1 ~> s-1]. !---------------------------------------------------------------------- @@ -805,7 +807,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs pres_Z(1) = 0.0 do k=1,nz - dMass = US%m_to_Z * GV%H_to_kg_m2 * h(k) + dMass = GV%H_to_RZ * h(k) dPres = US%L_to_Z**2 * GV%g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dS(k) @@ -1085,7 +1087,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then ! This is the energy that would be available from homogenizing the ! velocities between layer k and the layers above. - dMKE_max = (US%L_to_Z**2*US%m_to_Z*GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + dMKE_max = (US%L_to_Z**2*GV%H_to_RZ * CS%MKE_to_TKE_effic) * 0.5 * & (h(k) / ((htot + h(k))*htot)) * & ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be @@ -1441,7 +1443,7 @@ end subroutine ePBL_column subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, & pres_Z, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, & - PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) + PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, PE_ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the !! thicknesses around the interface [H ~> m or kg m-2]. @@ -1471,22 +1473,22 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers above [R Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! salinities of all the layers above [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers below [R Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! salinities of all the layers below [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. + !! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1505,23 +1507,23 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. + !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h - !! [J m-2 H-1 ~> J m-3 or J kg-1]. + !! [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [kg m-3 Z3 T-2 ~> J m-2]. + !! present interface [R Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. - real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net - !! change in the column height [kg m-3 Z3 T-2 ~> J m-2]. + !! limit where Kddt_h = 0 [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. + real, optional, intent(out) :: PE_ColHt_cor !< The correction to PE_chg that is made due to a net + !! change in the column height [R Z3 T-2 ~> J m-2]. real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes [kg m-3 Z2 T-2 ~> J m-3]. + ! for the potential energy changes [R Z2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions ! for the column height changes [H Z ~> m2 or kg m-1]. real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2]. @@ -1552,10 +1554,10 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & PE_chg = PEc_core * y1_3 ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg - if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) - elseif (present(ColHt_cor)) then + if (present(PE_ColHt_cor)) PE_ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) + elseif (present(PE_ColHt_cor)) then y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) + PE_ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) endif if (present(dPEc_dKd)) then @@ -1610,23 +1612,23 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! salinity change in the layer above the interface [ppt]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. + !! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers below [R Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! in the salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! in the salinities of all the layers below [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers above [R Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! salinities of all the layers above [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes in the @@ -1645,14 +1647,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. + !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h - !! [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. + !! [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [kg m-3 Z3 T-2 ~> J m-2]. + !! present interface [R Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. ! This subroutine determines the total potential energy change due to mixing ! at an interface, including all of the implicit effects of the prescribed @@ -1747,7 +1749,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1] real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1] - real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [T-1] + real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [T-1 ~> s-1] real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: BLD !< boundary layer depth [Z ~> m] real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim] @@ -1950,7 +1952,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. character(len=20) :: tmpstr real :: omega_frac_dflt - real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] + real :: R_Z3_T3_to_kg_s3 ! A conversion factor for work diagnostics [kg T3 R-1 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed integer :: mstar_mode, LT_enhance, wT_mode logical :: default_2018_answers @@ -2307,25 +2309,25 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Checking output flags - Z3_T3_to_m3_s3 = US%Z_to_m**3 * US%s_to_T**3 + R_Z3_T3_to_kg_s3 = US%R_to_kg_m3 * US%Z_to_m**3 * US%s_to_T**3 CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, & Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//& - 'through model layers', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + 'through model layers', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=R_Z3_T3_to_kg_s3) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index a4d8e985cf..d7985d1f1b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -35,6 +35,7 @@ module MOM_entrain_diffusive !! calculate the diapycnal entrainment. real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values !! [H ~> m or kg m-2]. + real :: Rho_sig_off !< The offset between potential density and a sigma value [R ~> kg m-3] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. integer :: id_Kd = -1 !< Diagnostic ID for diffusivity @@ -111,7 +112,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! layer after the effects of boundary conditions are ! considered [Z2 T-1 ~> m2 s-1]. diff_work ! The work actually done by diffusion across each - ! interface [W m-2]. Sum vertically for the total work. + ! interface [R Z3 T-3 ~> W m-2]. Sum vertically for the total work. real :: hm, fm, fr, fk ! Work variables with units of H, H, H, and H2. @@ -121,18 +122,18 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real, dimension(SZI_(G)) :: & htot, & ! The total thickness above or below a layer [H ~> m or kg m-2]. Rcv, & ! Value of the coordinate variable (potential density) - ! based on the simulated T and S and P_Ref [kg m-3]. + ! based on the simulated T and S and P_Ref [R ~> kg m-3]. pres, & ! Reference pressure (P_Ref) [Pa]. eakb, & ! The entrainment from above by the layer below the buffer ! layer (i.e. layer kb) [H ~> m or kg m-2]. ea_kbp1, & ! The entrainment from above by layer kb+1 [H ~> m or kg m-2]. eb_kmb, & ! The entrainment from below by the deepest buffer layer [H ~> m or kg m-2]. dS_kb, & ! The reference potential density difference across the - ! interface between the buffer layers and layer kb [kg m-3]. + ! interface between the buffer layers and layer kb [R ~> kg m-3]. dS_anom_lim, &! The amount by which dS_kb is reduced when limits are - ! applied [kg m-3]. + ! applied [R ~> kg m-3]. I_dSkbp1, & ! The inverse of the potential density difference across the - ! interface below layer kb [m3 kg-1]. + ! interface below layer kb [R-1 ~> m3 kg-1]. dtKd_kb, & ! The diapycnal diffusivity in layer kb times the time step ! [H2 ~> m2 or kg2 m-4]. maxF_correct, & ! An amount by which to correct maxF due to excessive @@ -152,7 +153,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real, dimension(SZI_(G),SZK_(G)) :: & Sref, & ! The reference potential density of the mixed and buffer layers, ! and of the two lightest interior layers (kb and kb+1) copied - ! into layers kmb+1 and kmb+2 [kg m-3]. + ! into layers kmb+1 and kmb+2 [R ~> kg m-3]. h_bl ! The thicknesses of the mixed and buffer layers, and of the two ! lightest interior layers (kb and kb+1) copied into layers kmb+1 ! and kmb+2 [H ~> m or kg m-2]. @@ -169,15 +170,15 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! 4*ds_Lay*(1/ds_k + 1/ds_k+1). [nondim] real :: dRHo ! The change in locally referenced potential density between - ! the layers above and below an interface [kg m-3]. + ! the layers above and below an interface [R ~> kg m-3]. real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors ! [m3 H-2 s-2 T-1 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to ! evaluate dRho_dT and dRho_dS [degC] and [ppt]. - dRho_dT, dRho_dS ! The partial derivatives of potential density with - ! temperature and salinity, [kg m-3 degC-1] and [kg m-3 ppt-1]. + dRho_dT, dRho_dS ! The partial derivatives of potential density with temperature and + ! salinity, [R degC-1 ~> kg m-3 degC-1] and [R ppt-1 ~> kg m-3 ppt-1]. real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. @@ -196,6 +197,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: do_any + logical :: do_entrain_eakb ! True if buffer layer is entrained logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density integer :: it, i, j, k, is, ie, js, je, nz, K2, kmb integer :: kb(SZI_(G)) ! The value of kb in row j. @@ -254,7 +256,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & !$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, & !$OMP zeros,maxF_kb,maxF,ea_kbp1,eakb,Sref, & - !$OMP maxF_correct,do_any, & + !$OMP maxF_correct,do_any,do_entrain_eakb, & !$OMP err_min_eakb0,err_max_eakb0,eakb_maxF, & !$OMP min_eakb,err_eakb0,F,minF,hm,fk,F_kb_maxent,& !$OMP F_kb,is1,ie1,kb_min_act,dFdfm_kb,b1,dFdfm, & @@ -299,7 +301,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! This subroutine determines the averaged entrainment across each ! interface and causes thin and relatively light interior layers to be ! entrained by the deepest buffer layer. This also determines kb. - call set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref, h_bl) + call set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, Sref, h_bl) do i=is,ie dtKd_kb(i) = 0.0 ; if (kb(i) < nz) dtKd_kb(i) = dtKd(i,kb(i)) @@ -355,10 +357,16 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & kmb, is, ie, G, GV, CS, F_kb_maxEnt, do_i_in = do_i) do i=is,ie - if ((.not.do_i(i)) .or. (err_max_eakb0(i) >= 0.0)) then - eakb(i) = 0.0 ; min_eakb(i) = 0.0 - else ! If error_max_eakb0 < 0 the buffer layers are always all entrained. + do_entrain_eakb = .false. + ! If error_max_eakb0 < 0, then buffer layers are always all entrained + if (do_i(i)) then ; if (err_max_eakb0(i) < 0.0) then + do_entrain_eakb = .true. + endif ; endif + + if (do_entrain_eakb) then eakb(i) = max_eakb(i) ; min_eakb(i) = max_eakb(i) + else + eakb(i) = 0.0 ; min_eakb(i) = 0.0 endif enddo @@ -381,7 +389,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*US%m_to_Z) + maxF(i,1) = GV%Z_to_H * (dt*fluxes%buoy(i,j)) / GV%g_prime(2) enddo ; endif endif @@ -413,11 +421,13 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & endif endif do k=nz-1,kb_min,-1 ; do i=is,ie ; if (do_i(i)) then - if (k>=kb(i)) then + if (k >= kb(i)) then maxF(i,k) = MIN(maxF(i,k),dsp1_ds(i,k+1)*maxF(i,k+1) + htot(i)) htot(i) = htot(i) + (h(i,j,k) - Angstrom) - if ( (k == kb(i)) .and. ((maxF(i,k) < F_kb(i)) .or. & - (maxF(i,k) < maxF_kb(i)) .and. (eakb_maxF(i) <= max_eakb(i))) ) then + endif + if (k == kb(i)) then + if ((maxF(i,k) < F_kb(i)) .or. (maxF(i,k) < maxF_kb(i)) & + .and. (eakb_maxF(i) <= max_eakb(i))) then ! In this case, too much was being entrained by the topmost interior ! layer, even with the minimum initial estimate. The buffer layer ! will always entrain the maximum amount. @@ -691,7 +701,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & .true., dS_kb, dS_anom_lim=dS_anom_lim) do k=nz-1,kb_min,-1 call calculate_density(tv%T(is:ie,j,k), tv%S(is:ie,j,k), pres(is:ie), & - Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state) + Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie if ((k>kb(i)) .and. (F(i,k) > 0.0)) then ! Within a time step, a layer may entrain no more than its @@ -776,7 +786,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & else ! not bulkmixedlayer do k=K2,nz-1 call calculate_density(tv%T(is:ie,j,k), tv%S(is:ie,j,k), pres(is:ie), & - Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state) + Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie ; if (F(i,k) > 0.0) then ! Within a time step, a layer may entrain no more than ! its thickness for correction. This limitation should @@ -842,7 +852,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & endif enddo call calculate_density_derivs(T_eos, S_eos, pressure, & - dRho_dT, dRho_dS, is, ie-is+1, tv%eqn_of_state) + dRho_dT, dRho_dS, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie if ((k>kmb) .and. (k m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density minus - !! 1000 for each layer [kg m-3]. + !! 1000 for each layer [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. ! This subroutine sets the average entrainment across each of the interfaces @@ -1053,13 +1064,13 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref real, dimension(SZI_(G)) :: & b1, d1, & ! Variables used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1] and [nondim]. Rcv, & ! Value of the coordinate variable (potential density) - ! based on the simulated T and S and P_Ref [kg m-3]. + ! based on the simulated T and S and P_Ref [R ~> kg m-3]. pres, & ! Reference pressure (P_Ref) [Pa]. frac_rem, & ! The fraction of the diffusion remaining [nondim]. h_interior ! The interior thickness available for entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G), SZK_(G)) :: & S_est ! An estimate of the coordinate potential density - 1000 after - ! entrainment for each layer [kg m-3]. + ! entrainment for each layer [R ~> kg m-3]. real :: max_ent ! The maximum possible entrainment [H ~> m or kg m-2]. real :: dh ! An available thickness [H ~> m or kg m-2]. real :: Kd_x_dt ! The diffusion that remains after thin layers are @@ -1076,10 +1087,10 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do i=is,ie ; pres(i) = tv%P_Ref ; enddo do k=1,kmb call calculate_density(tv%T(is:ie,j,k), tv%S(is:ie,j,k), pres(is:ie), & - Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state) + Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie h_bl(i,k) = h(i,j,k) + h_neglect - Sref(i,k) = Rcv(i) - 1000.0 + Sref(i,k) = Rcv(i) - CS%Rho_sig_off enddo enddo @@ -1121,7 +1132,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do i=is,ie ; kb(i) = nz+1 ; if (do_i(i)) kb(i) = kmb+1 ; enddo do k=kmb+1,nz ; do i=is,ie ; if (do_i(i)) then - if ((k == kb(i)) .and. (S_est(i,kmb) > (GV%Rlay(k) - 1000.0))) then + if ((k == kb(i)) .and. (S_est(i,kmb) > (GV%Rlay(k) - CS%Rho_sig_off))) then if (4.0*dtKd_int(i,Kmb+1)*frac_rem(i) > & (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom_H)) then ! Entrain this layer into the buffer layer and move kb down. @@ -1129,7 +1140,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref if (dh > 0.0) then frac_rem(i) = frac_rem(i) - ((h_bl(i,kmb) + h(i,j,k)) * dh) / & (4.0*dtKd_int(i,Kmb+1)) - Sref(i,kmb) = (h_bl(i,kmb)*Sref(i,kmb) + dh*(GV%Rlay(k)-1000.0)) / & + Sref(i,kmb) = (h_bl(i,kmb)*Sref(i,kmb) + dh*(GV%Rlay(k)-CS%Rho_sig_off)) / & (h_bl(i,kmb) + dh) h_bl(i,kmb) = h_bl(i,kmb) + dh S_est(i,kmb) = (h_bl(i,kmb)*Sref(i,kmb) + Ent_bl(i,Kmb)*S_est(i,kmb-1)) / & @@ -1145,14 +1156,14 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do k=nz,kmb+1,-1 ; do i=is,ie if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom_H) if (k==kb(i)) then - h_bl(i,kmb+1) = h(i,j,k) ; Sref(i,kmb+1) = GV%Rlay(k) - 1000.0 + h_bl(i,kmb+1) = h(i,j,k) ; Sref(i,kmb+1) = GV%Rlay(k) - CS%Rho_sig_off elseif (k==kb(i)+1) then - h_bl(i,kmb+2) = h(i,j,k) ; Sref(i,kmb+2) = GV%Rlay(k) - 1000.0 + h_bl(i,kmb+2) = h(i,j,k) ; Sref(i,kmb+2) = GV%Rlay(k) - CS%Rho_sig_off endif enddo ; enddo do i=is,ie ; if (kb(i) >= nz) then h_bl(i,kmb+1) = h(i,j,nz) - Sref(i,kmb+1) = GV%Rlay(nz) - 1000.0 + Sref(i,kmb+1) = GV%Rlay(nz) - CS%Rho_sig_off h_bl(i,kmb+2) = GV%Angstrom_H Sref(i,kmb+2) = Sref(i,kmb+1) + (GV%Rlay(nz) - GV%Rlay(nz-1)) endif ; enddo @@ -1194,7 +1205,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< Reference potential density [kg m-3] + real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< Reference potential density [R ~> kg m-3] real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface !! around the buffer layers [H ~> m or kg m-2]. @@ -1208,18 +1219,18 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & real, dimension(SZI_(G)), intent(inout) :: dSkb !< The limited potential density !! difference across the interface !! between the bottommost buffer layer - !! and the topmost interior layer. + !! and the topmost interior layer. [R ~> kg m-3] !! dSkb > 0. real, dimension(SZI_(G)), optional, intent(inout) :: ddSkb_dE !< The partial derivative of dSkb - !! with E [kg m-3 H-1 ~> kg m-4 or m-1]. + !! with E [R H-1 ~> kg m-4 or m-1]. real, dimension(SZI_(G)), optional, intent(inout) :: dSlay !< The limited potential density !! difference across the topmost - !! interior layer. 0 < dSkb + !! interior layer. 0 < dSkb [R ~> kg m-3] real, dimension(SZI_(G)), optional, intent(inout) :: ddSlay_dE !< The partial derivative of dSlay - !! with E [kg m-3 H-1 ~> kg m-4 or m-1]. + !! with E [R H-1 ~> kg m-4 or m-1]. real, dimension(SZI_(G)), optional, intent(inout) :: dS_anom_lim !< A limiting value to use for !! the density anomalies below the - !! buffer layer [kg m-3]. + !! buffer layer [R ~> kg m-3]. logical, dimension(SZI_(G)), optional, intent(in) :: do_i_in !< If present, determines which !! columns are worked on. @@ -1242,9 +1253,9 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & b1, c1, & ! b1 and c1 are variables used by the tridiagonal solver. - S, dS_dE, & ! The coordinate density and its derivative with R. - ea, dea_dE, & ! The entrainment from above and its derivative with R. - eb, deb_dE ! The entrainment from below and its derivative with R. + S, dS_dE, & ! The coordinate density [R ~> kg m-3] and its derivative with E. + ea, dea_dE, & ! The entrainment from above and its derivative with E. + eb, deb_dE ! The entrainment from below and its derivative with E. real :: deriv_dSkb(SZI_(G)) real :: d1(SZI_(G)) ! d1 = 1.0-c1 is also used by the tridiagonal solver. real :: src ! A source term for dS_dR. @@ -1438,14 +1449,14 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Sref !< The coordinate reference potential density, !! with the value of the topmost interior layer - !! at index kmb+1 [kg m-3]. + !! at index kmb+1 [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and downward !! across each interface around the buffer layers, !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in reference !! potential density across the base of the - !! uppermost interior layer [m3 kg-1]. + !! uppermost interior layer [R-1 ~> m3 kg-1]. real, dimension(SZI_(G)), intent(in) :: F_kb !< The entrainment from below by the !! uppermost interior layer [H ~> m or kg m-2] integer, intent(in) :: kmb !< The number of mixed and buffer layers. @@ -1570,14 +1581,14 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< The coordinate reference potential !! density, with the value of the !! topmost interior layer at layer - !! kmb+1 [kg m-3]. + !! kmb+1 [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across !! the base of the uppermost interior - !! layer [m3 kg-1]. + !! layer [R-1 ~> m3 kg-1]. real, dimension(SZI_(G)), intent(in) :: dtKd_kb !< The diapycnal diffusivity in the top !! interior layer times the time step !! [H2 ~> m2 or kg2 m-4]. @@ -1620,12 +1631,12 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)) :: & dS_kb, & ! The coordinate-density difference between the ! layer kb and deepest buffer layer, limited to - ! ensure that it is positive [kg m-3]. + ! ensure that it is positive [R ~> kg m-3]. dS_Lay, & ! The coordinate-density difference across layer ! kb, limited to ensure that it is positive and not - ! too much bigger than dS_kb or dS_kbp1 [kg m-3]. + ! too much bigger than dS_kb or dS_kbp1 [R ~> kg m-3]. ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E - ! [kg m-3 H-1 ~> kg m-4 or m-1]. + ! [R H-1 ~> kg m-4 or m-1]. derror_dE, & ! The derivative of err with E [H ~> m or kg m-2]. err, & ! The "error" whose zero is being sought [H2 ~> m2 or kg2 m-4]. E_min, E_max, & ! The minimum and maximum values of E [H ~> m or kg m-2]. @@ -1633,7 +1644,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real :: err_est ! An estimate of what err will be [H2 ~> m2 or kg2 m-4]. real :: eL ! 1 or 0, depending on whether increases in E lead ! to decreases in the entrainment from below by the - ! deepest buffer layer. + ! deepest buffer layer [nondim]. real :: fa ! Temporary variable used to calculate err [nondim]. real :: fk ! Temporary variable used to calculate err [H2 ~> m2 or kg2 m-4]. real :: fm, fr ! Temporary variables used to calculate err [H ~> m or kg m-2]. @@ -1780,7 +1791,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: Sref !< Reference potential density [kg m-3]. + intent(in) :: Sref !< Reference potential density [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around @@ -1788,7 +1799,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across the !! base of the uppermost interior layer - !! [m3 kg-1]. + !! [R-1 ~> m3 kg-1]. real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, @@ -1848,7 +1859,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & ! The most likely value is at max_ent. call determine_dSkb(h_bl, Sref, Ent_bl, max_ent_in, is, ie, kmb, G, GV, .false., & - dS_kb, ddSkb_dE , dS_anom_lim=dS_anom_lim) + dS_kb, ddSkb_dE, dS_anom_lim=dS_anom_lim) ie1 = is-1 ; doany = .false. do i=is,ie dS_kb_lim(i) = dS_kb(i) + dS_anom_lim(i) @@ -2125,11 +2136,13 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) "The tolerance with which to solve for entrainment values.", & units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) + CS%Rho_sig_off = 1000.0*US%kg_m3_to_R + CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & 'Work actually done by diapycnal diffusion across each interface', 'W m-2', & - conversion=US%Z_to_m**3*US%s_to_T**3) + conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) end subroutine entrain_diffusive_init diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index db14ef930a..dba311441e 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -5,14 +5,15 @@ module MOM_geothermal use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl -use MOM_domains, only : pass_var +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_io, only : MOM_read_data, slasher -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_io, only : MOM_read_data, slasher +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units +use MOM_EOS, only : calculate_density, calculate_density_derivs implicit none ; private @@ -24,8 +25,8 @@ module MOM_geothermal type, public :: geothermal_CS ; private real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is !! negative) the water is heated in place instead - !! of moving upward between layers [kg m-3 degC-1]. - real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux [W m-2]. + !! of moving upward between layers [R degC-1 ~> kg m-3 degC-1]. + real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux [J m-2 T-1 ~> W m-2]. real :: geothermal_thick !< The thickness over which geothermal heating is !! applied [m] (not [H]). logical :: apply_geothermal !< If true, geothermal heating will be applied @@ -49,7 +50,7 @@ module MOM_geothermal !! the partial derivative of the coordinate density with temperature is positive !! or very small, the layers are simply heated in place. Any heat that can not !! be applied to the ocean is returned (WHERE)? -subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) +subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] @@ -57,7 +58,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !! to any available thermodynamic !! fields. Absent fields have NULL !! ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The amount of fluid moved !! downward into a layer; this !! should be increased due to mixed @@ -66,6 +67,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !! into a layer; this should be !! increased due to mixed layer !! entrainment [H ~> m or kg m-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. @@ -74,20 +76,20 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat [H degC ~> m degC or kg degC m-2] h_geo_rem, & ! remaining thickness to apply geothermal heating [H ~> m or kg m-2] - Rcv_BL, & ! coordinate density in the deepest variable density layer [kg m-3] + Rcv_BL, & ! coordinate density in the deepest variable density layer [R ~> kg m-3] p_ref ! coordiante densities reference pressure [Pa] real, dimension(2) :: & T2, S2, & ! temp and saln in the present and target layers [degC] and [ppt] - dRcv_dT_, & ! partial derivative of coordinate density wrt temp [kg m-3 degC-1] - dRcv_dS_ ! partial derivative of coordinate density wrt saln [kg m-3 ppt-1] + dRcv_dT_, & ! partial derivative of coordinate density wrt temp [R degC-1 ~> kg m-3 degC-1] + dRcv_dS_ ! partial derivative of coordinate density wrt saln [R ppt-1 ~> kg m-3 ppt-1] real :: Angstrom, H_neglect ! small thicknesses [H ~> m or kg m-2] - real :: Rcv ! coordinate density of present layer [kg m-3] - real :: Rcv_tgt ! coordinate density of target layer [kg m-3] - real :: dRcv ! difference between Rcv and Rcv_tgt [kg m-3] + real :: Rcv ! coordinate density of present layer [R ~> kg m-3] + real :: Rcv_tgt ! coordinate density of target layer [R ~> kg m-3] + real :: dRcv ! difference between Rcv and Rcv_tgt [R ~> kg m-3] real :: dRcv_dT ! partial derivative of coordinate density wrt temp - ! in the present layer [kg m-3 degC-1]; usually negative + ! in the present layer [R degC-1 ~> kg m-3 degC-1]; usually negative real :: h_heated ! thickness that is being heated [H ~> m or kg m-2] real :: heat_avail ! heating available for the present layer [degC H ~> degC m or degC kg m-2] real :: heat_in_place ! heating to warm present layer w/o movement between layers @@ -155,7 +157,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) if (compute_h_old) h_old(:,:,:) = 0.0 if (compute_T_old) T_old(:,:,:) = 0.0 -!$OMP parallel do default(none) shared(is,ie,js,je,G,GV,CS,dt,Irho_cp,nkmb,tv, & +!$OMP parallel do default(none) shared(is,ie,js,je,G,GV,US,CS,dt,Irho_cp,nkmb,tv, & !$OMP p_Ref,h,Angstrom,nz,H_neglect,eb, & !$OMP compute_h_old,compute_T_old,h_old,T_old, & !$OMP work_3d,Idt) & @@ -197,7 +199,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) if (nkmb > 0) then call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_Ref(:), & - Rcv_BL(:), isj, iej-isj+1, tv%eqn_of_state) + Rcv_BL(:), isj, iej-isj+1, tv%eqn_of_state, scale=US%kg_m3_to_R) else Rcv_BL(:) = -1.0 endif @@ -243,11 +245,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Rcv = 0.0 ; dRcv_dT = 0.0 ! Is this OK? else call calculate_density(tv%T(i,j,k), tv%S(i,j,k), tv%P_Ref, & - Rcv, tv%eqn_of_state) + Rcv, tv%eqn_of_state, scale=US%kg_m3_to_R) T2(1) = tv%T(i,j,k) ; S2(1) = tv%S(i,j,k) T2(2) = tv%T(i,j,k_tgt) ; S2(2) = tv%S(i,j,k_tgt) call calculate_density_derivs(T2(:), S2(:), p_Ref(:), & - dRcv_dT_, dRcv_dS_, 1, 2, tv%eqn_of_state) + dRcv_dT_, dRcv_dS_, 1, 2, tv%eqn_of_state, scale=US%kg_m3_to_R) dRcv_dT = 0.5*(dRcv_dT_(1) + dRcv_dT_(2)) endif @@ -373,10 +375,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) end subroutine geothermal !> Initialize parameters and allocate memory associated with the geothermal heating module. -subroutine geothermal_init(Time, G, GV, param_file, diag, CS) +subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. @@ -388,7 +391,8 @@ subroutine geothermal_init(Time, G, GV, param_file, diag, CS) character(len=48) :: thickness_units ! Local variables character(len=200) :: inputdir, geo_file, filename, geotherm_var - real :: scale + real :: scale ! A constant heat flux or dimensionally rescaled scaling factor + ! [J m-2 T-1 ~> W m-2] or [s T-1 ~> 1] integer :: i, j, isd, ied, jsd, jed, id isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -407,7 +411,7 @@ subroutine geothermal_init(Time, G, GV, param_file, diag, CS) "The constant geothermal heat flux, a rescaling "//& "factor for the heat flux read from GEOTHERMAL_FILE, or "//& "0 to disable the geothermal heating.", & - units="W m-2 or various", default=0.0) + units="W m-2 or various", default=0.0, scale=US%T_to_s) CS%apply_geothermal = .not.(scale == 0.0) if (.not.CS%apply_geothermal) return @@ -423,7 +427,7 @@ subroutine geothermal_init(Time, G, GV, param_file, diag, CS) "The value of drho_dT above which geothermal heating "//& "simply heats water in place instead of moving it between "//& "isopycnal layers. This must be negative.", & - units="kg m-3 K-1", default=-0.01) + units="kg m-3 K-1", scale=US%kg_m3_to_R, default=-0.01) if (CS%dRcv_dT_inplace >= 0.0) call MOM_error(FATAL, "geothermal_init: "//& "GEOTHERMAL_DRHO_DT_INPLACE must be negative.") @@ -450,7 +454,7 @@ subroutine geothermal_init(Time, G, GV, param_file, diag, CS) ! post the static geothermal heating field id = register_static_field('ocean_model', 'geo_heat', diag%axesT1, & - 'Geothermal heat flux into ocean', 'W m-2', & + 'Geothermal heat flux into ocean', 'W m-2', conversion=US%s_to_T, & cmor_field_name='hfgeou', cmor_units='W m-2', & cmor_standard_name='upward_geothermal_heat_flux_at_sea_floor', & cmor_long_name='Upward geothermal heat flux at sea floor', & @@ -461,15 +465,15 @@ subroutine geothermal_init(Time, G, GV, param_file, diag, CS) CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & 'internal_heat_heat_tendency', diag%axesTL, Time, & 'Heat tendency (in 3D) due to internal (geothermal) sources', & - 'W m-2', v_extensive=.true.) + 'W m-2', conversion=US%s_to_T, v_extensive=.true.) CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & - 'degC s-1', v_extensive=.true.) + 'degC s-1', conversion=US%s_to_T, v_extensive=.true.) CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & - trim(thickness_units), conversion=GV%H_to_MKS, v_extensive=.true.) + trim(thickness_units), conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) end subroutine geothermal_init diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 79c1b744f0..01f583292f 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -37,12 +37,12 @@ module MOM_int_tide_input type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. real :: TKE_itide_max !< Maximum Internal tide conversion - !! available to mix above the BBL [W m-2] + !! available to mix above the BBL [R Z3 T-3 ~> W m-2] real :: kappa_fill !< Vertical diffusivity used to interpolate sensible values !! of T & S into thin layers [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:) :: TKE_itidal_coef - !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. + !< The time-invariant field that enters the TKE_itidal input calculation [R Z3 T-2 ~> J m-2]. character(len=200) :: inputdir !< The directory for input files. logical :: int_tide_source_test !< If true, apply an arbitrary generation site @@ -62,10 +62,10 @@ module MOM_int_tide_input !> This type is used to exchange fields related to the internal tides. type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & - TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean [W m-2]. + TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean [R Z3 T-3 ~> W m-2]. h2, & !< The squared topographic roughness height [Z2 ~> m2]. - tideamp, & !< The amplitude of the tidal velocities [m s-1]. - Nb !< The bottom stratification [s-1]. + tideamp, & !< The amplitude of the tidal velocities [Z T-1 ~> m s-1]. + Nb !< The bottom stratification [T-1 ~> s-1]. end type int_tide_input_type contains @@ -83,7 +83,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_type), intent(inout) :: itide !< A structure containing fields related !! to the internal tide sources. - real, intent(in) :: dt !< The time increment [s]. + real, intent(in) :: dt !< The time increment [T ~> s]. type(int_tide_input_CS), pointer :: CS !< This module's control structure. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -97,10 +97,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) logical :: avg_enabled ! for testing internal tides (BDM) type(time_type) :: time_end !< For use in testing internal tides (BDM) - - integer :: i, j, k, is, ie, js, je, nz - integer :: isd, ied, jsd, jed - + integer :: i, j, k, is, ie, js, je, nz, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -112,14 +109,14 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt*US%s_to_T, T_f, S_f, G, GV, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt, T_f, S_f, G, GV, larger_h_denom=.true.) endif call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - itide%Nb(i,j) = G%mask2dT(i,j) * US%s_to_T*sqrt(N2_bot(i,j)) + itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) enddo ; enddo @@ -131,7 +128,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) ! Input an arbitrary energy point source.id_ if (((G%geoLonCu(I-1,j)-CS%int_tide_source_x) * (G%geoLonBu(I,j)-CS%int_tide_source_x) <= 0.0) .and. & ((G%geoLatCv(i,J-1)-CS%int_tide_source_y) * (G%geoLatCv(i,j)-CS%int_tide_source_y) <= 0.0)) then - itide%TKE_itidal_input(i,j) = 1.0 + itide%TKE_itidal_input(i,j) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3 endif enddo ; enddo endif @@ -139,7 +136,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (CS%debug) then call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0, scale=US%s_to_T**2) - call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0) + call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0, & + scale=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) endif if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, itide%TKE_itidal_input, CS%diag) @@ -164,26 +162,27 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the - !! ocean bottom [s-2]. + !! ocean bottom [T-2 ~> s-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & - dRho_int ! The unfiltered density differences across interfaces. + dRho_int ! The unfiltered density differences across interfaces [R ~> kg m-3]. real, dimension(SZI_(G)) :: & pres, & ! The pressure at each interface [Pa]. Temp_int, & ! The temperature at each interface [degC]. Salin_int, & ! The salinity at each interface [ppt]. - drho_bot, & + drho_bot, & ! The density difference at the bottom of a layer [R ~> kg m-3] h_amp, & ! The amplitude of topographic roughness [Z ~> m]. hb, & ! The depth below a layer [Z ~> m]. z_from_bot, & ! The height of a layer center above the bottom [Z ~> m]. - dRho_dT, & ! The partial derivatives of density with temperature and - dRho_dS ! salinity [kg m-3 degC-1] and [kg m-3 ppt-1]. + dRho_dT, & ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + dRho_dS ! The partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. + ! density [Z T-2 R-1 ~> m4 s-2 kg-1]. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0 @@ -191,7 +190,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) do i=is,ie dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,h,T_f,S_f, & +!$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,US,h,T_f,S_f, & !$OMP h2,N2_bot,G_Rho0) & !$OMP private(pres,Temp_Int,Salin_Int,dRho_dT,dRho_dS, & !$OMP hb,dRho_bot,z_from_bot,do_i,h_amp, & @@ -211,7 +210,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) enddo call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) + dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie dRho_int(i,K) = max(dRho_dT(i)*(T_f(i,j,k) - T_f(i,j,k-1)) + & dRho_dS(i)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) @@ -219,7 +218,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) enddo else do K=2,nz ; do i=is,ie - dRho_int(i,K) = GV%Rlay(k) - GV%Rlay(k-1) + dRho_int(i,K) = (GV%Rlay(k) - GV%Rlay(k-1)) enddo ; enddo endif @@ -277,19 +276,19 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! Local variables type(vardesc) :: vd logical :: read_tideamp -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_int_tide_input" ! This module's name. character(len=20) :: tmpstr character(len=200) :: filename, tideamp_file, h2_file - real :: mask_itidal + real :: mask_itidal ! A multiplicative land mask, 0 or 1 [nondim] real :: max_frac_rough ! The fraction relating the maximum topographic roughness ! to the mean depth [nondim] - real :: utide ! constant tidal amplitude [m s-1] to be used if + real :: utide ! constant tidal amplitude [L T-1 ~> m s-1] to be used if ! tidal amplitude file is not present. - real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. - real :: kappa_itides ! topographic wavenumber and non-dimensional scaling + real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height [nondim]. + real :: kappa_itides ! topographic wavenumber and non-dimensional scaling [L-1 ~> m-1] real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion [Z ~> m]. integer :: tlen_days !< Time interval from start for adding wave source !! for testing internal tides (BDM) @@ -331,7 +330,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) allocate(itide%Nb(isd:ied,jsd:jed)) ; itide%Nb(:,:) = 0.0 allocate(itide%h2(isd:ied,jsd:jed)) ; itide%h2(:,:) = 0.0 @@ -342,7 +341,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=US%L_to_m) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& @@ -350,7 +349,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source available to mix "//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & - units="W m-2", default=1.0e3) + units="W m-2", default=1.0e3, scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing "//& @@ -361,7 +360,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', itide%tideamp, G%domain, timelevel=1) + call MOM_read_data(filename, 'tideamp', itide%tideamp, G%domain, timelevel=1, scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -402,17 +401,18 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) if (max_frac_rough >= 0.0) & itide%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, itide%h2(i,j)) - ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. - CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * US%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2 + ! Compute the fixed part of internal tidal forcing; units are [R Z3 T-2 ~> J m-2] here. + CS%TKE_itidal_coef(i,j) = 0.5*US%L_to_Z*kappa_h2_factor*GV%Rho0*& + kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2 enddo ; enddo CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal_itide',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + 'Internal Tide Driven Turbulent Kinetic Energy', & + 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) CS%id_Nb = register_diag_field('ocean_model','Nb_itide',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') + 'Bottom Buoyancy Frequency', 's-1', conversion=US%s_to_T) CS%id_N2_bot = register_diag_field('ocean_model','N2_b_itide',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index f5343f86e2..d315a18b16 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -73,7 +73,7 @@ module MOM_kappa_shear !! massive layers in this calculation. ! I can think of no good reason why this should be false. - RWH real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [Z T-1 ~> m s-1]. + !! are set to 0 [L T-1 ~> m s-1]. ! logical :: layer_stagger = .false. ! If true, do the calculations centered at ! layers, rather than the interfaces. logical :: debug = .false. !< If true, write verbose debugging messages. @@ -130,7 +130,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZI_(G),SZK_(GV)) :: & h_2d, & ! A 2-D version of h, but converted to [Z ~> m]. u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1]. - T_2d, S_2d, rho_2d ! 2-D versions of T, S, and rho. + T_2d, S_2d, rho_2d ! 2-D versions of T [degC], S [ppt], and rho [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)+1) :: & kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1]. tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. @@ -396,7 +396,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZK_(GV)) :: & h_2d, & ! A 2-D version of h, but converted to [Z ~> m]. u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1]. - T_2d, S_2d, rho_2d ! 2-D versions of T, S, and rho. + T_2d, S_2d, rho_2d ! 2-D versions of T [degC], S [ppt], and rho [R ~> kg m-3]. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & @@ -734,7 +734,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & local_src_avg, & ! The time-integral of the local source [nondim]. tol_min, & ! Minimum tolerated ksrc for the corrector step [T-1 ~> s-1]. tol_max, & ! Maximum tolerated ksrc for the corrector step [T-1 ~> s-1]. - tol_chg, & ! The tolerated change integrated in time [s T-nondim]. + tol_chg, & ! The tolerated change integrated in time [nondim]. dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term [T-1 ~> s-1]. @@ -744,8 +744,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. real :: gR0 ! A conversion factor from Z to Pa equal to Rho_0 times g - ! [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. - real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z m3 kg-1 T-2 ~> m4 kg-1 s-2]. + ! [Pa Z-1 = kg m-1 s-2 Z-1 ~> kg m-2 s-2]. + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z R-1 T-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc @@ -761,8 +761,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: dt_inc ! An increment to dt_test that is being tested [T ~> s]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. - logical :: valid_dt ! If true, all levels so far exhibit acceptably small - ! changes in k_src. + logical :: valid_dt ! If true, all levels so far exhibit acceptably small changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. integer :: ks_kappa, ke_kappa ! The k-range with nonzero kappas. @@ -793,7 +792,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_crit = CS%Rino_crit gR0 = GV%z_to_H*GV%H_to_Pa - g_R0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 + g_R0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -884,11 +883,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, & - dbuoy_dS, 2, nzc-1, tv%eqn_of_state) - do K=2,nzc - dbuoy_dT(K) = -g_R0*dbuoy_dT(K) - dbuoy_dS(K) = -g_R0*dbuoy_dS(K) - enddo + dbuoy_dS, 2, nzc-1, tv%eqn_of_state, scale=-g_R0*US%kg_m3_to_R) else do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif @@ -1215,8 +1210,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, !! [Z2 T-1 ~> m2 s-1]. - real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [m s-1]. - real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [m s-1]. + real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [L T-1 ~> m s-1]. + real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [L T-1 ~> m s-1]. real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. real, dimension(nz), intent(in) :: S0 !< The initial salinity [ppt]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. @@ -1227,8 +1222,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. real, intent(in) :: dt !< The time step [T ~> s]. - real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. - real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. + real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [L T-1 ~> m s-1]. + real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [L T-1 ~> m s-1]. real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [ppt]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1242,13 +1237,13 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! diffusivity. real, optional, intent(in) :: vel_underflow !< If present and true, any velocities that !! are smaller in magnitude than this value are - !! set to 0 [m s-1]. + !! set to 0 [L T-1 ~> m s-1]. ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth ! units squared [Z2 s2 T-2 m-2 ~> 1]. - real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [m s-1]. + real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [L T-1 ~> m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1357,7 +1352,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to - !! boundaries [Z-2 !> m-2]. + !! boundaries [Z-2 ~> m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. real, intent(in) :: f2 !< The squared Coriolis parameter [T-2 ~> s-2]. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. @@ -1371,7 +1366,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), optional, & - intent(out) :: kappa_src !< The source term for kappa [T-1]. + intent(out) :: kappa_src !< The source term for kappa [T-1 ~> s-1]. real, dimension(nz+1), optional, & intent(out) :: local_src !< The sum of all local sources for kappa, !! [T-1 ~> s-1]. @@ -1427,7 +1422,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Temporary variables used in the Newton's method iterations. real :: decay_term_k ! The decay term in the diffusivity equation real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1] - real :: I_Q ! The inverse of TKE [s2 m-2] + real :: I_Q ! The inverse of TKE [T2 Z-2 ~> s2 m-2] real :: kap_src real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] real :: v2 diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 5e42de0fea..18b01223ff 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -556,9 +556,9 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [m3 kg-1 degC-1]. + !! volume with temperature [R-1 degC-1]. real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. + !! throughout a layer [R Z3 T-2 ~> J m-2]. ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & @@ -599,7 +599,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real :: epsilon ! A small thickness that must remain in each ! layer, and which will not be subject to heating [H ~> m or kg m-2] real :: g_Hconv2 ! A conversion factor for use in the TKE calculation - ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. + ! in units of [Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. logical :: SW_Remains ! If true, some column has shortwave radiation that ! was not entirely absorbed. logical :: TKE_calc ! If true, calculate the implications to the @@ -618,9 +618,9 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l TKE_calc = (present(TKE) .and. present(dSV_dT)) if (optics%answers_2018) then - g_Hconv2 = (US%m_to_Z**2 * US%L_to_Z**2*GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + g_Hconv2 = (US%L_to_Z**2*GV%g_Earth * GV%H_to_RZ) * GV%H_to_RZ else - g_Hconv2 = US%m_to_Z**2 * US%L_to_Z**2*GV%g_Earth * GV%H_to_kg_m2**2 + g_Hconv2 = US%L_to_Z**2*GV%g_Earth * GV%H_to_RZ**2 endif h_heat(:) = 0.0 @@ -841,7 +841,12 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) do i=is,ie ; h_heat(i) = 0.0 ; enddo - netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface + do i=is,ie + netPen(i,1) = 0. + do n=1,max(nsw,1) + netPen(i,1) = netPen(i,1) + pen_SW_bnd(n,i) ! Surface interface + enddo + enddo ! Apply penetrating SW radiation to remaining parts of layers. ! Excessively thin layers are not heated to avoid runaway temps. diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index cca2d9f94e..57f7bd2444 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -10,6 +10,7 @@ module MOM_regularize_layers use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -74,7 +75,7 @@ module MOM_regularize_layers !> This subroutine partially steps the bulk mixed layer model. !! The following processes are executed, in the order listed. -subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) +subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -82,7 +83,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed @@ -91,6 +92,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. ! Local variables @@ -105,14 +107,14 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) call pass_var(h, G%Domain, clock=id_clock_pass) if (CS%regularize_surface_layers) then - call regularize_surface(h, tv, dt, ea, eb, G, GV, CS) + call regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) endif end subroutine regularize_layers !> This subroutine ensures that there is a degree of horizontal smoothness !! in the depths of the near-surface interfaces. -subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) +subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -120,7 +122,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed @@ -129,6 +131,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. ! Local variables @@ -158,7 +161,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) h_2d, & ! A 2-d version of h [H ~> m or kg m-2]. T_2d, & ! A 2-d version of tv%T [degC]. S_2d, & ! A 2-d version of tv%S [ppt]. - Rcv, & ! A 2-d version of the coordinate density [kg m-3]. + Rcv, & ! A 2-d version of the coordinate density [R ~> kg m-3]. h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. T_2d_init, & ! THe initial value of T_2d [degC]. S_2d_init, & ! The initial value of S_2d [ppt]. @@ -193,7 +196,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real :: h_det_tot real :: max_def_rat real :: Rcv_min_det ! The lightest (min) and densest (max) coordinate density - real :: Rcv_max_det ! that can detrain into a layer [kg m-3]. + real :: Rcv_max_det ! that can detrain into a layer [R ~> kg m-3]. real :: int_top, int_bot real :: h_predicted @@ -297,7 +300,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) ! Now restructure the layers. -!$OMP parallel do default(none) shared(is,ie,js,je,nz,do_j,def_rat_h,CS,nkmb,G,GV,& +!$OMP parallel do default(none) shared(is,ie,js,je,nz,do_j,def_rat_h,CS,nkmb,G,GV,US, & !$OMP e,I_dtol,h,tv,debug,h_neglect,p_ref_cv,ea, & !$OMP eb,id_clock_EOS,nkml) & !$OMP private(d_ea,d_eb,max_def_rat,do_i,nz_filt,e_e,e_w,& @@ -441,7 +444,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) call cpu_clock_begin(id_clock_EOS) do k=1,nkmb call calculate_density(T_2d(:,k),S_2d(:,k),p_ref_cv,Rcv(:,k), & - is,ie-is+1,tv%eqn_of_state) + is,ie-is+1,tv%eqn_of_state, scale=US%kg_m3_to_R) enddo call cpu_clock_end(id_clock_EOS) @@ -452,11 +455,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) if (k1 <= 1) exit if (k2 <= nkmb) exit ! ### The 0.6 here should be adjustable? It gives 20% overlap for now. - Rcv_min_det = GV%Rlay(k2) + 0.6*Rcv_tol(i)*(GV%Rlay(k2-1)-GV%Rlay(k2)) + Rcv_min_det = (GV%Rlay(k2) + 0.6*Rcv_tol(i)*(GV%Rlay(k2-1)-GV%Rlay(k2))) if (k2 < nz) then - Rcv_max_det = GV%Rlay(k2) + 0.6*Rcv_tol(i)*(GV%Rlay(k2+1)-GV%Rlay(k2)) + Rcv_max_det = (GV%Rlay(k2) + 0.6*Rcv_tol(i)*(GV%Rlay(k2+1)-GV%Rlay(k2))) else - Rcv_max_det = GV%Rlay(nz) + 0.6*Rcv_tol(i)*(GV%Rlay(nz)-GV%Rlay(nz-1)) + Rcv_max_det = (GV%Rlay(nz) + 0.6*Rcv_tol(i)*(GV%Rlay(nz)-GV%Rlay(nz-1))) endif if (Rcv(i,k1) > Rcv_max_det) & exit ! All shallower interior layers are too light for detrainment. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7d118bc00a..b4c100dc5d 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -58,8 +58,8 @@ module MOM_set_diffusivity logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! GV%nk_rho_varies variable density mixed & buffer layers. real :: FluxRi_max !< The flux Richardson number where the stratification is - !! large enough that N2 > omega2. The full expression for - !! the Flux Richardson number is usually + !! large enough that N2 > omega2 [nondim]. The full expression + !! for the Flux Richardson number is usually !! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. @@ -87,14 +87,12 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation [kg Z2 m-3 T-3 ~> W m-3] - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [kg Z2 m-3 T-3 ~> W m-3] - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [kg Z2 m-3 T-2 ~> J m-3] - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [kg Z2 m-3 T-1 ~> J s m-3] + real :: dissip_min !< Minimum dissipation [R Z2 T-3 ~> W m-3] + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [R Z2 T-3 ~> W m-3] + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [R Z2 T-2 ~> J m-3] + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [R Z2 T-1 ~> J s m-3] real :: dissip_Kd_min !< Minimum Kd [Z2 T-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 - real :: TKE_itide_max !< maximum internal tide conversion [W m-2] - !! available to mix above the BBL real :: omega !< Earth's rotation frequency [T-1 ~> s-1] logical :: ML_radiation !< allow a fraction of TKE available from wind work !! to penetrate below mixed layer base with a vertical @@ -107,7 +105,7 @@ module MOM_set_diffusivity !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is !! calculated the same way as in the mixed layer code. !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), - !! where N2 is the squared buoyancy frequency [s-2] and OMEGA2 + !! where N2 is the squared buoyancy frequency [T-2 ~> s-2] and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence !! radiated from the base of the mixed layer [Z2 T-1 ~> m2 s-1]. @@ -175,7 +173,7 @@ module MOM_set_diffusivity N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [T-2 ~> s-2] Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 T-1 ~> m2 s-1] Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [kg Z3 m-3 T-3 ~> W m-2] + Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [R Z3 T-3 ~> W m-2] maxTKE => NULL(), & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 T-1 ~> m2 s-1]. KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 T-1 ~> m2 s-1]. @@ -202,7 +200,7 @@ module MOM_set_diffusivity !! viscosity associated with processes 1,2 and 4 listed above, which is stored in !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear -subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, & +subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & G, GV, US, CS, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -224,7 +222,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, !! properties of the ocean. type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt_in_T !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. @@ -246,19 +244,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, real, dimension(SZI_(G),SZK_(G)) :: & N2_lay, & !< squared buoyancy frequency associated with layers [T-2 ~> s-2] - maxTKE, & !< energy required to entrain to h_max [m3 T-3] + maxTKE, & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between !< TKE dissipated within a layer and Kd in that layer !< [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] - dRho_int, & !< locally ref potential density difference across interfaces [kg m-3] + dRho_int, & !< locally ref potential density difference across interfaces [R ~> kg m-3] KT_extra, & !< double difusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] KS_extra !< double difusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] - real :: I_Rho0 ! inverse of Boussinesq density [m3 kg-1] - real :: dissip ! local variable for dissipation calculations [Z2 kg m-3 T-3 ~> W m-3] + real :: dissip ! local variable for dissipation calculations [Z2 R T-3 ~> W m-3] real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] logical :: use_EOS ! If true, compute density from T/S using equation of state. @@ -279,12 +276,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - I_Rho0 = 1.0 / GV%Rho0 - ! ### Dimensional parameters if (CS%answers_2018) then + ! These hard-coded dimensional parameters are being replaced. kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200. else - kappa_dt_fill = CS%Kd_smooth * dt_in_T + kappa_dt_fill = CS%Kd_smooth * dt endif Omega2 = CS%omega * CS%omega @@ -357,7 +353,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, (GV%Z_to_H**2)*kappa_dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & - visc%TKE_turb, visc%Kv_shear_Bu, dt_in_T, G, GV, US, CS%kappaShear_CSp) + visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) @@ -367,7 +363,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, else ! Changes: visc%Kd_shear ; Sets: visc%Kv_shear and visc%TKE_turb call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & - visc%Kv_shear, dt_in_T, G, GV, US, CS%kappaShear_CSp) + visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) @@ -469,7 +465,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt_in_T, G, GV, US, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) @@ -634,7 +630,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density - !! across each interface [kg m-3]. + !! across each interface [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. integer, intent(in) :: j !< j-index of row to work on @@ -657,7 +653,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & dsp1_ds, & ! inverse coordinate variable (sigma-2) difference ! across an interface times the difference across the ! interface above it [nondim] - rho_0, & ! Layer potential densities relative to surface pressure [kg m-3] + rho_0, & ! Layer potential densities relative to surface pressure [R ~> kg m-3] maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the @@ -668,18 +664,18 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & mFkb, & ! total thickness in the mixed and buffer layers ! times ds_dsp1 [Z ~> m]. p_ref, & ! array of tv%P_Ref pressures - Rcv_kmb, & ! coordinate density in the lowest buffer layer + Rcv_kmb, & ! coordinate density in the lowest buffer layer [R ~> kg m-3] p_0 ! An array of 0 pressures real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers ! above or below [Z ~> m]. - real :: dRho_lay ! density change across a layer [kg m-3] + real :: dRho_lay ! density change across a layer [R ~> kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z m3 T-2 kg-1 -> m4 s-2 kg-1] - real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z m3 T-2 kg-1 -> m4 s-2 kg-1] - real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] - real :: I_dt ! 1/dt [T-1] + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z T-2 R-1 ~> m4 s-2 kg-1] + real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z T-2 R-1 ~> m4 s-2 kg-1] + real :: I_Rho0 ! inverse of Boussinesq reference density [R-1 ~> m3 kg-1] + real :: I_dt ! 1/dt [T-1 ~> s-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] real :: hN2pO2 ! h (N^2 + Omega^2), in [m3 T-2 Z-2 ~> m s-2]. logical :: do_i(SZI_(G)) @@ -690,9 +686,9 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & I_dt = 1.0 / dt Omega2 = CS%omega**2 H_neglect = GV%H_subroundoff - G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) if (CS%answers_2018) then - I_Rho0 = 1.0 / GV%Rho0 + I_Rho0 = 1.0 / (GV%Rho0) G_IRho0 = (US%L_to_Z**2 * GV%g_Earth) * I_Rho0 else G_IRho0 = G_Rho0 @@ -719,10 +715,10 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & do i=is,ie ; p_0(i) = 0.0 ; p_ref(i) = tv%P_Ref ; enddo do k=1,nz call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_0, rho_0(:,k), & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo call calculate_density(tv%T(:,j,kmb), tv%S(:,j,kmb), p_ref, Rcv_kmb, & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) kb_min = kmb+1 do i=is,ie @@ -859,7 +855,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: dRho_int !< Change in locally referenced potential density - !! across each interface [kg m-3]. + !! across each interface [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(G)), & @@ -867,15 +863,15 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [T-2 ~> s-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & - dRho_int_unfilt, & ! unfiltered density differences across interfaces - dRho_dT, & ! partial derivative of density wrt temp [kg m-3 degC-1] - dRho_dS ! partial derivative of density wrt saln [kg m-3 ppt-1] + dRho_int_unfilt, & ! unfiltered density differences across interfaces [R ~> kg m-3] + dRho_dT, & ! partial derivative of density wrt temp [R degC-1 ~> kg m-3 degC-1] + dRho_dS ! partial derivative of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G)) :: & pres, & ! pressure at each interface [Pa] Temp_int, & ! temperature at each interface [degC] Salin_int, & ! salinity at each interface [ppt] - drho_bot, & + drho_bot, & ! A density difference [R ~> kg m-3] h_amp, & ! The topographic roughness amplitude [Z ~> m]. hb, & ! The thickness of the bottom layer [Z ~> m]. z_from_bot ! The hieght above the bottom [Z ~> m]. @@ -883,14 +879,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real :: Rml_base ! density of the deepest variable density layer real :: dz_int ! thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density - ! times some unit conversion factors [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. + ! times some unit conversion factors [Z T-2 R-1 ~> m4 s-2 kg-1]. real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -911,7 +907,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) enddo call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state) + dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) @@ -957,13 +953,13 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int - dRho_bot(i) = dRho_bot(i) + dRho_int(i,K) + drho_bot(i) = drho_bot(i) + dRho_int(i,K) if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) - dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) + drho_bot(i) = drho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. else @@ -975,7 +971,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & do i=is,ie if (hb(i) > 0.0) then - N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) + N2_bot(i) = (G_Rho0 * drho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) @@ -1039,14 +1035,14 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp [kg m-3 degC-1] - dRho_dS, & ! partial derivatives of density wrt saln [kg m-3 ppt-1] + dRho_dT, & ! partial derivatives of density wrt temp [R degC-1 ~> kg m-3 degC-1] + dRho_dS, & ! partial derivatives of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] pres, & ! pressure at each interface [Pa] Temp_int, & ! temperature at interfaces [degC] Salin_int ! Salinity at interfaces [ppt] - real :: alpha_dT ! density difference between layers due to temp diffs [kg m-3] - real :: beta_dS ! density difference between layers due to saln diffs [kg m-3] + real :: alpha_dT ! density difference between layers due to temp diffs [R ~> kg m-3] + real :: beta_dS ! density difference between layers due to saln diffs [R ~> kg m-3] real :: Rrho ! vertical density ratio [nondim] real :: diff_dd ! factor for double-diffusion [nondim] @@ -1070,7 +1066,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) enddo call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) + dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) do i=is,ie alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) @@ -1137,14 +1133,14 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! This routine adds diffusion sustained by flow energy extracted by bottom drag. real, dimension(SZK_(G)+1) :: & - Rint ! coordinate density of an interface [kg m-3] + Rint ! coordinate density of an interface [R ~> kg m-3] real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the ! integrated thickness in the BBL [Z ~> m]. - rho_htot, & ! running integral with depth of density [Z kg m-3 ~> kg m-2] + rho_htot, & ! running integral with depth of density [Z R ~> kg m-2] gh_sum_top, & ! BBL value of g'h that can be supported by - ! the local ustar, times R0_g [kg m-2] - Rho_top, & ! density at top of the BBL [kg m-3] + ! the local ustar, times R0_g [R ~> kg m-2] + Rho_top, & ! density at top of the BBL [R ~> kg m-3] TKE, & ! turbulent kinetic energy available to drive ! bottom-boundary layer mixing in a layer [Z3 T-3 ~> m3 s-3] I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1]. @@ -1152,12 +1148,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: TKE_to_layer ! TKE used to drive mixing in a layer [Z3 T-3 ~> m3 s-3] real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [Z3 T-3 ~> m3 s-3] real :: TKE_here ! TKE that goes into mixing in this layer [Z3 T-3 ~> m3 s-3] - real :: dRl, dRbot ! temporaries holding density differences [kg m-3] + real :: dRl, dRbot ! temporaries holding density differences [R ~> kg m-3] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar_h ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: absf ! average absolute Coriolis parameter around a thickness point [T-1 ~> s-1] - real :: R0_g ! Rho0 / G_Earth [kg T2 Z-1 m-4 ~> kg s2 m-5] - real :: I_rho0 ! 1 / RHO0 [m3 kg-1] + real :: R0_g ! Rho0 / G_Earth [R T2 Z-1 m-1 ~> kg s2 m-5] + real :: I_rho0 ! 1 / RHO0 [R-1 ~> m3 kg-1] real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 T-1 ~> m2 s-1]. logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this @@ -1177,7 +1173,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE_Ray = 0.0 ; Rayleigh_drag = .false. if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = 1.0 / (GV%Rho0) R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1204,7 +1200,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & visc%TKE_BBL(i,j) if (associated(fluxes%TKE_tidal)) & - TKE(i) = TKE(i) + (US%T_to_s**3 * US%m_to_Z**3 * fluxes%TKE_tidal(i,j)) * I_Rho0 * & + TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following @@ -1256,7 +1252,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else dRl = Rint(K+1) - Rint(K) ; dRbot = Rint(K+1) - Rho_top(i) TKE_to_layer = TKE(i) * dRl * & - (3.0*dRbot*(Rint(K) - Rho_top(i)) + dRl**2) / dRbot**3 + (3.0*dRbot*(Rint(K) - Rho_top(i)) + dRl**2) / (dRbot**3) endif else ; TKE_to_layer = 0.0 ; endif @@ -1377,7 +1373,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: Kd_wall ! Law of the wall diffusivity [Z2 T-1 ~> m2 s-1]. real :: Kd_lower ! diffusivity for lower interface [Z2 T-1 ~> m2 s-1] real :: ustar_D ! u* x D [Z2 T-1 ~> m2 s-1]. - real :: I_Rho0 ! 1 / rho0 + real :: I_Rho0 ! 1 / rho0 [R-1 ~> m3 kg-1] real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall [T-2 ~> s-2] logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on ! the assumption that this extracted energy also drives diapycnal mixing. @@ -1394,7 +1390,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Determine whether to add Rayleigh drag contribution to TKE Rayleigh_drag = .false. if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = 1.0 / (GV%Rho0) cdrag_sqrt = sqrt(CS%cdrag) do i=G%isc,G%iec ! Developed in single-column mode @@ -1420,10 +1416,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! (Note that visc%TKE_BBL is in [Z3 T-3 ~> m3 s-3], set in set_BBL_TKE().) ! I am still unsure about sqrt(cdrag) in this expressions - AJA TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) - ! Add in tidal dissipation energy at the bottom [m3 s-3]. - ! Note that TKE_tidal is in [W m-2]. + ! Add in tidal dissipation energy at the bottom [R Z3 T-3 ~> m3 s-3]. + ! Note that TKE_tidal is in [R Z3 T-3 ~> W m-2]. if (associated(fluxes%TKE_tidal)) & - TKE_column = TKE_column + US%m_to_Z**3*US%T_to_s**3 * fluxes%TKE_tidal(i,j) * I_Rho0 + TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column @@ -1452,9 +1448,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = exp(-Idecay*dh) * TKE_remaining z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom [Z ~> m]. - D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. + D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer [Z ~> m]. - ! Diffusivity using law of the wall, limited by rotation, at height z [m2 s-1]. + ! Diffusivity using law of the wall, limited by rotation, at height z [Z2 T-1 ~> m2 s-1]. ! This calculation is at the upper interface of the layer if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. @@ -1463,7 +1459,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & / (ustar_D + absf * (z_bot * D_minus_z)) endif - ! TKE associated with Kd_wall [m3 s-2]. + ! TKE associated with Kd_wall [Z3 T-3 ~> m3 s-3]. ! This calculation if for the volume spanning the interface. TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) @@ -1792,15 +1788,15 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) !! it [nondim] real, dimension(SZI_(G),SZK_(G)), & optional, intent(in) :: rho_0 !< Layer potential densities relative to - !! surface press [kg m-3]. + !! surface press [R ~> kg m-3]. ! Local variables - real :: g_R0 ! g_R0 is a rescaled version of g/Rho [m3 L2 Z-1 kg-1 T-2 ~> m4 kg-1 s-2] + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [L2 Z-1 R-1 T-2 ~> m4 kg-1 s-2] real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures - real :: Rcv(SZI_(G),SZK_(G)) ! coordinate density in the mixed and buffer layers [kg m-3] - real :: I_Drho ! temporary variable [m3 kg-1] + real :: Rcv(SZI_(G),SZK_(G)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3] + real :: I_Drho ! temporary variable [R-1 ~> m3 kg-1] integer :: i, k, k3, is, ie, nz, kmb is = G%isc ; ie = G%iec ; nz = G%ke @@ -1818,13 +1814,13 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%g_Earth / GV%Rho0 + g_R0 = GV%g_Earth / (GV%Rho0) kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo do k=1,kmb call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo do i=is,ie if (kb(i) <= nz-1) then @@ -2102,18 +2098,18 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower "//& "bound of Kd (a floor).", units="W m-3", default=0.0, & - scale=US%m2_s_to_Z2_T*(US%T_to_s**2)) + scale=US%kg_m3_to_R*US%m2_s_to_Z2_T*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression "//& "used to set a minimum dissipation by which to determine "//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & units="W m-3", default=0.0, & - scale=US%m2_s_to_Z2_T*(US%T_to_s**2)) + scale=US%kg_m3_to_R*US%m2_s_to_Z2_T*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to "//& "set a minimum dissipation by which to determine a lower "//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0, scale=US%m2_s_to_Z2_T*US%T_to_s) + units="J m-3", default=0.0, scale=US%kg_m3_to_R*US%m2_s_to_Z2_T*US%T_to_s) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) @@ -2133,7 +2129,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ CS%tm_csp%Lowmode_itidal_dissipation) then CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, & - 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%Z_to_m**3*US%s_to_T**3) + 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & 'Maximum layer TKE', 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 450ccdb05a..0aaba9d3cf 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -135,15 +135,15 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) S_EOS, & ! The salinity used to calculate the partial derivatives ! of density with T and S [ppt]. dR_dT, & ! Partial derivative of the density in the bottom boundary - ! layer with temperature [kg m-3 degC-1]. + ! layer with temperature [R degC-1 ~> kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density in the bottom boundary - ! layer with salinity [kg m-3 ppt-1]. + ! layer with salinity [R ppt-1 ~> kg m-3 ppt-1]. press ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. real :: htot ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: Rhtot ! Running sum of thicknesses times the layer potential - ! densities [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! densities [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZIB_(G),SZJ_(G)) :: & D_u, & ! Bottom depth interpolated to u points [Z ~> m]. mask_u ! A mask that disables any contributions from u points that @@ -163,21 +163,21 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) S_vel, & ! Arithmetic mean of the layer salinities adjacent to a ! velocity point [ppt]. Rml_vel ! Arithmetic mean of the layer coordinate densities adjacent - ! to a velocity point [kg m-3]. + ! to a velocity point [R ~> kg m-3]. real :: h_vel_pos ! The arithmetic mean thickness at a velocity point ! plus H_neglect to avoid 0 values [H ~> m or kg m-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion - ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! from m to thickness units [H R ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, - ! divided by G_Earth [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! divided by G_Earth [H R ~> kg m-2 or kg2 m-5]. real :: Dfn ! The increment in oldfn for entraining - ! the layer [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! the layer [H R ~> kg m-2 or kg2 m-5]. real :: Dh ! The increment in layer thickness from ! the present layer [H ~> m or kg m-2]. real :: bbl_thick ! The thickness of the bottom boundary layer [H ~> m or kg m-2]. @@ -187,7 +187,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean ! magnitude near the bottom for use in the - ! quadratic bottom drag [m2 s-2]. + ! quadratic bottom drag [L2 T-2 ~> m2 s-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the @@ -198,10 +198,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa [L T-1 ~> m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [R T2 H Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & - Rml ! The mixed layer coordinate density [kg m-3]. + Rml ! The mixed layer coordinate density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually set to 2e7 Pa = 2000 dbar). @@ -260,6 +260,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: C2pi_3 ! An irrational constant, 2/3 pi. real :: tmp ! A temporary variable. real :: tmp_val_m1_to_p1 + real :: curv_tol ! Numerator of curvature cubed, used to estimate + ! accuracy of a single L(:) Newton iteration + logical :: use_L0, do_one_L_iter ! Control flags for L(:) Newton iteration logical :: use_BBL_EOS, do_i(SZIB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, m, n, K2, nkmb, nkml integer :: itt, maxitt=20 @@ -273,7 +276,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(BBL): "//& + if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& "Module must be initialized before it is used.") if (.not.CS%bottomdraglaw) return @@ -304,7 +307,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nkmb call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, & - Rml(:,j,k), Isq, Ieq-Isq+2, tv%eqn_of_state) + Rml(:,j,k), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo ; enddo endif @@ -545,7 +548,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) press(i) = press(i) + GV%H_to_Pa * h_vel(i,k) enddo ; enddo call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, & - is-G%IsdB+1, ie-is+1, tv%eqn_of_state) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=is,ie ; if (do_i(i)) then @@ -574,7 +577,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot = htot + Dh @@ -597,7 +600,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) elseif ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot = htot + Dh @@ -613,7 +616,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) elseif ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot = htot + Dh @@ -773,19 +776,29 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0) ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0) - ! The following code is more robust when GV%Angstrom_H=0, but it changes answers. - if (.not.CS%answers_2018) then - Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) - Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) - endif + use_L0 = .false. + do_one_L_iter = .false. + if (CS%answers_2018) then + curv_tol = GV%Angstrom_H*dV_dL2**2 & + * (0.25 * dV_dL2 * GV%Angstrom_H - a * L0 * dVol) + do_one_L_iter = (a * a * dVol**3) < curv_tol + else + ! The following code is more robust when GV%Angstrom_H=0, but + ! it changes answers. + use_L0 = (dVol <= 0.) + + Vol_tol = max(0.5 * GV%Angstrom_H + GV%H_subroundoff, 1e-14 * vol) + Vol_quit = max(0.9 * GV%Angstrom_H + GV%H_subroundoff, 1e-14 * vol) - if ((.not.CS%answers_2018) .and. (dVol <= 0.0)) then + curv_tol = Vol_tol * dV_dL2**2 & + * (dV_dL2 * Vol_tol - 2.0 * a * L0 * dVol) + do_one_L_iter = (a * a * dVol**3) < curv_tol + endif + + if (use_L0) then L(K) = L0 Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol - elseif ( ((.not.CS%answers_2018) .and. & - (a*a*dVol**3 < Vol_tol*dV_dL2**2 *(dV_dL2*Vol_tol - 2.0*a*L0*dVol))) .or. & - (CS%answers_2018 .and. (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol) )) ) then + elseif (do_one_L_iter) then ! One iteration of Newton's method should give an estimate ! that is accurate to within Vol_tol. L(K) = sqrt(L0*L0 + dVol / dV_dL2) @@ -1018,7 +1031,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to vertvisc_init. logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations @@ -1034,15 +1047,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Shtot, & ! The integrated salt of layers that are within the ! surface mixed layer [H ppt ~> m ppt or kg ppt m-2]. Rhtot, & ! The integrated density of layers that are within the surface mixed layer - ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no + ! [H R ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. + ! (roughly the base of the mixed layer) with temperature [R degC-1 ~> kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with salinity [kg m-3 ppt-1]. + ! (roughly the base of the mixed layer) with salinity [R ppt-1 ~> kg m-3 ppt-1]. ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] @@ -1076,8 +1089,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: I_2hlay ! 1 / 2*hlay [H-1 ~> m-1 or m2 kg-1]. real :: T_lay ! The layer temperature at velocity points [degC]. real :: S_lay ! The layer salinity at velocity points [ppt]. - real :: Rlay ! The layer potential density at velocity points [kg m-3]. - real :: Rlb ! The potential density of the layer below [kg m-3]. + real :: Rlay ! The layer potential density at velocity points [R ~> kg m-3]. + real :: Rlb ! The potential density of the layer below [R ~> kg m-3]. real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based @@ -1087,20 +1100,20 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! viscous mixed layer, including reduction for turbulent ! decay. Nondimensional. real :: dt_Rho0 ! The time step divided by the conversion from the layer - ! thickness to layer mass [s H m2 kg-1 ~> s m3 kg-1 or s]. + ! thickness to layer mass [T H Z-1 R-1 ~> s m3 kg-1 or s]. real :: g_H_Rho0 ! The gravitational acceleration times the conversion from H to m divided - ! by the mean density [L2 m3 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! by the mean density [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion - ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! from m to thickness units [H R ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, - ! divided by G_Earth [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! divided by G_Earth [H R ~> kg m-2 or kg2 m-5]. real :: Dfn ! The increment in oldfn for entraining - ! the layer [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! the layer [H R ~> kg m-2 or kg2 m-5]. real :: Dh ! The increment in layer thickness from ! the present layer [H ~> m or kg m-2]. real :: U_bg_sq ! The square of an assumed background velocity, for @@ -1113,7 +1126,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [R T2 H Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real :: ustar1 ! ustar [H T-1 ~> m s-1 or kg m-2 s-1] real :: h2f2 ! (h*2*f)^2 [H2 T-2 ~> m2 s-2 or kg2 m-4 s-2] @@ -1125,7 +1138,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc_ML): "//& + if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& "Module must be initialized before it is used.") if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. & associated(forces%frac_shelf_v)) ) return @@ -1141,25 +1154,27 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) - dt_Rho0 = dt/GV%H_to_kg_m2 + dt_Rho0 = dt / GV%H_to_RZ h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect - g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0 + g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / (GV%Rho0) if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& "forces%frac_shelf_v is associated, but the other is not.") if (associated(forces%frac_shelf_u)) then - ! This configuration has ice shelves, and the appropriate variables need to - ! be allocated. + ! This configuration has ice shelves, and the appropriate variables need to be + ! allocated. If the arrays have already been allocated, these calls do nothing. call safe_alloc_ptr(visc%tauy_shelf, G%isd, G%ied, G%JsdB, G%JedB) call safe_alloc_ptr(visc%tbl_thick_shelf_u, G%IsdB, G%IedB, G%jsd, G%jed) call safe_alloc_ptr(visc%tbl_thick_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) call safe_alloc_ptr(visc%kv_tbl_shelf_u, G%IsdB, G%IedB, G%jsd, G%jed) call safe_alloc_ptr(visc%kv_tbl_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) + call safe_alloc_ptr(visc%taux_shelf, G%IsdB, G%IedB, G%jsd, G%jed) + call safe_alloc_ptr(visc%tauy_shelf, G%isd, G%ied, G%JsdB, G%JedB) - ! With a linear drag law, the friction velocity is already known. + ! With a linear drag law under shelves, the friction velocity is already known. ! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel endif @@ -1205,8 +1220,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(I) = .true. ; do_any = .true. k_massive(I) = nkml Thtot(I) = 0.0 ; Shtot(I) = 0.0 ; Rhtot(i) = 0.0 - uhtot(I) = US%m_s_to_L_T*dt_Rho0 * forces%taux(I,j) - vhtot(I) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & + uhtot(I) = dt_Rho0 * forces%taux(I,j) + vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else @@ -1232,7 +1247,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri S_EOS(I) = (h(i,j,k2)*tv%S(i,j,k2) + h(i+1,j,k2)*tv%S(i+1,j,k2)) * I_2hlay enddo call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, & - Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state) + Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1353,7 +1368,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (use_EOS) then call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), & - dR_dT, dR_dS, Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state) + dR_dT, dR_dS, Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1376,7 +1391,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot(i) = htot(i) + Dh @@ -1401,7 +1416,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot(i) = htot(i) + Dh @@ -1440,8 +1455,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(i) = .true. ; do_any = .true. k_massive(i) = nkml Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; Rhtot(i) = 0.0 - vhtot(i) = US%m_s_to_L_T*dt_Rho0 * forces%tauy(i,J) - uhtot(i) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & + vhtot(i) = dt_Rho0 * forces%tauy(i,J) + uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & (forces%taux(I-1,j) + forces%taux(I,j+1))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else @@ -1469,7 +1484,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri S_EOS(i) = (h(i,j,k2)*tv%S(i,j,k2) + h(i,j+1,k2)*tv%S(i,j+1,k2)) * I_2hlay enddo call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, & - is-G%IsdB+1, ie-is+1, tv%eqn_of_state) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=is,ie ; if (do_i(i)) then @@ -1590,7 +1605,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (use_EOS) then call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), & - dR_dT, dR_dS, is-G%IsdB+1, ie-is+1, tv%eqn_of_state) + dR_dT, dR_dS, is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=is,ie ; if (do_i(i)) then @@ -1613,7 +1628,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot(i) = htot(i) + Dh @@ -1638,7 +1653,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else - Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) + Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn)) endif htot(i) = htot(i) + Dh diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 978e8d1807..dd0887845c 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -11,6 +11,7 @@ module MOM_sponge use MOM_grid, only : ocean_grid_type use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type ! Planned extension: Support for time varying sponge targets. @@ -54,9 +55,9 @@ module MOM_sponge !! registered by calls to set_up_sponge_field integer, pointer :: col_i(:) => NULL() !< Array of the i-indicies of each of the columns being damped. integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each of the columns being damped. - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each column. + real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each column [T-1 ~> s-1]. real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer - !! coordinate-density is being damped [kg m-3]. + !! coordinate-density is being damped [R ~> kg m-3]. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface !! heights are being damped [Z ~> m]. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. @@ -64,9 +65,9 @@ module MOM_sponge logical :: do_i_mean_sponge !< If true, apply sponges to the i-mean fields. real, pointer :: Iresttime_im(:) => NULL() !< The inverse restoring time of - !! each row for i-mean sponges. + !! each row for i-mean sponges [T-1 ~> s-1]. real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean - !< mixed layer coordinate-density is being damped [kg m-3]. + !< mixed layer coordinate-density is being damped [R ~> kg m-3]. real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean !! interface heights are being damped [Z ~> m]. type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of @@ -154,7 +155,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) then CS%col_i(col) = i ; CS%col_j(col) = j - CS%Iresttime_col(col) = Iresttime(i,j) + CS%Iresttime_col(col) = G%US%T_to_s*Iresttime(i,j) col = col +1 endif enddo ; enddo @@ -171,7 +172,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & allocate(CS%Ref_eta_im(G%jsd:G%jed,G%ke+1)) ; CS%Ref_eta_im(:,:) = 0.0 do j=G%jsc,G%jec - CS%Iresttime_im(j) = Iresttime_i_mean(j) + CS%Iresttime_im(j) = G%US%T_to_s*Iresttime_i_mean(j) enddo do K=1,CS%nz+1 ; do j=G%jsc,G%jec CS%Ref_eta_im(j,K) = int_height_i_mean(j,K) @@ -189,9 +190,11 @@ end subroutine initialize_sponge !> This subroutine sets up diagnostics for the sponges. It is separate !! from initialize_sponge because it requires fields that are not readily !! available where initialize_sponge is called. -subroutine init_sponge_diags(Time, G, diag, CS) +subroutine init_sponge_diags(Time, G, GV, US, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that !! is set by a previous call to initialize_sponge. @@ -200,7 +203,7 @@ subroutine init_sponge_diags(Time, G, diag, CS) CS%diag => diag CS%id_w_sponge = register_diag_field('ocean_model', 'w_sponge', diag%axesTi, & - Time, 'The diapycnal motion due to the sponges', 'm s-1') + Time, 'The diapycnal motion due to the sponges', 'm s-1', conversion=US%s_to_T) end subroutine init_sponge_diags @@ -273,12 +276,12 @@ end subroutine set_up_sponge_field subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: sp_val !< The reference values of the mixed layer density [kg m-3] + intent(in) :: sp_val !< The reference values of the mixed layer density [R ~> kg m-3] type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that is !! set by a previous call to initialize_sponge. real, dimension(SZJ_(G)), & optional, intent(in) :: sp_val_i_mean !< the reference values of the zonal mean mixed - !! layer density [kg m-3], for use if Iresttime_i_mean > 0. + !! layer density [R ~> kg m-3], for use if Iresttime_i_mean > 0. ! This subroutine stores the reference value for mixed layer density. It is ! handled differently from other values because it is only used in determining ! which layers can be inflated. @@ -317,12 +320,13 @@ end subroutine set_up_sponge_ML_density !> This subroutine applies damping to the layers thicknesses, mixed layer buoyancy, and a variety of !! tracers for every column where there is damping. -subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) +subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, intent(in) :: dt !< The amount of time covered by this call [s]. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< An array to which the amount of fluid entrained !! from the layer above during this call will be @@ -334,7 +338,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer [kg m-3]. + optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer [R ~> kg m-3]. ! This subroutine applies damping to the layers thicknesses, mixed ! layer buoyancy, and a variety of tracers for every column where @@ -376,7 +380,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim] real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). [nondim] - real :: Idt ! 1.0/dt [s-1]. + real :: Idt ! 1.0/dt times a height unit conversion factor [m H-1 T-1 ~> s-1 or m3 kg-1 s-1]. integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -428,7 +432,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) enddo do j=js,je ; if (CS%Iresttime_im(j) > 0.0) then - damp = dt*CS%Iresttime_im(j) ; damp_1pdamp = damp / (1.0 + damp) + damp = dt * CS%Iresttime_im(j) ; damp_1pdamp = damp / (1.0 + damp) do i=is,ie h_above(i,1) = 0.0 ; h_below(i,nz+1) = 0.0 @@ -476,7 +480,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! c is an index for the next 3 lines but a multiplier for the rest of the loop ! Therefore we use c as per C code and increment the index where necessary. i = CS%col_i(c) ; j = CS%col_j(c) - damp = dt*CS%Iresttime_col(c) + damp = dt * CS%Iresttime_col(c) e(1) = 0.0 ; e0 = 0.0 do K=1,nz @@ -574,7 +578,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then if (CS%id_w_sponge > 0) then - Idt = GV%H_to_m / dt + Idt = GV%H_to_m / dt ! Do any height unit conversion here for efficiency. do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index fd910697af..887cc6d067 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -45,9 +45,9 @@ module MOM_tidal_mixing Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [kg Z3 m-3 T-3 ~> W m-2] - Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [kg Z3 m-3 T-3 ~> W m-2] - Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [kg Z3 m-3 T-3 ~> W m-2] + Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] + Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] + Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] N2_int => NULL(),& !< Bouyancy frequency squared at interfaces [s-2] vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition [W m-3] Schmittner_coeff_3d => NULL() !< The coefficient in the Schmittner et al mixing scheme, in UNITS? @@ -58,7 +58,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [kg Z3 m-3 T-3 ~> W m-2] + TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] N2_bot => NULL(),& !< bottom squared buoyancy frequency [T-2 ~> s-2] N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [T-2 ~> s-2] Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation @@ -108,7 +108,7 @@ module MOM_tidal_mixing !! et al. (2002) and Simmons et al. (2004). real :: Nu_Polzin !< The non-dimensional constant used in Polzin form of - !! the vertical scale of decay of tidal dissipation + !! the vertical scale of decay of tidal dissipation [nondim] real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the !! ocean bottom used in Polzin formulation of the @@ -121,7 +121,7 @@ module MOM_tidal_mixing real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation !! profile in Polzin formulation [Z ~> m]. - real :: TKE_itide_max !< maximum internal tide conversion [kg Z3 m-3 T-3 ~> W m-2] + real :: TKE_itide_max !< maximum internal tide conversion [R Z3 T-3 ~> W m-2] !! available to mix above the BBL real :: utide !< constant tidal amplitude [Z T-1 ~> m s-1] if READ_TIDEAMP is false. @@ -145,9 +145,9 @@ module MOM_tidal_mixing ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input - !! [kg Z3 m-3 T-3 ~> W m-2] + !! [R Z3 T-3 ~> W m-2] real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication [kg Z3 m-3 T-2 ~> J m-2]. + !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [T-1 ~> s-1]. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [m2]. @@ -433,7 +433,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source available to mix "//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & - units="W m-2", default=1.0e3, scale=US%m_to_Z**3*US%T_to_s**3) + units="W m-2", default=1.0e3, scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing "//& @@ -479,7 +479,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing. - ! The units here are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. + ! The units here are [R Z3 T-2 ~> J m-2 = kg s-2] here. CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * & CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -502,7 +502,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) filename) call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je) ; CS%TKE_Niku(:,:) = 0.0 call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja - scale=US%m_to_Z**3*US%T_to_s**3) + scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3) CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & @@ -596,7 +596,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) else CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'Internal Tide Driven Turbulent Kinetic Energy', & + 'W m-2', conversion=(US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3)) CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & 'Bottom Buoyancy Frequency', 's-1', conversion=US%s_to_T) @@ -628,20 +629,23 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 'Buoyancy frequency squared averaged over the water column', 's-2', conversion=US%s_to_T**2) CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'Work done by Internal Tide Diapycnal Mixing', & + 'W m-2', conversion=(US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & - 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'Work done by Nikurashin Lee Wave Drag Scheme', & + 'W m-2', conversion=(US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & 'Work done by Internal Tide Diapycnal Mixing (low modes)', & - 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'W m-2', conversion=(US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3)) if (CS%Lee_wave_dissipation) then CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & - 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'Lee wave Driven Turbulent Kinetic Energy', & + 'W m-2', conversion=(US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif endif ! S%use_CVMix_tidal endif @@ -992,7 +996,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, z_from_bot, & ! distance from bottom [Z ~> m]. z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. - real :: I_rho0 ! 1 / RHO0 [m3 kg-1] + real :: I_rho0 ! Inverse of the Boussinesq reference density, i.e. 1 / RHO0 [R-1 ~> m3 kg-1] real :: Kd_add ! diffusivity to add in a layer [Z2 T-1 ~> m2 s-1]. real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [Z3 T-3 ~> m3 s-3] real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [Z3 T-3 ~> m3 s-3] @@ -1003,7 +1007,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3]. real :: z0Ps_denom ! The denominator of the unlimited z0_Polzin_scaled [T-3 ~> s-3]. real :: z0_psl ! temporary variable [Z ~> m]. - real :: TKE_lowmode_tot ! TKE from all low modes [kg Z3 m-3 T-3 ~> W m-2] (BDM) + real :: TKE_lowmode_tot ! TKE from all low modes [R Z3 T-3 ~> W m-2] (BDM) logical :: use_Polzin, use_Simmons character(len=160) :: mesg ! The text of an error message @@ -1021,7 +1025,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = 1.0 / (GV%Rho0) use_Polzin = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09)) .or. & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4b80c38d13..c612a1ceed 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -155,7 +155,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< Viscosities and bottom drag - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure type(accel_diag_ptrs), intent(inout) :: ADp !< Accelerations in the momentum !! equations for diagnostics @@ -163,10 +163,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to - !! rock [kg L Z T-2 m-3 ~> Pa] + !! rock [R L Z T-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to - !! rock [kg L Z T-2 m-3 ~> Pa] + !! rock [R L Z T-2 ~> Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information @@ -185,10 +185,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress [H ~> m or kg m-2]. real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. - real :: dt_in_T ! The timestep [T ~> s] real :: Idt ! The inverse of the time step [T-1 ~> s-1]. - real :: dt_Rho0 ! The time step divided by the mean density [L s2 H m T-1 kg-1 ~> s m3 kg-1 or s]. - real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. + real :: dt_Rho0 ! The time step divided by the mean density [T H Z-1 R-1 ~> s m3 kg-1 or s]. real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - [T H Z-1 ~> s or s kg m-3]. real :: h_neglect ! A thickness that is so small it is usually lost @@ -214,12 +212,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif - dt_in_T = US%s_to_T*dt - dt_Rho0 = US%m_s_to_L_T*US%T_to_s * dt_in_T / GV%H_to_kg_m2 - dt_Z_to_H = dt_in_T*GV%Z_to_H - Rho0 = GV%Rho0 + dt_Rho0 = dt / GV%H_to_RZ + dt_Z_to_H = dt*GV%Z_to_H h_neglect = GV%H_subroundoff - Idt = 1.0 / dt_in_T + Idt = 1.0 / dt !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. @@ -322,15 +318,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -GV%Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = GV%Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + GV%Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -403,15 +399,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -GV%Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = GV%Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + GV%Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -471,7 +467,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a !! barotopic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure @@ -493,7 +489,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H + dt_Z_to_H = dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -579,12 +575,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure ! Field from forces used in this subroutine: - ! ustar: the friction velocity [m s-1], used here as the mixing + ! ustar: the friction velocity [Z T-1 ~> m s-1], used here as the mixing ! velocity in the mixed layer if NKML > 1 in a bulk mixed layer. ! Local variables @@ -1055,7 +1051,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, !! normalized by the bottom boundary layer thickness real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [H ~> m or kg m-2] integer, intent(in) :: j !< j-index to find coupling coefficient for - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -1108,7 +1104,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The maximum coupling coefficent was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. - I_amax = (1.0e-10*US%Z_to_m) * dt*US%s_to_T + I_amax = (1.0e-10*US%Z_to_m) * dt do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1305,9 +1301,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, end subroutine find_coupling_coef -!> Velocity components which exceed a threshold for physically -!! reasonable values are truncated. Optionally, any column with excessive -!! velocities may be sent to a diagnostic reporting subroutine. +!> Velocity components which exceed a threshold for physically reasonable values +!! are truncated. Optionally, any column with excessive velocities may be sent +!! to a diagnostic reporting subroutine. subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -1322,17 +1318,16 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS type(cont_diag_ptrs), intent(in) :: CDp !< Continuity diagnostic pointers type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables real :: maxvel ! Velocities components greater than maxvel real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. - real :: dt_in_T ! The timestep [T ~> s] real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. - real :: dt_Rho0 ! The timestep divided by the Boussinesq density [s m3 kg-1]. + real :: dt_Rho0 ! The timestep divided by the Boussinesq density [m2 T2 s-1 L-1 Z-1 R-1 ~> s m3 kg-1]. real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) ! The previous u-velocity [L T-1 ~> m s-1] real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] @@ -1344,8 +1339,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS maxvel = CS%maxvel truncvel = 0.9*maxvel H_report = 6.0 * GV%Angstrom_H - dt_in_T = US%s_to_T*dt - dt_Rho0 = dt / GV%Rho0 + dt_Rho0 = (US%L_T_to_m_s*US%Z_to_m) * dt / (GV%Rho0) if (len_trim(CS%u_trunc_file) > 0) then !$OMP parallel do default(shared) private(trunc_any,CFL) @@ -1357,9 +1351,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1383,11 +1377,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1400,14 +1394,14 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS enddo ! j-loop else ! Do not report accelerations leading to large velocities. if (CS%CFL_based_trunc) then -!$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt_in_T,G,CS,h,H_report) +!$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1416,7 +1410,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 elseif (abs(u(I,j,k)) > maxvel) then - u(I,j,k) = SIGN(truncvel,u(I,j,k)) + u(I,j,k) = SIGN(truncvel, u(I,j,k)) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1442,9 +1436,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1468,11 +1462,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1488,11 +1482,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1501,7 +1495,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 elseif (abs(v(i,J,k)) > maxvel) then - v(i,J,k) = SIGN(truncvel,v(i,J,k)) + v(i,J,k) = SIGN(truncvel, v(i,J,k)) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1737,10 +1731,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%L_T2_to_m_s2*US%Z_to_m) + conversion=US%R_to_kg_m3*US%L_T2_to_m_s2*US%Z_to_m) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%L_T2_to_m_s2*US%Z_to_m) + conversion=US%R_to_kg_m3*US%L_T2_to_m_s2*US%Z_to_m) if ((len_trim(CS%u_trunc_file) > 0) .or. (len_trim(CS%v_trunc_file) > 0)) & call PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS%PointAccel_CSp) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 0268c04f17..a5fc04fc06 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -460,9 +460,9 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS ! The -GV%Rho0 changes the sign convention of the flux and changes the units ! of the flux from [Conc. m s-1] to [Conc. kg m-2 s-1]. call coupler_type_extract_data(fluxes%tr_fluxes, CS%ind_cfc_11_flux, ind_flux, & - CFC11_flux, -GV%Rho0, idim=idim, jdim=jdim) + CFC11_flux, -G%US%R_to_kg_m3*GV%Rho0, idim=idim, jdim=jdim) call coupler_type_extract_data(fluxes%tr_fluxes, CS%ind_cfc_12_flux, ind_flux, & - CFC12_flux, -GV%Rho0, idim=idim, jdim=jdim) + CFC12_flux, -G%US%R_to_kg_m3*GV%Rho0, idim=idim, jdim=jdim) ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index d12897038f..28f31c6fa1 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -457,7 +457,8 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'runoff_tracer_flux',runoff_tracer_flux_array) !nnz: Why is fluxes%river = 0? - runoff_tracer_flux_array = trunoff_array * fluxes%lrunoff + runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * & + G%US%R_to_kg_m3*G%US%Z_to_m*G%US%s_to_T*fluxes%lrunoff(:,:) stf_array = stf_array + runoff_tracer_flux_array endif @@ -492,9 +493,10 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,Hml,G%isd,G%jsd,1,dt,& - G%US%L_to_m**2*G%areaT, get_diag_time_end(CS%diag), & + G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & - internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) + internal_heat=tv%internal_heat, & + frunoff=G%US%R_to_kg_m3*G%US%Z_to_m*G%US%s_to_T*fluxes%frunoff(:,:), sosga=sosga) ! This uses applyTracerBoundaryFluxesInOut to handle the change in tracer due to freshwater fluxes ! usually in ALE mode diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 80c6aa242f..0ffff7409d 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -435,7 +435,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] - real, intent(in) :: dt !< Tracer time step * I_numitts + real, intent(in) :: dt !< Tracer time step * I_numitts [T ~> s] !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -454,7 +454,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) type(tracer_type), pointer :: Tracer => NULL() ! Pointer to the current tracer integer :: i, j, k, m, ks, nk - real :: Idt + real :: Idt ! The inverse of the time step [T-1 ~> s-1] real :: h_neglect, h_neglect_edge !### Try replacing both of these with GV%H_subroundoff @@ -468,10 +468,10 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) tracer => Reg%Tr(m) ! for diagnostics - if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 .or. & - tracer%id_dfx_2d > 0 .or. tracer%id_dfy_2d > 0) then - Idt = 1.0/dt - tendency(:,:,:) = 0.0 + if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 .or. & + tracer%id_dfx_2d > 0 .or. tracer%id_dfy_2d > 0) then + Idt = 1.0 / dt + tendency(:,:,:) = 0.0 endif uFlx(:,:,:) = 0. @@ -2401,6 +2401,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) ! Tests for linearized version of searching the layer for neutral surface position ! EOS linear in T, uniform alpha CS%max_iter = 10 + ! Unit tests require explicit initialization of tolerance + CS%Drho_tol = 0. + CS%x_tol = 0. ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & find_neutral_pos_linear(CS, 0., 10., 35., 0., -0.2, 0., & 0., -0.2, 0., 10., -0.2, 0., & diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 753faa2a56..164ba483b6 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -58,7 +58,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used - real, intent(in) :: dt !< time increment [s] + real, intent(in) :: dt !< time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry @@ -88,7 +88,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! can be simply discarded [H L2 ~> m3 or kg]. real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> m3 or kg]. - real :: Idt ! 1/dt [s-1]. + real :: Idt ! 1/dt [T-1 ~> s-1]. logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding ! row or column. @@ -122,7 +122,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ntr = Reg%ntr do m=1,ntr ; Tr(m) = Reg%Tr(m) ; enddo - Idt = 1.0/dt + Idt = 1.0 / dt max_iter = 2*INT(CEILING(dt/CS%dt)) + 1 @@ -339,7 +339,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row - real, intent(in) :: Idt !< The inverse of dt [s-1] + real, intent(in) :: Idt !< The inverse of dt [T-1 ~> s-1] integer, intent(in) :: ntr !< The number of tracers integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on @@ -380,7 +380,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 real :: fac1,u_L_in,u_L_out ! terms used for time-stepping OBC reservoirs type(OBC_segment_type), pointer :: segment=>NULL() - real :: dt ! the inverse of Idt, needed for time-stepping of tracer reservoirs logical :: usePLMslope usePLMslope = .not. (usePPM .and. useHuynh) @@ -390,7 +389,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff - dt=1.0/Idt ! do I=is-1,ie ; ts2(I) = 0.0 ; enddo do I=is-1,ie ; CFL(I) = 0.0 ; enddo @@ -652,10 +650,14 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & do m=1,ntr ! update tracer - do i=is,ie ; if ((do_i(i)) .and. (Ihnew(i) > 0.0)) then - Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & - (flux_x(I,m) - flux_x(I-1,m))) * Ihnew(i) - endif ; enddo + do i=is,ie + if (do_i(i)) then + if (Ihnew(i) > 0.0) then + Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & + (flux_x(I,m) - flux_x(I-1,m))) * Ihnew(i) + endif + endif + enddo ! diagnostics if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i)) then @@ -696,7 +698,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row - real, intent(in) :: Idt !< The inverse of dt [s-1] + real, intent(in) :: Idt !< The inverse of dt [T-1 ~> s-1] integer, intent(in) :: ntr !< The number of tracers integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on @@ -736,7 +738,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer :: i, j, j2, m, n, j_up, stencil real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 real :: fac1,v_L_in,v_L_out ! terms used for time-stepping OBC reservoirs - real :: dt ! The inverse of Idt, needed for segment reservoir time-stepping type(OBC_segment_type), pointer :: segment=>NULL() logical :: usePLMslope @@ -747,7 +748,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff - dt=1.0/Idt !do i=is,ie ; ts2(i) = 0.0 ; enddo ! We conditionally perform work on tracer points: calculating the PLM slope, @@ -1051,9 +1051,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & end subroutine advect_y !> Initialize lateral tracer advection module -subroutine tracer_advect_init(Time, G, param_file, diag, CS) +subroutine tracer_advect_init(Time, G, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< open file to parse for model parameters type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output type(tracer_advect_CS), pointer :: CS !< module control structure @@ -1076,7 +1077,7 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DT", CS%dt, fail_if_missing=.true., & - desc="The (baroclinic) dynamics time step.", units="s") + desc="The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) call get_param(param_file, mdl, "TRACER_ADVECTION_SCHEME", mesg, & desc="The horizontal transport scheme for tracers:\n"//& diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index f7f8028d91..276742905c 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -18,10 +18,10 @@ module MOM_tracer_diabatic contains -!> This subroutine solves a tridiagonal equation for the final tracer -!! concentrations after the dual-entrainments, and possibly sinking or surface -!! and bottom sources, are applied. The sinking is implemented with an -!! fully implicit upwind advection scheme. +!> This subroutine solves a tridiagonal equation for the final tracer concentrations after the +!! dual-entrainments, and possibly sinking or surface and bottom sources, are applied. The sinking +!! is implemented with an fully implicit upwind advection scheme. Alternate time units can be +!! used for the timestep, surface and bottom fluxes and sink_rate provided they are all consistent. subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in) type(ocean_grid_type), intent(in) :: G !< ocean grid structure @@ -33,13 +33,18 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer !! below [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration in concentration units [CU] - real, intent(in) :: dt !< amount of time covered by this call [s] - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer [CU kg m-2 s-1] + real, intent(in) :: dt !< amount of time covered by this call [T ~> s] + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units of + !! [CU kg m-2 T-1 ~> CU kg m-2 s-1] or + !! [CU H ~> CU m or CU kg m-2] if + !! convert_flux_in is .false. real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the - !! tracer [CU kg m-2 s-1] + !! tracer in [CU kg m-2 T-1 ~> CU kg m-2 s-1] or + !! [CU H ~> CU m or CU kg m-2] if real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir !! [CU kg m-2]; formerly [CU m] - real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks [m s-1] + real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks + !! [m T-1 ~> m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index d6e913094c..3dd89881b2 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -35,11 +35,10 @@ module MOM_tracer_hor_diff !> The ocntrol structure for along-layer and epineutral tracer diffusion type, public :: tracer_hor_diff_CS ; private - real :: dt !< The baroclinic dynamics time step [s]. - real :: KhTr !< The along-isopycnal tracer diffusivity [m2 s-1]. - real :: KhTr_Slope_Cff !< The non-dimensional coefficient in KhTr formula - real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity [m2 s-1]. - real :: KhTr_max !< Maximum along-isopycnal tracer diffusivity [m2 s-1]. + real :: KhTr !< The along-isopycnal tracer diffusivity [L2 T-1 ~> m2 s-1]. + real :: KhTr_Slope_Cff !< The non-dimensional coefficient in KhTr formula [nondim] + real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity [L2 T-1 ~> m2 s-1]. + real :: KhTr_max !< Maximum along-isopycnal tracer diffusivity [L2 T-1 ~> m2 s-1]. real :: KhTr_passivity_coeff !< Passivity coefficient that scales Rd/dx (default = 0) !! where passivity is the ratio between along-isopycnal !! tracer mixing and thickness mixing [nondim] @@ -101,7 +100,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, intent(in) :: dt !< time step [s] + real, intent(in) :: dt !< time step [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -153,11 +152,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real :: I_numitts ! The inverse of the number of iterations, num_itts. real :: scale ! The fraction of khdt_x or khdt_y that is applied in this ! layer for this iteration [nondim]. - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. - real :: dt_in_T ! The timestep [T ~> s] real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. @@ -178,8 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online call cpu_clock_begin(id_clock_diffuse) ntr = Reg%ntr - dt_in_T = US%s_to_T*dt - Idt = 1.0/dt + Idt = 1.0 / dt h_neglect = GV%H_subroundoff if (CS%Diffuse_ML_interior .and. CS%first_call) then ; if (is_root_pe()) then @@ -248,48 +245,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt_in_T*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt_in_T*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -302,7 +299,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt_in_T*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else @@ -319,7 +316,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt_in_T*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else @@ -487,7 +484,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%debug) call MOM_tracer_chksum("Before epipycnal diff ", Reg%Tr, ntr, G) call cpu_clock_begin(id_clock_epimix) - call tracer_epipycnal_ML_diff(h, dt, Reg%Tr, ntr, khdt_x, khdt_y, G, GV, & + call tracer_epipycnal_ML_diff(h, dt, Reg%Tr, ntr, khdt_x, khdt_y, G, GV, US, & CS, tv, num_itts) call cpu_clock_end(id_clock_epimix) endif @@ -546,11 +543,11 @@ end subroutine tracer_hordiff !! Multiple iterations are used (if necessary) so that there is no limit on the !! acceptable time increment. subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & - GV, CS, tv, num_itts) + GV, US, CS, tv, num_itts) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, intent(in) :: dt !< time step + real, intent(in) :: dt !< time step [T ~> s] type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< Zonal epipycnal diffusivity times @@ -559,15 +556,16 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< Meridional epipycnal diffusivity times !! a time step and the ratio of the open face width over !! the distance between adjacent tracer points [L2 ~> m2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), intent(inout) :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic structure integer, intent(in) :: num_itts !< number of iterations (usually=1) real, dimension(SZI_(G), SZJ_(G)) :: & - Rml_max ! The maximum coordinate density within the mixed layer [kg m-3]. + Rml_max ! The maximum coordinate density within the mixed layer [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G), max(1,GV%nk_rho_varies)) :: & - rho_coord ! The coordinate density that is used to mix along [kg m-3]. + rho_coord ! The coordinate density that is used to mix along [R ~> kg m-3]. ! The naming mnemnonic is a=above,b=below,L=Left,R=Right,u=u-point,v=v-point. ! These are 1-D arrays of pointers to 2-d arrays to minimize memory usage. @@ -591,7 +589,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & - rho_srt, & ! The density of each layer of the sorted columns [kg m-3]. + rho_srt, & ! The density of each layer of the sorted columns [R ~> kg m-3]. h_srt ! The thickness of each layer of the sorted columns [H ~> m or kg m-2]. integer, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & k0_srt ! The original k-index that each layer of the sorted column @@ -622,9 +620,9 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & nPv ! The number of epipycnal pairings at each v-point. real :: h_exclude ! A thickness that layers must attain to be considered ! for inclusion in mixing [H ~> m or kg m-2]. - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. real :: I_maxitt ! The inverse of the maximum number of iterations. - real :: rho_pair, rho_a, rho_b ! Temporary densities [kg m-3]. + real :: rho_pair, rho_a, rho_b ! Temporary densities [R ~> kg m-3]. real :: Tr_min_face ! The minimum and maximum tracer concentrations real :: Tr_max_face ! associated with a pairing [Conc] real :: Tr_La, Tr_Lb ! The 4 tracer concentrations that might be @@ -653,7 +651,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB - Idt = 1.0/dt + Idt = 1.0 / dt nkmb = GV%nk_rho_varies if (num_itts <= 1) then @@ -669,7 +667,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & !$OMP parallel do default(shared) do k=1,nkmb ; do j=js-2,je+2 call calculate_density(tv%T(:,j,k),tv%S(:,j,k), p_ref_cv, & - rho_coord(:,j,k), is-2, ie-is+5, tv%eqn_of_state) + rho_coord(:,j,k), is-2, ie-is+5, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo ; enddo do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 6a2dd79b5b..5f32fb104e 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -393,33 +393,33 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) Tr%id_adx = register_diag_field("ocean_model", trim(shortnm)//"_adx", & diag%axesCuL, Time, trim(flux_longname)//" advective zonal flux" , & trim(flux_units), v_extensive = .true., y_cell_method = 'sum', & - conversion=Tr%flux_scale) + conversion=Tr%flux_scale*US%s_to_T) Tr%id_ady = register_diag_field("ocean_model", trim(shortnm)//"_ady", & diag%axesCvL, Time, trim(flux_longname)//" advective meridional flux" , & trim(flux_units), v_extensive = .true., x_cell_method = 'sum', & - conversion=Tr%flux_scale) + conversion=Tr%flux_scale*US%s_to_T) Tr%id_dfx = register_diag_field("ocean_model", trim(shortnm)//"_dfx", & diag%axesCuL, Time, trim(flux_longname)//" diffusive zonal flux" , & trim(flux_units), v_extensive = .true., y_cell_method = 'sum', & - conversion=(US%L_to_m**2)*Tr%flux_scale) + conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T) Tr%id_dfy = register_diag_field("ocean_model", trim(shortnm)//"_dfy", & diag%axesCvL, Time, trim(flux_longname)//" diffusive zonal flux" , & trim(flux_units), v_extensive = .true., x_cell_method = 'sum', & - conversion=(US%L_to_m**2)*Tr%flux_scale) + conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T) else Tr%id_adx = register_diag_field("ocean_model", trim(shortnm)//"_adx", & diag%axesCuL, Time, "Advective (by residual mean) Zonal Flux of "//trim(flux_longname), & - flux_units, v_extensive=.true., conversion=Tr%flux_scale, y_cell_method = 'sum') + flux_units, v_extensive=.true., conversion=Tr%flux_scale*US%s_to_T, y_cell_method = 'sum') Tr%id_ady = register_diag_field("ocean_model", trim(shortnm)//"_ady", & diag%axesCvL, Time, "Advective (by residual mean) Meridional Flux of "//trim(flux_longname), & - flux_units, v_extensive=.true., conversion=Tr%flux_scale, x_cell_method = 'sum') + flux_units, v_extensive=.true., conversion=Tr%flux_scale*US%s_to_T, x_cell_method = 'sum') Tr%id_dfx = register_diag_field("ocean_model", trim(shortnm)//"_diffx", & diag%axesCuL, Time, "Diffusive Zonal Flux of "//trim(flux_longname), & - flux_units, v_extensive=.true., conversion=(US%L_to_m**2)*Tr%flux_scale, & + flux_units, v_extensive=.true., conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T, & y_cell_method='sum') Tr%id_dfy = register_diag_field("ocean_model", trim(shortnm)//"_diffy", & diag%axesCvL, Time, "Diffusive Meridional Flux of "//trim(flux_longname), & - flux_units, v_extensive=.true., conversion=(US%L_to_m**2)*Tr%flux_scale, & + flux_units, v_extensive=.true., conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T, & x_cell_method='sum') endif if (Tr%id_adx > 0) call safe_alloc_ptr(Tr%ad_x,IsdB,IedB,jsd,jed,nz) @@ -430,20 +430,20 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) Tr%id_adx_2d = register_diag_field("ocean_model", trim(shortnm)//"_adx_2d", & diag%axesCu1, Time, & "Vertically Integrated Advective Zonal Flux of "//trim(flux_longname), & - flux_units, conversion=Tr%flux_scale, y_cell_method = 'sum') + flux_units, conversion=Tr%flux_scale*US%s_to_T, y_cell_method = 'sum') Tr%id_ady_2d = register_diag_field("ocean_model", trim(shortnm)//"_ady_2d", & diag%axesCv1, Time, & "Vertically Integrated Advective Meridional Flux of "//trim(flux_longname), & - flux_units, conversion=Tr%flux_scale, x_cell_method = 'sum') + flux_units, conversion=Tr%flux_scale*US%s_to_T, x_cell_method = 'sum') Tr%id_dfx_2d = register_diag_field("ocean_model", trim(shortnm)//"_diffx_2d", & diag%axesCu1, Time, & "Vertically Integrated Diffusive Zonal Flux of "//trim(flux_longname), & - flux_units, conversion=(US%L_to_m**2)*Tr%flux_scale, & + flux_units, conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T, & y_cell_method='sum') Tr%id_dfy_2d = register_diag_field("ocean_model", trim(shortnm)//"_diffy_2d", & diag%axesCv1, Time, & "Vertically Integrated Diffusive Meridional Flux of "//trim(flux_longname), & - flux_units, conversion=(US%L_to_m**2)*Tr%flux_scale, & + flux_units, conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T, & x_cell_method='sum') if (Tr%id_adx_2d > 0) call safe_alloc_ptr(Tr%ad2d_x,IsdB,IedB,jsd,jed) @@ -455,11 +455,11 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) diag%axesTL, Time, & 'Horizontal convergence of residual mean advective fluxes of '//& trim(lowercase(flux_longname)), conv_units, v_extensive=.true., & - conversion=Tr%conv_scale) + conversion=Tr%conv_scale*US%s_to_T) Tr%id_adv_xy_2d = register_diag_field('ocean_model', trim(shortnm)//"_advection_xy_2d", & diag%axesT1, Time, & 'Vertical sum of horizontal convergence of residual mean advective fluxes of '//& - trim(lowercase(flux_longname)), conv_units, conversion=Tr%conv_scale) + trim(lowercase(flux_longname)), conv_units, conversion=Tr%conv_scale*US%s_to_T) if ((Tr%id_adv_xy > 0) .or. (Tr%id_adv_xy_2d > 0)) & call safe_alloc_ptr(Tr%advection_xy,isd,ied,jsd,jed,nz) @@ -478,19 +478,19 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) if (Tr%diag_form == 1) then Tr%id_dfxy_cont = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_cont_tendency', & diag%axesTL, Time, "Lateral or neutral diffusion tracer content tendency for "//trim(shortnm), & - conv_units, conversion=Tr%conv_scale, x_cell_method='sum', y_cell_method='sum', v_extensive=.true.) + conv_units, conversion=Tr%conv_scale*US%s_to_T, x_cell_method='sum', y_cell_method='sum', v_extensive=.true.) Tr%id_dfxy_cont_2d = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_cont_tendency_2d', & diag%axesT1, Time, "Depth integrated lateral or neutral diffusion tracer concentration "//& - "tendency for "//trim(shortnm), conv_units, conversion = Tr%conv_scale, & - x_cell_method = 'sum', y_cell_method = 'sum') + "tendency for "//trim(shortnm), conv_units, conversion=Tr%conv_scale*US%s_to_T, & + x_cell_method='sum', y_cell_method= 'sum') else cmor_var_lname = 'Tendency of '//trim(lowercase(cmor_longname))//& ' expressed as '//trim(lowercase(flux_longname))//& ' content due to parameterized mesoscale diffusion' Tr%id_dfxy_cont = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_cont_tendency', & diag%axesTL, Time, "Lateral or neutral diffusion tracer concentration tendency for "//trim(shortnm), & - conv_units, conversion = Tr%conv_scale, cmor_field_name = trim(Tr%cmor_tendprefix)//'pmdiff', & + conv_units, conversion=Tr%conv_scale*US%s_to_T, cmor_field_name = trim(Tr%cmor_tendprefix)//'pmdiff', & cmor_long_name = trim(cmor_var_lname), cmor_standard_name = trim(cmor_long_std(cmor_var_lname)), & x_cell_method = 'sum', y_cell_method = 'sum', v_extensive = .true.) @@ -499,13 +499,13 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) Tr%id_dfxy_cont_2d = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_cont_tendency_2d', & diag%axesT1, Time, "Depth integrated lateral or neutral diffusion tracer "//& "concentration tendency for "//trim(shortnm), conv_units, & - conversion=Tr%conv_scale, cmor_field_name=trim(Tr%cmor_tendprefix)//'pmdiff_2d', & + conversion=Tr%conv_scale*US%s_to_T, cmor_field_name=trim(Tr%cmor_tendprefix)//'pmdiff_2d', & cmor_long_name=trim(cmor_var_lname), cmor_standard_name=trim(cmor_long_std(cmor_var_lname)), & x_cell_method='sum', y_cell_method='sum') endif Tr%id_dfxy_conc = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_conc_tendency', & diag%axesTL, Time, "Lateral (neutral) tracer concentration tendency for "//trim(shortnm), & - trim(units)//' s-1') + trim(units)//' s-1', conversion=US%s_to_T) var_lname = "Net time tendency for "//lowercase(flux_longname) if (len_trim(Tr%cmor_tendprefix) == 0) then @@ -658,14 +658,14 @@ subroutine post_tracer_diagnostics(Reg, h, diag_prev, diag, G, GV, dt) work3d(i,j,k) = (Tr%t(i,j,k) - Tr%t_prev(i,j,k))*Idt tr%t_prev(i,j,k) = Tr%t(i,j,k) enddo ; enddo ; enddo - call post_data(Tr%id_tendency, work3d, diag, alt_h = diag_prev%h_state) + call post_data(Tr%id_tendency, work3d, diag, alt_h=diag_prev%h_state) endif if ((Tr%id_trxh_tendency > 0) .or. (Tr%id_trxh_tendency_2d > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie work3d(i,j,k) = (Tr%t(i,j,k)*h(i,j,k) - Tr%Trxh_prev(i,j,k)) * Idt Tr%Trxh_prev(i,j,k) = Tr%t(i,j,k) * h(i,j,k) enddo ; enddo ; enddo - if (Tr%id_trxh_tendency > 0) call post_data(Tr%id_trxh_tendency, work3d, diag, alt_h = diag_prev%h_state) + if (Tr%id_trxh_tendency > 0) call post_data(Tr%id_trxh_tendency, work3d, diag, alt_h=diag_prev%h_state) if (Tr%id_trxh_tendency_2d > 0) then work2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie @@ -697,15 +697,15 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then Tr => Reg%Tr(m) if (Tr%id_tr > 0) call post_data(Tr%id_tr, Tr%t, diag) - if (Tr%id_adx > 0) call post_data(Tr%id_adx, Tr%ad_x, diag, alt_h = h_diag) - if (Tr%id_ady > 0) call post_data(Tr%id_ady, Tr%ad_y, diag, alt_h = h_diag) - if (Tr%id_dfx > 0) call post_data(Tr%id_dfx, Tr%df_x, diag, alt_h = h_diag) - if (Tr%id_dfy > 0) call post_data(Tr%id_dfy, Tr%df_y, diag, alt_h = h_diag) + if (Tr%id_adx > 0) call post_data(Tr%id_adx, Tr%ad_x, diag, alt_h=h_diag) + if (Tr%id_ady > 0) call post_data(Tr%id_ady, Tr%ad_y, diag, alt_h=h_diag) + if (Tr%id_dfx > 0) call post_data(Tr%id_dfx, Tr%df_x, diag, alt_h=h_diag) + if (Tr%id_dfy > 0) call post_data(Tr%id_dfy, Tr%df_y, diag, alt_h=h_diag) if (Tr%id_adx_2d > 0) call post_data(Tr%id_adx_2d, Tr%ad2d_x, diag) if (Tr%id_ady_2d > 0) call post_data(Tr%id_ady_2d, Tr%ad2d_y, diag) if (Tr%id_dfx_2d > 0) call post_data(Tr%id_dfx_2d, Tr%df2d_x, diag) if (Tr%id_dfy_2d > 0) call post_data(Tr%id_dfy_2d, Tr%df2d_y, diag) - if (Tr%id_adv_xy > 0) call post_data(Tr%id_adv_xy, Tr%advection_xy, diag, alt_h = h_diag) + if (Tr%id_adv_xy > 0) call post_data(Tr%id_adv_xy, Tr%advection_xy, diag, alt_h=h_diag) if (Tr%id_adv_xy_2d > 0) then work2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 055e6af00f..546efcf0b9 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -35,11 +35,12 @@ module BFB_initialization !! This case is set up in such a way that the temperature of the topmost layer is equal to the SST at the !! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers !! and linearly interpolated for the intermediate layers. -subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) - real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. +subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) + real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at !! each interface [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the !! equation of state. @@ -50,19 +51,19 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) call get_param(param_file, mdl, "DRHO_DT", drho_dt, & "Rate of change of density with temperature.", & - units="kg m-3 K-1", default=-0.2) + units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "SST_S", SST_s, & "SST at the suothern edge of the domain.", units="C", default=20.0) call get_param(param_file, mdl, "T_BOT", T_bot, & "Bottom Temp", units="C", default=5.0) - rho_top = GV%rho0 + drho_dt*SST_s - rho_bot = GV%rho0 + drho_dt*T_bot + rho_top = GV%Rho0 + drho_dt*SST_s + rho_bot = GV%Rho0 + drho_dt*T_bot nz = GV%ke do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth / (GV%Rho0) else g_prime(k) = GV%g_Earth endif diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 558be86734..6283f07490 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -27,16 +27,16 @@ module BFB_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. + real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - real :: Flux_const !< The restoring rate at the surface [m s-1]. + real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. real :: SST_s !< SST at the southern edge of the linear forcing ramp [degC] real :: SST_n !< SST at the northern edge of the linear forcing ramp [degC] real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degLat] real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degLat] - real :: drho_dt !< Rate of change of density with temperature [kg m-3 degC-1]. + real :: drho_dt !< Rate of change of density with temperature [R degC-1 ~> kg m-3 degC-1]. !! Note that temperature is being used as a dummy variable here. !! All temperatures are converted into density. @@ -65,10 +65,11 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) real :: Temp_restore ! The temperature that is being restored toward [degC]. real :: Salin_restore ! The salinity that is being restored toward [ppt]. real :: density_restore ! The potential density that is being restored - ! toward [kg m-3]. - real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. + ! toward [R ~> kg m-3]. + real :: rhoXcp ! Reference density times heat capacity times unit scaling + ! factors [J T s-1 Z-1 m-2 degC-1 ~> J m-3 degC-1] real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -127,7 +128,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & "Temperature and salinity restoring used without modification." ) - rhoXcp = CS%Rho0 * fluxes%C_p + rhoXcp = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in ppt) that are being restored toward. @@ -137,8 +138,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & (Temp_restore - state%SST(i,j)) fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & - ((Salin_restore - state%SSS(i,j)) / & - (0.5 * (Salin_restore + state%SSS(i,j)))) + ((Salin_restore - state%SSS(i,j)) / (0.5 * (Salin_restore + state%SSS(i,j)))) enddo ; enddo else ! When modifying the code, comment out this error message. It is here @@ -147,7 +147,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) ! "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 Temp_restore = 0.0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential @@ -164,7 +164,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) density_restore = Temp_restore*CS%drho_dt + CS%Rho0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & - (density_restore - state%sfc_density(i,j)) + (density_restore - US%kg_m3_to_R*state%sfc_density(i,j)) enddo ; enddo endif endif ! end RESTOREBUOY @@ -206,22 +206,22 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LFR_SLAT", CS%lfrslat, & "Southern latitude where the linear forcing ramp begins.", & - units="degrees", default = 20.0) + units="degrees", default=20.0) call get_param(param_file, mdl, "LFR_NLAT", CS%lfrnlat, & "Northern latitude where the linear forcing ramp ends.", & - units="degrees", default = 40.0) + units="degrees", default=40.0) call get_param(param_file, mdl, "SST_S", CS%SST_s, & "SST at the southern edge of the linear forcing ramp.", & - units="C", default = 20.0) + units="C", default=20.0) call get_param(param_file, mdl, "SST_N", CS%SST_n, & "SST at the northern edge of the linear forcing ramp.", & - units="C", default = 10.0) + units="C", default=10.0) call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, & "The rate of change of density with temperature.", & - units="kg m-3 K-1", default = -0.2) + units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) @@ -234,8 +234,8 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 0a3a5e071f..cb30c09b6f 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -260,9 +260,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! The following variables are used to set the target temperature and salinity. real :: T0(SZK_(G)), S0(SZK_(G)) real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the @@ -290,7 +290,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (.not.associated(OBC)) return - g_prime_tot = (GV%g_Earth / GV%Rho0)*2.0 + g_prime_tot = (GV%g_Earth / GV%Rho0) * 2.0*US%kg_m3_to_R Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%m_to_L*Def_Rad) * GV%Z_to_H @@ -357,13 +357,13 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! target density and a salinity of 35 psu. This code is taken from ! USER_initialize_temp_sal. pres(:) = tv%P_Ref ; S0(:) = 35.0 ; T0(1) = 25.0 - call calculate_density(T0(1),S0(1),pres(1),rho_guess(1),tv%eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,tv%eqn_of_state) + call calculate_density(T0(1),S0(1),pres(1),rho_guess(1),tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,tv%eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz ; T0(k) = T0(1) + (GV%Rlay(k)-rho_guess(1)) / drho_dT(1) ; enddo do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,tv%eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,tv%eqn_of_state) + call calculate_density(T0,S0,pres,rho_guess,1,nz,tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,tv%eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 56ca631022..5fb35fa939 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -150,8 +150,9 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read ! positive upward, in depth units [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x - real :: rho_range - real :: min_thickness, s_sur, s_bot, t_sur, t_bot, rho_sur, rho_bot + real :: min_thickness, s_sur, s_bot, t_sur, t_bot + real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] + real :: rho_range ! The range of densities [R ~> kg m-3] logical :: just_read ! If true, just read parameters but set nothing. character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate @@ -183,10 +184,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read if (just_read) return ! All run-time parameters have been read, so return. ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Surface density is:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Bottom density is:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -199,7 +200,8 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range e0(k) = min( 0., e0(k) ) ! Bound by surface e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model - ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) + ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)', & + ! G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) ! call MOM_mesg(mesg,5) enddo e0(nz+1) = -G%max_depth @@ -248,20 +250,22 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read end subroutine ISOMIP_initialize_thickness !> Initial values for temperature and salinity -subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & +subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, & eqn_of_state, just_read_params) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt - real :: x, ds, dt, rho_sur, rho_bot + real :: x, ds, dt + real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: xi0, xi1 ! Heights in depth units [Z ~> m]. real :: S_sur, S_bot ! Salinity at the surface and bottom [ppt] real :: T_sur, T_bot ! Temperature at the bottom [degC] @@ -274,11 +278,13 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, logical :: just_read ! If true, just read parameters but set nothing. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. real :: T0(SZK_(G)), S0(SZK_(G)) - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. (zero here) - real :: drho_dT1, drho_dS1, T_Ref, S_Ref + real :: drho_dT1 ! A prescribed derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + real :: drho_dS1 ! A prescribed derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: T_Ref, S_Ref is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pres(:) = 0.0 @@ -295,10 +301,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, call get_param(param_file, mdl, "ISOMIP_S_BOT", s_bot, & 'Salinity at the bottom (interface)', default=34.55, do_not_log=just_read) - call calculate_density(t_sur,s_sur,0.0,rho_sur,eqn_of_state) + call calculate_density(t_sur,s_sur,0.0,rho_sur,eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Density in the surface layer:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,eqn_of_state) + call calculate_density(t_bot,s_bot,0.0,rho_bot,eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Density in the bottom layer::', rho_bot ! call MOM_mesg(mesg,5) @@ -326,10 +332,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, default=.false., do_not_log=just_read) call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & "Partial derivative of density with salinity.", & - units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="kg m-3 PSU-1", scale=US%kg_m3_to_R, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & "Partial derivative of density with temperature.", & - units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="kg m-3 K-1", scale=US%kg_m3_to_R, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_Ref, & "A reference temperature used in initialization.", & units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) @@ -356,10 +362,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! call MOM_mesg(mesg,5) enddo - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) ! call MOM_mesg(mesg,5) - call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state, scale=US%kg_m3_to_R) if (fit_salin) then ! A first guess of the layers' salinity. @@ -368,8 +374,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, enddo ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) enddo @@ -382,8 +388,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, enddo do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -405,9 +411,9 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! for debugging !i=G%iec; j=G%jec !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,eqn_of_state) + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k) - ! call MOM_mesg(mesg,5) + ! call MOM_mesg(mesg,5) !enddo end subroutine ISOMIP_initialize_temperature_salinity @@ -440,7 +446,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) real :: S_sur, T_sur ! Surface salinity and temerature in sponge real :: S_bot, T_bot ! Bottom salinity and temerature in sponge real :: t_ref, s_ref ! reference T and S - real :: rho_sur, rho_bot, rho_range + real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] + real :: rho_range ! The range of densities [R ~> kg m-3] real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually @@ -518,10 +525,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state, scale=US%kg_m3_to_R) !write (mesg,*) 'Surface density in sponge:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state, scale=US%kg_m3_to_R) !write (mesg,*) 'Bottom density in sponge:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -539,7 +546,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range e0(k) = min( 0., e0(k) ) ! Bound by surface e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model - ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) + ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',& + ! G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) ! call MOM_mesg(mesg,5) enddo e0(nz+1) = -G%max_depth @@ -601,7 +609,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! for debugging !i=G%iec; j=G%jec !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Sponge - k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k) ! call MOM_mesg(mesg,5) !enddo @@ -651,7 +659,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! for debugging !i=G%iec; j=G%jec !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& ! S(i,j,k),rho_tmp,GV%Rlay(k) ! call MOM_mesg(mesg,5) diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 730551ccdb..b4cbb32401 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -52,8 +52,8 @@ module Idealized_hurricane real :: max_windspeed !< Maximum wind speeds [m s-1] real :: hurr_translation_spd !< Hurricane translation speed [m s-1] real :: hurr_translation_dir !< Hurricane translation speed [m s-1] - real :: gustiness !< Gustiness (optional, used in u*) [m s-1] - real :: Rho0 !< A reference ocean density [kg m-3] + real :: gustiness !< Gustiness (optional, used in u*) [R L Z T-1 ~> Pa] + real :: Rho0 !< A reference ocean density [R ~> kg m-3] real :: Hurr_cen_Y0 !< The initial y position of the hurricane !! This experiment is conducted in a Cartesian !! grid and this is assumed to be in meters [m] @@ -90,15 +90,12 @@ module Idealized_hurricane contains !> Initializes wind profile for the SCM idealized hurricane example -subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) - type(time_type), & - intent(in) :: Time !< Model time - type(ocean_grid_type), & - intent(in) :: G !< Grid structure - type(param_file_type), & - intent(in) :: param_file !< Input parameter structure - type(idealized_hurricane_CS), & - pointer :: CS !< Parameter container +subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Input parameter structure + type(idealized_hurricane_CS), pointer :: CS !< Parameter container for this module real :: DP, C @@ -178,10 +175,10 @@ subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0, do_not_log=.true.) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "GUST_CONST", CS%gustiness, & "The background gustiness in the winds.", units="Pa", & - default=0.00, do_not_log=.true.) + default=0.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z, do_not_log=.true.) if (CS%BR_BENCH) then @@ -193,7 +190,6 @@ subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) CS%Holland_A = (CS%rad_max_wind)**CS%Holland_B CS%Holland_AxBxDP = CS%Holland_A*CS%Holland_B*DP - return end subroutine idealized_hurricane_wind_init !> Computes the surface wind for the idealized hurricane test cases @@ -269,9 +265,8 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) YY = LAT - YC XX = LON - XC endif - call idealized_hurricane_wind_profile(& - CS,f,YY,XX,Uocn,Vocn,TX,TY) - forces%taux(I,j) = G%mask2dCu(I,j) * TX + call idealized_hurricane_wind_profile(CS,f,YY,XX,Uocn,Vocn,TX,TY) + forces%taux(I,j) = G%mask2dCu(I,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * TX enddo enddo !> Computes tauy @@ -292,7 +287,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) XX = LON - XC endif call idealized_hurricane_wind_profile(CS, f, YY, XX, Uocn, Vocn, TX, TY) - forces%tauy(i,J) = G%mask2dCv(i,J) * TY + forces%tauy(i,J) = G%mask2dCv(i,J) * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * TY enddo enddo @@ -300,9 +295,9 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) do j=js,je do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + & + sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0)) enddo enddo @@ -433,7 +428,6 @@ subroutine idealized_hurricane_wind_profile(CS, absf, YY, XX, UOCN, VOCN, Tx, Ty TX = CS%rho_A * Cd * sqrt(du**2 + dV**2) * dU TY = CS%rho_A * Cd * sqrt(du**2 + dV**2) * dV - return end subroutine idealized_hurricane_wind_profile !> This subroutine is primarily needed as a legacy for reproducing answers. @@ -579,7 +573,8 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) else Cd = 0.0018 endif - forces%taux(I,j) = CS%rho_a * G%mask2dCu(I,j) * Cd*sqrt(du**2+dV**2)*dU + forces%taux(I,j) = CS%rho_a * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + G%mask2dCu(I,j) * Cd*sqrt(du**2+dV**2)*dU enddo ; enddo !/BR ! See notes above @@ -597,16 +592,17 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) else Cd = 0.0018 endif - forces%tauy(I,j) = CS%rho_a * G%mask2dCv(I,j) * Cd*du10*dV + forces%tauy(I,j) = CS%rho_a * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + G%mask2dCv(I,j) * Cd*du10*dV enddo ; enddo ! Set the surface friction velocity [m s-1]. ustar is always positive. do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + & + sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0)) enddo ; enddo - return + end subroutine SCM_idealized_hurricane_wind_forcing end module idealized_hurricane diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 0da6285f37..a048d85491 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1024,7 +1024,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) + call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(US%R_to_kg_m3*GV%Rho0/1.225), u10, GV, US) ! surface Stokes drift UStokes = us_to_u10*u10 ! diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index d5f2bb608b..f84a634976 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -22,8 +22,7 @@ module RGC_initialization use MOM_ALE_sponge, only : ALE_sponge_CS, set_up_ALE_sponge_field, initialize_ALE_sponge use MOM_ALE_sponge, only : set_up_ALE_sponge_vel_field -use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge -use MOM_sponge, only : set_up_sponge_ML_density +use MOM_domains, only : pass_var use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -31,10 +30,12 @@ module RGC_initialization use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_io, only : slasher +use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge +use MOM_sponge, only : set_up_sponge_ML_density +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type -use MOM_domains, only: pass_var implicit none ; private #include @@ -46,9 +47,10 @@ module RGC_initialization !> Sets up the the inverse restoration time, and the values towards which the interface heights, !! velocities and tracers should be restored within the sponges for the RGC test case. -subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) +subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and @@ -222,7 +224,7 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) do j=js,je call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state) + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) enddo call set_up_sponge_ML_density(tmp, G, CSp) diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index b991fa95bc..80b3bc6d94 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -36,9 +36,10 @@ module Rossby_front_2d_initialization contains !> Initialization of thicknesses in 2D Rossby front test -subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure +subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read_params) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -48,7 +49,8 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par integer :: i, j, k, is, ie, js, je, nz real :: Tz, Dml, eta, stretch, h0 - real :: min_thickness, T_range, dRho_dT + real :: min_thickness, T_range + real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate @@ -67,7 +69,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & units='C', default=0.0, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, do_not_log=.true.) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, scale=US%kg_m3_to_R, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -178,7 +180,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just real :: y ! Non-dimensional coordinate across channel, 0..pi real :: T_range ! Range of salinities and temperatures over the vertical real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 degC-1 ~> m s-1 degC-1] - real :: dRho_dT + real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] real :: Dml, zi, zc, zm ! Depths [Z ~> m]. real :: f ! The local Coriolis parameter [T-1 ~> s-1] real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] @@ -195,7 +197,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & units='C', default=0.0, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, do_not_log=.true.) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, scale=US%kg_m3_to_R, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 48c4dc229d..960abd49ca 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -131,8 +131,12 @@ subroutine SCM_CVMix_tests_surface_forcing_init(Time, G, param_file, CS) type(param_file_type), intent(in) :: param_file !< Input parameter structure type(SCM_CVMix_tests_CS), pointer :: CS !< Parameter container -! This include declares and sets the variable "version". -#include "version_variable.h" + + ! This include declares and sets the variable "version". +# include "version_variable.h" + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type + + US => G%US if (associated(CS)) then call MOM_error(FATAL, "SCM_CVMix_tests_surface_forcing_init called with an associated "// & @@ -163,11 +167,11 @@ subroutine SCM_CVMix_tests_surface_forcing_init(Time, G, param_file, CS) call get_param(param_file, mdl, "SCM_TAU_X", & CS%tau_x, "Constant X-dir wind stress "// & "used in the SCM CVMix test surface forcing.", & - units='N/m2', fail_if_missing=.true.) + units='N/m2', scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z, fail_if_missing=.true.) call get_param(param_file, mdl, "SCM_TAU_Y", & CS%tau_y, "Constant y-dir wind stress "// & "used in the SCM CVMix test surface forcing.", & - units='N/m2', fail_if_missing=.true.) + units='N/m2', scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z, fail_if_missing=.true.) endif if (CS%UseHeatFlux) then call get_param(param_file, mdl, "SCM_HEAT_FLUX", & @@ -215,20 +219,20 @@ subroutine SCM_CVMix_tests_wind_forcing(state, forces, day, G, US, CS) enddo ; enddo call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) - mag_tau = sqrt(CS%tau_x*CS%tau_x + CS%tau_y*CS%tau_y) if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( mag_tau / CS%Rho0 ) + forces%ustar(i,j) = sqrt( US%L_to_Z * mag_tau / (US%kg_m3_to_R*CS%Rho0) ) enddo ; enddo ; endif end subroutine SCM_CVMix_tests_wind_forcing -subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, CS) +subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, US, CS) type(surface), intent(in) :: state !< Surface state structure type(forcing), intent(inout) :: fluxes !< Surface fluxes structure type(time_type), intent(in) :: day !< Current model time type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(SCM_CVMix_tests_CS), pointer :: CS !< Container for SCM parameters ! Local variables @@ -256,9 +260,9 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, CS) if (CS%UseEvaporation) then do J=Jsq,Jeq ; do i=is,ie ! Note CVMix test inputs give evaporation in [m s-1] - ! This therefore must be converted to mass flux - ! by multiplying by density - fluxes%evap(i,J) = CS%surf_evap * CS%Rho0 + ! This therefore must be converted to mass flux in [R Z T-1 ~> kg m-2 s-1] + ! by multiplying by density and some unit conversion factors. + fluxes%evap(i,J) = CS%surf_evap * US%kg_m3_to_R*US%m_to_Z*US%T_to_s * CS%Rho0 enddo ; enddo endif diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 28033d8799..bb4102f215 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -47,10 +47,14 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref - real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS + real :: dRho_dS ! The partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. + real :: x, y, yy + real :: delta_S_strat, dSdz, delta_S, S_ref + real :: min_thickness, adjustment_width, adjustment_delta + real :: adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym - real :: target_values(SZK_(G)+1) + real :: target_values(SZK_(G)+1) ! Target densities or density anomalies [R ~> kg m-3] logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate ! This include declares and sets the variable "version". @@ -107,6 +111,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) + dRho_dS = 1.0 * US%kg_m3_to_R if (delta_S_strat /= 0.) then ! This was previously coded ambiguously. adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth @@ -119,12 +124,12 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read e0(k) = -G%max_depth * (real(k-1) / real(nz)) enddo endif - target_values(1) = GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(2)) - target_values(nz+1) = GV%Rlay(nz) + 0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) + target_values(1) = ( GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(2)) ) + target_values(nz+1) = ( GV%Rlay(nz) + 0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) ) do k = 2,nz target_values(k) = target_values(k-1) + ( GV%Rlay(nz) - GV%Rlay(1) ) / (nz-1) enddo - target_values(:) = target_values(:) - 1000. + target_values(:) = target_values(:) - 1000.*US%kg_m3_to_R do j=js,je ; do i=is,ie if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -140,8 +145,8 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read x = x * acos( 0. ) delta_S = adjustment_deltaS * 0.5 * (1. - sin( x ) ) do k=2,nz - if (dSdz /= 0.) then - eta1D(k) = ( target_values(k) - ( S_ref + delta_S ) ) / dSdz + if (dRho_dS*dSdz /= 0.) then + eta1D(k) = ( target_values(k) - dRho_dS*( S_ref + delta_S ) ) / (dRho_dS*dSdz) else eta1D(k) = e0(k) - (0.5*adjustment_delta) * sin( x ) endif diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 859a878446..3478415c60 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -108,13 +108,17 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state real :: T_int ! The initial temperature of an interface [degC]. real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units [Z ~> m]. - real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS - real :: a_exp ! The fraction of the overall stratification that is exponential. + real, dimension(SZK_(GV)) :: & + T0, pres, S0, & ! drho + rho_guess, & ! Potential density at T0 & S0 [R ~> kg m-3]. + drho_dT, & ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + drho_dS ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: a_exp ! The fraction of the overall stratification that is exponential. real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. - real :: T_frac ! A ratio of the interface temperature to the range - ! between SST and the bottom temperature. + real :: T_frac ! A ratio of the interface temperature to the range + ! between SST and the bottom temperature. real :: err, derr_dz ! The error between the profile's temperature and the - ! interface temperature for a given z and its derivative. + ! interface temperature for a given z and its derivative. real :: pi, z logical :: just_read ! This include declares and sets the variable "version". @@ -147,8 +151,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state pres(k) = P_Ref ; S0(k) = 35.0 enddo T0(k1) = 29.0 - call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state) + call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, scale=US%kg_m3_to_R) ! A first guess of the layers' temperatures. do k=1,nz @@ -157,8 +161,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -208,7 +212,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state end subroutine benchmark_initialize_thickness !> Initializes layer temperatures and salinities for benchmark -subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & +subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & eqn_of_state, P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -216,6 +220,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & !! that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being !! initialized. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. @@ -228,9 +233,9 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & ! Local variables real :: T0(SZK_(G)), S0(SZK_(G)) real :: pres(SZK_(G)) ! Reference pressure [kg m-3]. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: SST ! The initial sea surface temperature [degC]. real :: lat @@ -251,8 +256,8 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & enddo T0(k1) = 29.0 - call calculate_density(T0(k1),S0(k1),pres(k1),rho_guess(k1),eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,k1,1,eqn_of_state) + call calculate_density(T0(k1),S0(k1),pres(k1),rho_guess(k1),eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,k1,1,eqn_of_state, scale=US%kg_m3_to_R) ! A first guess of the layers' temperatures. ! do k=1,nz @@ -261,8 +266,8 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & ! Refine the guesses for each layer. ! do itt = 1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index d8b3ad269b..d6d6dea11a 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -27,9 +27,9 @@ module dumbbell_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as !! state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. + real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - real :: Flux_const !< The restoring rate at the surface [m s-1]. + real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. real :: slp_amplitude !< The amplitude of pressure loading [Pa] applied @@ -47,7 +47,7 @@ module dumbbell_surface_forcing contains !> Surface buoyancy (heat and fresh water) fluxes for the dumbbell test case -subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) +subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any @@ -57,6 +57,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(dumbbell_surface_forcing_CS), pointer :: CS !< A control structure returned by a previous !! call to dumbbell_surface_forcing_init ! Local variables @@ -124,8 +125,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! density [kg m-3] that is being restored toward. if (CS%forcing_mask(i,j)>0.) then fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & - ((CS%S_restore(i,j) - state%SSS(i,j)) / & - (0.5 * (CS%S_restore(i,j) + state%SSS(i,j)))) + ((CS%S_restore(i,j) - state%SSS(i,j)) / (0.5 * (CS%S_restore(i,j) + state%SSS(i,j)))) endif enddo ; enddo @@ -214,7 +214,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DUMBBELL_SLP_AMP", CS%slp_amplitude, & "Amplitude of SLP forcing in reservoirs.", & units="kg m2 s-1", default = 10000.0) @@ -238,8 +238,8 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) + "velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 64f4f84247..7db78f2454 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -37,12 +37,13 @@ module user_initialization contains !> Set vertical coordinates. -subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) +subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. - real, dimension(:), intent(out) :: Rlay !< Layer potential density. + real, dimension(:), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at !! each interface [L2 Z-1 T-2 ~> m s-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -249,7 +250,7 @@ end subroutine write_user_log !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter [T-1 ~> s-1]. !! - GV%g_prime - The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. -!! - GV%Rlay - Layer potential density (coordinate variable) [kg m-3]. +!! - GV%Rlay - Layer potential density (coordinate variable) [R ~> kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature [degC]. !! - S - Salinity [psu].