diff --git a/.testing/Makefile b/.testing/Makefile index bd0cbc4c0a..f330c92e3b 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -146,6 +146,7 @@ endif # These are set to true by our Travis configuration if testing a pull request DO_REGRESSION_TESTS ?= REPORT_COVERAGE ?= +CODECOV_UPLOADER_URL ?= https://uploader.codecov.io/latest/linux/codecov ifeq ($(DO_REGRESSION_TESTS), true) BUILDS += target @@ -165,6 +166,7 @@ else endif + # List of source files to link this Makefile's dependencies to model Makefiles # Assumes a depth of two, and the following extensions: F90 inc c h # (1): Root directory @@ -542,6 +544,7 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # $(4): MOM_override configuration # $(5): Environment variables # $(6): Number of MPI ranks + define STAT_RULE work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo "Running test $$*.$(1)..." @@ -570,10 +573,13 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo -e "$(DONE): $$*.$(1); no runtime errors." if [ $(3) ]; then \ mkdir -p results/$$* ; \ - cd build/symmetric \ - && bash <(curl -s https://codecov.io/bash) -Z -n $$@ \ - > codecov.$$*.$(1).out \ - 2> codecov.$$*.$(1).err \ + cd build/symmetric ; \ + gcov *.gcda > gcov.$$*.$(1).out ; \ + curl -s $(CODECOV_UPLOADER_URL) -o codecov ; \ + chmod +x codecov ; \ + ./codecov -Z -f "*.gcov" -n $$@ \ + > codecov.$$*.$(1).out \ + 2> codecov.$$*.$(1).err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}"; \ fi endef diff --git a/README.md b/README.md index dfbfafc7d0..46774baaf0 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,5 @@ -[![Build Status](https://travis-ci.org/NOAA-GFDL/MOM6.svg?branch=dev/master)](https://travis-ci.org/NOAA-GFDL/MOM6) [![Read The Docs Status](https://readthedocs.org/projects/mom6/badge/?badge=latest)](http://mom6.readthedocs.io/) -[![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev%2Fmaster/graph/badge.svg)](https://codecov.io/gh/NOAA-GFDL/MOM6) +[![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev/gfdl/graph/badge.svg?token=uF8SVydCdp)](https://codecov.io/gh/NOAA-GFDL/MOM6) # MOM6 diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 6479549eb7..acbbc292de 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -65,8 +65,8 @@ module MOM_surface_forcing_gfdl 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] + real :: latent_heat_fusion !< Latent heat of fusion [Q ~> J kg-1] + real :: latent_heat_vapor !< Latent heat of vaporization [Q ~> J kg-1] real :: max_p_surf !< The maximum surface pressure that can be exerted by !! the atmosphere and floating sea-ice [R L2 T-2 ~> Pa]. @@ -113,6 +113,8 @@ module MOM_surface_forcing_gfdl real :: Flux_const !< Piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_salt !< Piston velocity for surface salt restoring [Z T-1 ~> m s-1] real :: Flux_const_temp !< Piston velocity for surface temp restoring [Z T-1 ~> m s-1] + logical :: trestore_SPEAR_ECDA !< If true, modify restoring data wrt local SSS + real :: SPEAR_dTf_dS !< The derivative of the freezing temperature with salinity. 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 @@ -231,8 +233,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value [ppt] SSS_mean, & ! A (mean?) salinity about which to normalize local salinity ! anomalies when calculating restorative precipitation anomalies [ppt] - PmE_adj, & ! The adjustment to PminusE that will cause the salinity - ! to be restored toward its target value [kg m-1 s-1] net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] net_FW2, & ! The net freshwater flux into the ocean [kg m-2 s-1] work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] @@ -246,7 +246,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, real :: delta_sst ! temporary storage for sst diff from restoring value [degC] real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling - ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1] real :: rhoXcp ! Reference density times heat capacity times unit scaling ! factors [Q R 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. @@ -264,7 +264,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, kg_m2_s_conversion = US%kg_m2s_to_RZ_T if (CS%restore_temp) rhoXcp = CS%Rho0 * fluxes%C_p open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 fluxes%vPrecGlobalScl = 0.0 fluxes%saltFluxGlobalAdj = 0.0 @@ -349,7 +348,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + if (sfc_state%SST(i,j) <= CS%SPEAR_dTf_dS*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 enddo ; enddo endif if (CS%salt_restore_as_sflux) then @@ -403,11 +402,19 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! SST restoring logic if (CS%restore_temp) then call time_interp_external(CS%id_trestore, Time, data_restore) + if ( CS%trestore_SPEAR_ECDA ) then + do j=js,je ; do i=is,ie + if (abs(data_restore(i,j)+1.8)<0.0001) then + data_restore(i,j) = CS%SPEAR_dTf_dS*sfc_state%SSS(i,j) + endif + enddo ; enddo + endif + do j=js,je ; do i=is,ie 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) * & - rhoXcp * delta_sst * CS%Flux_const_temp ! W m-2 + rhoXcp * delta_sst * CS%Flux_const_temp ! [Q R Z T-1 ~> W m-2] enddo ; enddo endif @@ -490,19 +497,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - & - IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_fusion endif if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - & - IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*kg_m2_s_conversion * & + CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - & - IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) @@ -573,8 +578,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, !#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo -!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, US%s_to_T*valid_time, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged @@ -601,7 +606,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, 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) + US%kg_m2s_to_RZ_T * & + 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 @@ -663,14 +668,16 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points [L4 Z-1 T-1 ~> m3 s-1] - net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. + net_mass_src, & ! A temporary of net mass sources [R Z T-1 ~> kg m-2 s-1]. ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. real :: I_GEarth ! The inverse of the gravitational acceleration [T2 Z L-2 ~> s2 m-1] real :: Kv_rho_ice ! (CS%Kv_sea_ice / CS%density_sea_ice) [L4 Z-2 T-1 R-1 ~> m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [R Z ~> kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [R Z ~> kg m-2] - real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. + real :: wt1, wt2 ! Relative weights of previous and current values of ustar [nondim]. + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer @@ -687,6 +694,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd + kg_m2_s_conversion = US%kg_m2s_to_RZ_T + ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then @@ -779,15 +788,15 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then if (associated(IOB%lprec)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%lprec(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%lprec(i-i0,j-j0) if (associated(IOB%fprec)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%fprec(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) if (associated(IOB%runoff)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%runoff(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%runoff(i-i0,j-j0) if (associated(IOB%calving)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%calving(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%calving(i-i0,j-j0) if (associated(IOB%q_flux)) & - net_mass_src(i,j) = net_mass_src(i,j) - IOB%q_flux(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) - kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) endif ; enddo ; enddo if (wt1 <= 0.0) then do j=js,je ; do i=is,ie @@ -891,9 +900,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ! Local variables 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(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses [R Z L T-2 ~> Pa] at u 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)) :: taux_in_B ! Zonal wind stresses [R Z L T-2 ~> 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 [R Z L T-2 ~> Pa] @@ -1109,7 +1118,8 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - real, dimension(G%isc:G%iec,G%jsc:G%jec) :: temp_at_h ! Various fluxes at h points [W m-2] or [kg m-2 s-1] + real, dimension(G%isc:G%iec,G%jsc:G%jec) :: temp_at_h ! Various fluxes at h points + ! [Q R Z T-1 ~> W m-2] or [R Z T-1 ~> kg m-2 s-1] integer :: isc, iec, jsc, jec, i, j logical :: overrode_h @@ -1120,7 +1130,7 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) scale=US%W_m2_to_QRZ_T) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j) * G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) @@ -1168,8 +1178,8 @@ subroutine apply_force_adjustments(G, US, CS, Time, forces) tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged overrode_x = .false. ; overrode_y = .false. - call data_override(G%Domain, 'taux_adj', tempx_at_h, Time, override=overrode_x, scale=Pa_conversion) - call data_override(G%Domain, 'tauy_adj', tempy_at_h, Time, override=overrode_y, scale=Pa_conversion) + call data_override(G%Domain, 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x, scale=Pa_conversion) + call data_override(G%Domain, 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y, scale=Pa_conversion) if (overrode_x .or. overrode_y) then if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& @@ -1283,9 +1293,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & - "The latent heat of fusion.", units="J/kg", default=hlf) + "The latent heat of fusion.", units="J/kg", default=hlf, scale=US%J_kg_to_Q) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & - "The latent heat of fusion.", units="J/kg", default=hlv) + "The latent heat of fusion.", units="J/kg", default=hlv, scale=US%J_kg_to_Q) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & "The maximum surface pressure that can be exerted by the "//& "atmosphere and floating sea-ice or ice shelves. This is "//& @@ -1373,12 +1383,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s,unscaled=unscaled_fluxconst) + default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s, unscaled=unscaled_fluxconst) call get_param(param_file, mdl, "FLUXCONST_SALT", CS%Flux_const_salt, & "The constant that relates the restoring surface salt fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & fail_if_missing=.false.,default=unscaled_fluxconst, units="m day-1", scale=US%m_to_Z*US%T_to_s) - ! Convert CS%Flux_const from m day-1 to m s-1. + ! Finish converting CS%Flux_const from m day-1 to [Z T-1 ~> m s-1]. CS%Flux_const = CS%Flux_const / 86400.0 CS%Flux_const_salt = CS%Flux_const_salt / 86400.0 call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1448,12 +1458,22 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) + call get_param(param_file, mdl, "SPEAR_ECDA_SST_RESTORE_TFREEZE", CS%trestore_SPEAR_ECDA, & + "If true, modify SST restoring field using SSS state. This only modifies the "//& + "restoring data that is within 0.0001degC of -1.8degC.", default=.false.) + else + CS%trestore_SPEAR_ECDA = .false. ! Needed to toggle logging of SPEAR_DTFREEZE_DS endif - -! Optionally read tidal amplitude from input file [m s-1] on model grid. -! Otherwise use default tidal amplitude for bottom frictionally-generated -! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of -! work done against tides globally using OSU tidal amplitude. + call get_param(param_file, mdl, "SPEAR_DTFREEZE_DS", CS%SPEAR_dTf_dS, & + "The derivative of the freezing temperature with salinity.", & + units="deg C PSU-1", default=-0.054, do_not_log=.not.CS%trestore_SPEAR_ECDA) + + ! Optionally read tidal amplitude from input file [Z T-1 ~> m s-1] on model grid. + ! Otherwise use default tidal amplitude for bottom frictionally-generated + ! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of + ! work done against tides globally using OSU tidal amplitude. + ! Note that the slightly unusual length scaling is deliberate, because the tidal + ! amplitudes are used to set the friction velocity. call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) @@ -1599,7 +1619,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) endif endif -!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, US, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1624,7 +1644,7 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end -!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type +!> Write out a set of messages with checksums of the fields in an ice_ocean_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) character(len=*), intent(in) :: id !< An identifying string for this call diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 50ea6c943d..97fb869ad4 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -86,7 +86,7 @@ module ocean_model_mod !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence -!! the persistnce of things like the cutsy element name "avg_kount". +!! the persistence of things like the cutesy element name "avg_kount". type, public :: ocean_public_type type(domain2d) :: Domain !< The domain for the surface fields. logical :: is_ocean_pe !< .true. on processors that run the ocean model. @@ -110,8 +110,8 @@ module ocean_model_mod !! a global max across ocean and non-ocean processors can be !! used to determine its value. real, pointer, dimension(:,:) :: & - t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) - s_surf => NULL(), & !< SSS on t-cell (psu) + t_surf => NULL(), & !< SST on t-cell [degrees Kelvin] + s_surf => NULL(), & !< SSS on t-cell [ppt] u_surf => NULL(), & !< i-velocity at the locations indicated by stagger [m s-1]. v_surf => NULL(), & !< j-velocity at the locations indicated by stagger [m s-1]. sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, @@ -154,8 +154,8 @@ module ocean_model_mod logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the !! ocean dynamics and forcing fluxes. - real :: press_to_z !< A conversion factor between pressure and ocean - !! depth in m, usually 1/(rho_0*g) [m Pa-1]. + real :: press_to_z !< A conversion factor between pressure and ocean depth, + !! usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1]. real :: C_p !< The heat capacity of seawater [J degC-1 kg-1]. logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode !! with the barotropic and baroclinic dynamics, thermodynamics, @@ -221,7 +221,7 @@ module ocean_model_mod !! for restarts and reading restart files if appropriate. !! !! This subroutine initializes both the ocean state and the ocean surface type. -!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! Because of the way that indices and domains are handled, Ocean_sfc must have !! been used in a previous call to initialize_ocean_type. subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas_fields_ocn) type(ocean_public_type), target, & @@ -242,16 +242,16 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. ! Local variables - real :: Rho0 ! The Boussinesq ocean density [kg m-3]. - real :: G_Earth ! The gravitational acceleration [m s-2]. - real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. + real :: Rho0 ! The Boussinesq ocean density [R ~> kg m-3] + real :: G_Earth ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] + real :: HFrz !< If HFrz > 0 [Z ~> m], melt potential will be computed. !! The actual depth over which melt potential is computed will !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot!< If true, allocate melt_potential array + logical :: use_melt_pot !< If true, allocate melt_potential array -! 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 = "ocean_model_init" ! This module's name. character(len=48) :: stagger ! A string indicating the staggering locations for the ! surface velocities returned to the coupler. @@ -331,10 +331,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas "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=OS%US%kg_m3_to_R) call get_param(param_file, mdl, "G_EARTH", G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default=9.80, scale=OS%US%m_s_to_L_T**2*OS%US%Z_to_m) call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) @@ -342,7 +342,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - OS%press_to_z = 1.0/(Rho0*G_Earth) + OS%press_to_z = 1.0 / (Rho0*G_Earth) ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. @@ -350,9 +350,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas "If HFREEZE > 0, melt potential will be computed. The actual depth "//& "over which melt potential is computed will be min(HFREEZE, OBLD), "//& "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//& - "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + "melt potential will not be computed.", & + units="m", default=-1.0, scale=OS%US%m_to_Z, do_not_log=.true.) - if (HFrz .gt. 0.0) then + if (HFrz > 0.0) then use_melt_pot=.true. else use_melt_pot=.false. @@ -655,7 +656,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & -! Ice_ocean_boundary%p, OS%press_to_z) +! OS%fluxes%p_surf_full, OS%press_to_z) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn call coupler_type_send_data(Ocean_sfc%fields, Time1) @@ -766,7 +767,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, gas_field !! tracer fluxes. integer :: xsz, ysz, layout(2) - ! ice-ocean-boundary fields are always allocated using absolute indicies + ! ice-ocean-boundary fields are always allocated using absolute indices ! and have no halos. integer :: isc, iec, jsc, jec @@ -806,7 +807,7 @@ end subroutine initialize_ocean_public_type !! surface state variable. This may eventually be folded into the MOM !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no -!! halo points in its arrays and always uses absolute indicies. +!! halo points in its arrays and always uses absolute indices. subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -816,9 +817,9 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [Pa]. - real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and - !! ocean depth in m, usually 1/(rho_0*g) [m Pa-1]. + real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [R L2 T-2 ~> Pa] + real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and ocean + !! depth, usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1] ! Local variables real :: IgR0 character(len=48) :: val_str @@ -860,7 +861,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%sea_lev(i,j) = US%Z_to_m * sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z + Ocean_sfc%sea_lev(i,j) = US%Z_to_m * (sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z) Ocean_sfc%area(i,j) = US%L_to_m**2 * G%areaT(i+i0,j+j0) enddo ; enddo else @@ -946,7 +947,7 @@ end subroutine ocean_model_init_sfc !> ocean_model_flux_init is used to initialize properties of the air-sea fluxes !! as determined by various run-time parameters. It can be called from -!! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely +!! non-ocean PEs, or PEs that have not yet been initialized, and it can safely !! be called multiple times. subroutine ocean_model_flux_init(OS, verbosity) type(ocean_state_type), optional, pointer :: OS !< An optional pointer to the ocean state, diff --git a/config_src/drivers/mct_cap/ocn_comp_mct.F90 b/config_src/drivers/mct_cap/ocn_comp_mct.F90 index 1872fff335..2f7deaa716 100644 --- a/config_src/drivers/mct_cap/ocn_comp_mct.F90 +++ b/config_src/drivers/mct_cap/ocn_comp_mct.F90 @@ -722,7 +722,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 + L2_to_rad2 = 1.0 / grid%Rad_Earth_L**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 652f9e5b47..174a659f12 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -1112,7 +1112,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) k = k + 1 ! Increment position within gindex if (mask(k) /= 0) then mesh_areas(k) = dataPtr_mesh_areas(k) - model_areas(k) = ocean_grid%US%L_to_m**2 * ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth**2 + model_areas(k) = ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth_L**2 mod2med_areacor(k) = model_areas(k) / mesh_areas(k) med2mod_areacor(k) = mesh_areas(k) / model_areas(k) end if diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 index 7c778d9753..300c736802 100644 --- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 @@ -31,7 +31,7 @@ module MESO_surface_forcing real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [Pa]. + !! that contributes to ustar [R L Z T-1 ~> Pa] real, dimension(:,:), pointer :: & T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward [degC]. S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward [ppt] @@ -61,7 +61,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by @@ -138,7 +138,7 @@ subroutine MESO_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) = CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) @@ -215,8 +215,8 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MESO_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 7dfce01f68..1b88f1ce36 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -96,8 +96,6 @@ program MOM_main ! This is .true. if incremental restart files may be saved. logical :: permit_incr_restart = .true. - integer :: ns - ! nmax is the number of iterations after which to stop so that the ! simulation does not exceed its CPU time limit. nmax is determined by ! evaluating the CPU time used between successive calls to write_cputime. @@ -120,6 +118,7 @@ program MOM_main type(time_type) :: Time_end ! End time for the segment or experiment. type(time_type) :: restart_time ! The next time to write restart files. type(time_type) :: Time_step_ocean ! A time_type version of dt_forcing. + logical :: segment_start_time_set ! True if segment_start_time has been set to a valid value. real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. logical :: elapsed_time_master ! If true, elapsed time is used to set the @@ -136,9 +135,9 @@ program MOM_main ! chosen so that dt_forcing is an integer multiple of dt_dyn. real :: dtdia ! The diabatic timestep [s] real :: t_elapsed_seg ! The elapsed time in this run segment [s] - integer :: n, n_max, nts, n_last_thermo + integer :: n, ns, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call - type(time_type) :: Time2, time_chg + type(time_type) :: Time2, time_chg ! Temporary time variables integer :: Restart_control ! An integer that is bit-tested to determine whether ! incremental restart files are saved and whether they @@ -152,23 +151,13 @@ program MOM_main type(time_type) :: daymax ! The final day of the simulation. integer :: CPU_steps ! The number of steps between writing CPU time. - integer :: date_init(6)=0 ! The start date of the whole simulation. - integer :: date(6)=-1 ! Possibly the start date of this run segment. - integer :: years=0, months=0, days=0 ! These may determine the segment run - integer :: hours=0, minutes=0, seconds=0 ! length, if read from a namelist. - integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. + integer :: date(6) ! Possibly the start date of this run segment. type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. - character(len=9) :: month - character(len=16) :: calendar = 'julian' - integer :: calendar_type=-1 - integer :: unit, io_status, ierr - integer :: ensemble_size, nPEs_per, ensemble_info(6) + integer :: calendar_type=-1 ! A coded integer indicating the calendar type. - integer, dimension(0) :: atm_PElist, land_PElist, ice_PElist - integer, dimension(:), allocatable :: ocean_PElist - logical :: unit_in_use + integer :: unit, io_status, ierr integer :: initClock, mainClock, termClock logical :: debug ! If true, write verbose checksums for debugging purposes. @@ -180,7 +169,8 @@ program MOM_main ! and diffusion equation are read in from files stored from ! a previous integration of the prognostic model - type(MOM_control_struct) :: MOM_CSp !> MOM control structure + type(MOM_control_struct) :: MOM_CSp !< The control structure with all the MOM6 internal types, + !! parameters and variables type(tracer_flow_control_CS), pointer :: & tracer_flow_CSp => NULL() !< A pointer to the tracer flow control structure type(surface_forcing_CS), pointer :: surface_forcing_CSp => NULL() @@ -195,14 +185,18 @@ program MOM_main !----------------------------------------------------------------------- character(len=4), parameter :: vers_num = 'v2.0' -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mod_name = "MOM_main (MOM_driver)" ! This module's name. + ! These are the variables that might be read via the namelist capability. + integer :: date_init(6)=0 ! The start date of the whole simulation. + character(len=16) :: calendar = 'julian' ! The name of the calendar type. + integer :: years=0, months=0, days=0 ! These may determine the segment run + integer :: hours=0, minutes=0, seconds=0 ! length, if read from a namelist. integer :: ocean_nthreads = 1 logical :: use_hyper_thread = .false. - integer :: omp_get_num_threads,omp_get_thread_num - namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds,& + namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds, & ocean_nthreads, use_hyper_thread !===================================================================== @@ -213,18 +207,8 @@ program MOM_main !allocate(forces,fluxes,sfc_state) - ! Initialize the ensemble manager. If there are no settings for ensemble_size - ! in input.nml(ensemble.nml), these should not do anything. In coupled - ! configurations, this all occurs in the external driver. - call ensemble_manager_init() ; ensemble_info(:) = get_ensemble_size() - ensemble_size=ensemble_info(1) ; nPEs_per=ensemble_info(2) - if (ensemble_size > 1) then ! There are multiple ensemble members. - allocate(ocean_pelist(nPEs_per)) - call ensemble_pelist_setup(.true., 0, nPEs_per, 0, 0, atm_pelist, ocean_pelist, & - land_pelist, ice_pelist) - call Set_PElist(ocean_pelist) - deallocate(ocean_pelist) - endif + ! Initialize the ensemble manager based on settings in input.nml(ensemble.nml). + call initialize_ocean_only_ensembles() ! These clocks are on the global pelist. initClock = cpu_clock_id( 'Initialization' ) @@ -241,9 +225,7 @@ program MOM_main read(unit, ocean_solo_nml, iostat=io_status) call close_file(unit) ierr = check_nml_error(io_status,'ocean_solo_nml') - if (years+months+days+hours+minutes+seconds > 0) then - if (is_root_pe()) write(*,ocean_solo_nml) - endif + if (is_root_pe() .and. (years+months+days+hours+minutes+seconds > 0)) write(*,ocean_solo_nml) endif ! This call sets the number and affinity of threads with openMP. @@ -253,13 +235,22 @@ program MOM_main ! The contents of dirs will be reread in initialize_MOM. call get_MOM_input(dirs=dirs) + segment_start_time_set = .false. ! Read ocean_solo restart, which can override settings from the namelist. if (file_exists(trim(dirs%restart_input_dir)//'ocean_solo.res')) then + date(:) = -1 call open_ASCII_file(unit, trim(dirs%restart_input_dir)//'ocean_solo.res', action=READONLY_FILE) read(unit,*) calendar_type read(unit,*) date_init read(unit,*) date call close_file(unit) + + call set_calendar_type(calendar_type) + if (sum(date) >= 0) then + ! In this case, the segment starts at a time fixed by ocean_solo.res + segment_start_time = set_date(date(1), date(2), date(3), date(4), date(5), date(6)) + segment_start_time_set = .true. + endif else calendar = uppercase(calendar) if (calendar(1:6) == 'JULIAN') then ; calendar_type = JULIAN @@ -272,8 +263,8 @@ program MOM_main else call MOM_error(FATAL,'MOM_driver: No namelist value for calendar') endif + call set_calendar_type(calendar_type) endif - call set_calendar_type(calendar_type) if (sum(date_init) > 0) then @@ -285,23 +276,18 @@ program MOM_main call time_interp_external_init() - if (sum(date) >= 0) then - ! In this case, the segment starts at a time fixed by ocean_solo.res - segment_start_time = set_date(date(1), date(2), date(3), date(4), date(5), date(6)) - Time = segment_start_time - else - ! In this case, the segment starts at a time read from the MOM restart file - ! or left as Start_time by MOM_initialize. - Time = Start_time - endif - ! Call initialize MOM with an optional Ice Shelf CS which, if present triggers ! initialization of ice shelf parameters and arrays. - if (sum(date) >= 0) then + if (segment_start_time_set) then + ! In this case, the segment starts at a time fixed by ocean_solo.res + Time = segment_start_time call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & segment_start_time, offline_tracer_mode=offline_tracer_mode, & diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp) else + ! In this case, the segment starts at a time read from the MOM restart file + ! or is left at Start_time by MOM_initialize. + Time = Start_time call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, & tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp) @@ -328,7 +314,7 @@ program MOM_main call callTree_waypoint("done surface_forcing_init") - call get_param(param_file,mod_name, "USE_WAVES", Use_Waves, & + call get_param(param_file, mod_name, "USE_WAVES", Use_Waves, & "If true, enables surface wave modules.",default=.false.) ! MOM_wave_interface_init is called regardless of the value of USE_WAVES because ! it also initializes statistical waves. @@ -346,7 +332,8 @@ program MOM_main "The default value is given by DT.", units="s", default=dt) if (offline_tracer_mode) then call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & - "Time step for the offline time step") + "Length of time between reading in of input fields", & + units='s', fail_if_missing=.true.) dt = dt_forcing endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) @@ -432,16 +419,7 @@ program MOM_main call diag_mediator_close_registration(diag) ! Write out a time stamp file. - if (is_root_pe() .and. (calendar_type /= NO_CALENDAR)) then - call open_ASCII_file(unit, 'time_stamp.out', action=APPEND_FILE) - call get_date(Time, date(1), date(2), date(3), date(4), date(5), date(6)) - month = month_name(date(2)) - write(unit,'(6i4,2x,a3)') date, month(1:3) - call get_date(Time_end, date(1), date(2), date(3), date(4), date(5), date(6)) - month = month_name(date(2)) - write(unit,'(6i4,2x,a3)') date, month(1:3) - call close_file(unit) - endif + if (is_root_pe() .and. (calendar_type /= NO_CALENDAR)) call write_time_stamp_file(Time) if (cpu_steps > 0) call write_cputime(Time, 0, write_CPU_CSp) @@ -616,34 +594,19 @@ program MOM_main call save_restart(dirs%restart_output_dir, Time, grid, restart_CSp, GV=GV) if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, & dirs%restart_output_dir) - ! Write ocean solo restart file. - if (is_root_pe()) then - call open_ASCII_file(unit, trim(dirs%restart_output_dir)//'ocean_solo.res') - write(unit, '(i6,8x,a)') calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - call get_date(Start_time, yr, mon, day, hr, mins, sec) - write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & - 'Model start time: year, month, day, hour, minute, second' - call get_date(Time, yr, mon, day, hr, mins, sec) - write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & - 'Current model time: year, month, day, hour, minute, second' - call close_file(unit) - endif + ! Write the ocean solo restart file. + call write_ocean_solo_res(Time, Start_time, calendar_type, & + trim(dirs%restart_output_dir)//'ocean_solo.res') endif if (is_root_pe()) then - do unit=10,1967 - INQUIRE(unit,OPENED=unit_in_use) - if (.not.unit_in_use) exit - enddo - open(unit,FILE="exitcode",FORM="FORMATTED",STATUS="REPLACE",action="WRITE") + call open_ASCII_file(unit, "exitcode") if (Time < daymax) then write(unit,*) 9 else write(unit,*) 0 endif - close(unit) + call close_file(unit) endif call callTree_waypoint("End MOM_main") @@ -656,4 +619,72 @@ program MOM_main call MOM_end(MOM_CSp) +contains + +!> Write out the ocean solo restart file to the indicated path. +subroutine write_ocean_solo_res(Time, Start_time, calendar, file_path) + type(time_type), intent(in) :: Time !< The current model time. + type(time_type), intent(in) :: Start_Time !< The start time of the simulation. + integer, intent(in) :: calendar !< A coded integer indicating the calendar type. + character(len=*), intent(in) :: file_path !< The full path and name of the restart file + + ! Local variables + integer :: unit + integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. + + if (.not.is_root_pe()) return + + call open_ASCII_file(unit, trim(file_path)) + write(unit, '(i6,8x,a)') calendar, & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + + call get_date(Start_time, yr, mon, day, hr, mins, sec) + write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & + 'Model start time: year, month, day, hour, minute, second' + call get_date(Time, yr, mon, day, hr, mins, sec) + write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & + 'Current model time: year, month, day, hour, minute, second' + call close_file(unit) +end subroutine write_ocean_solo_res + + +!> Write out an ascii time stamp file with the model time, following FMS conventions. +subroutine write_time_stamp_file(Time) + type(time_type), intent(in) :: Time !< The current model time. + ! Local variables + integer :: unit + integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. + character(len=9) :: month ! The name of the month + + if (.not.is_root_PE()) return + + call open_ASCII_file(unit, 'time_stamp.out', action=APPEND_FILE) + call get_date(Time, yr, mon, day, hr, mins, sec) + month = month_name(mon) + write(unit,'(6i4,2x,a3)') yr, mon, day, hr, mins, sec, month(1:3) + call get_date(Time_end, yr, mon, day, hr, mins, sec) + month = month_name(mon) + write(unit,'(6i4,2x,a3)') yr, mon, day, hr, mins, sec, month(1:3) + call close_file(unit) +end subroutine write_time_stamp_file + +!> Initialize the ensemble manager. If there are no settings for ensemble_size +!! in input.nml(ensemble.nml), these should not do anything. In coupled +!! configurations, this all occurs in the external driver. +subroutine initialize_ocean_only_ensembles() + integer, dimension(:), allocatable :: ocean_PElist + integer, dimension(0) :: atm_PElist, land_PElist, ice_PElist + integer :: ensemble_size, nPEs_per, ensemble_info(6) + + call ensemble_manager_init() ; ensemble_info(:) = get_ensemble_size() + ensemble_size = ensemble_info(1) ; nPEs_per = ensemble_info(2) + if (ensemble_size > 1) then ! There are multiple ensemble members. + allocate(ocean_pelist(nPEs_per)) + call ensemble_pelist_setup(.true., 0, nPEs_per, 0, 0, atm_pelist, ocean_pelist, & + land_pelist, ice_pelist) + call Set_PElist(ocean_pelist) + deallocate(ocean_pelist) + endif +end subroutine initialize_ocean_only_ensembles + end program MOM_main diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 85c363b897..7c26c2f194 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -79,12 +79,14 @@ module MOM_surface_forcing 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 [Z T-1 ~> m s-1] - real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] + real :: Flux_const_T !< piston velocity for surface temperature restoring [Z T-1 ~> m s-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 [Q ~> J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1] - real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing - real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing + real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" + !! forcing [R L Z T-1 ~> Pa] + real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" + !! forcing [R L Z T-1 ~> 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 @@ -99,31 +101,31 @@ module MOM_surface_forcing ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) - real :: gyres_taux_const !< A constant wind stress [Pa]. - real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. - real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. - real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' + real :: gyres_taux_const !< A constant wind stress [R L Z T-1 ~> Pa]. + real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover !! the answers from the end of 2018. Otherwise, use a form of the gyre !! wind stresses that are rotationally invariant and more likely to be !! the same between compilers. logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the !! gustless wind friction velocity. - ! if WIND_CONFIG=='scurves' then use the following to define a piecwise scurve profile + ! if WIND_CONFIG=='scurves' then use the following to define a piecewise scurve profile real :: scurves_ydata(20) = 90. !< Latitudes of scurve nodes [degreesN] - real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [Pa] + real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-1 ~> Pa] - real :: T_north !< target temperatures at north used in buoyancy_forcing_linear - real :: T_south !< target temperatures at south used in buoyancy_forcing_linear - real :: S_north !< target salinity at north used in buoyancy_forcing_linear - real :: S_south !< target salinity at south used in buoyancy_forcing_linear + real :: T_north !< Target temperatures at north used in buoyancy_forcing_linear [degC] + real :: T_south !< Target temperatures at south used in buoyancy_forcing_linear [degC] + real :: S_north !< Target salinity at north used in buoyancy_forcing_linear [ppt] + real :: S_south !< Target salinity at south used in buoyancy_forcing_linear [ppt] logical :: first_call_set_forcing = .true. !< True until after the first call to set_forcing logical :: archaic_OMIP_file = .true. !< If true use the variable names and data fields from !! a very old version of the OMIP forcing logical :: dataOverrideIsInitialized = .false. !< If true, data override has been initialized - real :: wind_scale !< value by which wind-stresses are scaled, ND. + real :: wind_scale !< value by which wind-stresses are scaled [nondim] real :: constantHeatForcing !< value used for sensible heat flux when buoy_config="const" [Q R Z T-1 ~> W m-2] character(len=8) :: wind_stagger !< A character indicating how the wind stress components @@ -231,7 +233,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: dt ! length of time over which fluxes applied [s] + real :: dt ! length of time over which fluxes applied [T ~> s] type(time_type) :: day_center ! central time of the fluxes. integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -240,7 +242,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US call callTree_enter("set_forcing, MOM_surface_forcing.F90") day_center = day_start + day_interval/2 - dt = time_type_to_real(day_interval) + dt = US%s_to_T * time_type_to_real(day_interval) if (CS%first_call_set_forcing) then ! Allocate memory for the mechanical and thermodynamic forcing fields. @@ -371,32 +373,30 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: tau_x0 !< The zonal wind stress [Pa] - real, intent(in) :: tau_y0 !< The meridional wind stress [Pa] + real, intent(in) :: tau_x0 !< The zonal wind stress [R Z L T-2 ~> Pa] + real, intent(in) :: tau_y0 !< The meridional wind stress [R Z L T-2 ~> Pa] type(time_type), intent(in) :: day !< The time of the fluxes 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 structure 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 + real :: mag_tau ! Magnitude of the wind stress [R Z L T-2 ~> Pa] 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 = Pa_conversion * sqrt( tau_x0**2 + tau_y0**2) + mag_tau = sqrt( tau_x0**2 + tau_y0**2) + ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = tau_x0 * Pa_conversion + forces%taux(I,j) = tau_x0 enddo ; enddo do J=js-1,Jeq ; do i=is,ie - forces%tauy(i,J) = tau_y0 * Pa_conversion + forces%tauy(i,J) = tau_y0 enddo ; enddo if (CS%read_gust_2d) then @@ -424,18 +424,21 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: PI + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: PI ! A common irrational number, 3.1415926535... [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_2gyre, 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 - !set the steady surface wind stresses, in units of Pa. + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z PI = 4.0*atan(1.0) + ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = 0.1*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + forces%taux(I,j) = 0.1 * Pa_to_RLZ_T2 * & (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) enddo ; enddo @@ -458,18 +461,21 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: PI + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: PI ! A common irrational number, 3.1415926535... [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_1gyre, 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 - ! set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + ! Set the steady surface wind stresses, in units of [R Z L T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = -0.2*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + forces%taux(I,j) = -0.2 * Pa_to_RLZ_T2 * & cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) enddo ; enddo @@ -491,22 +497,24 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: PI, y, I_rho + real :: PI ! A common irrational number, 3.1415926535... [nondim] + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + real :: y ! The latitude relative to the south normalized by the domain extent [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_gyres, 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 - ! steady surface wind stresses [Pa] PI = 4.0*atan(1.0) + ! steady surface wind stresses [R L Z T-1 ~> Pa] do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat - forces%taux(I,j) = 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) )) + forces%taux(I,j) = CS%gyres_taux_const + & + ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) enddo ; enddo do J=js-1,Jeq ; do i=is-1,ie+1 @@ -546,9 +554,14 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: PI, I_rho, y - real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] - real :: off + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: PI ! A common irrational number, 3.1415926535... [nondim] + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + real :: y ! The latitude relative to the south normalized by the domain extent [nondim] + real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] + real :: off ! An offset in the relative latitude [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -558,14 +571,15 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true.) - ! Set the surface wind stresses, in units of Pa. A positive taux + ! Set the surface wind stresses, in units of [R Z L T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. PI = 4.0*atan(1.0) + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z forces%taux(:,:) = 0.0 - tau_max = 0.2 * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + tau_max = 0.2 * Pa_to_RLZ_T2 off = 0.02 do j=js,je ; do I=is-1,Ieq y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat @@ -586,7 +600,7 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar is always positive. + ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then I_rho = US%L_to_Z / CS%Rho0 do j=js,je ; do i=is,ie @@ -610,7 +624,10 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables integer :: i, j, kseg - real :: lon, lat, I_rho, y, L + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + real :: y_curve ! The latitude relative to the southern end of a curve segment [degreesN] + real :: L_curve ! The latitudinal extent of a curve segment [degreesN] ! real :: ydata(7) = (/ -70., -45., -15., 0., 15., 45., 70. /) ! real :: taudt(7) = (/ 0., 0.2, -0.1, -0.02, -0.1, 0.1, 0. /) @@ -619,21 +636,18 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) kseg = 1 do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - lon = G%geoLonCu(I,j) - lat = G%geoLatCu(I,j) - - ! Find segment k s.t. ydata(k)<= lat < ydata(k+1) - do while (lat>=CS%scurves_ydata(kseg+1) .and. kseg<6) + ! Find segment k s.t. ydata(k)<= G%geoLatCu(I,j) < ydata(k+1) + do while (G%geoLatCu(I,j) >= CS%scurves_ydata(kseg+1) .and. kseg<6) ! Should this be kseg<19? kseg = kseg+1 enddo - do while (lat1) + do while (G%geoLatCu(I,j) < CS%scurves_ydata(kseg) .and. kseg>1) kseg = kseg-1 enddo - y = lat - CS%scurves_ydata(kseg) - L = CS%scurves_ydata(kseg+1) - CS%scurves_ydata(kseg) + y_curve = G%geoLatCu(I,j) - CS%scurves_ydata(kseg) + L_curve = CS%scurves_ydata(kseg+1) - CS%scurves_ydata(kseg) forces%taux(I,j) = CS%scurves_taux(kseg) + & - ( CS%scurves_taux(kseg+1) - CS%scurves_taux(kseg) ) * scurve(y, L) + (CS%scurves_taux(kseg+1) - CS%scurves_taux(kseg)) * scurve(y_curve, L_curve) forces%taux(I,j) = G%mask2dCu(I,j) * forces%taux(I,j) enddo ; enddo @@ -641,7 +655,7 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar is always positive. + ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then I_rho = US%L_to_Z / CS%Rho0 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -655,9 +669,9 @@ end subroutine scurve_wind_forcing !> Returns the value of a cosine-bell function evaluated at x/L real function scurve(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: s + real , intent(in) :: x !< non-dimensional position [nondim] + real , intent(in) :: L !< non-dimensional width [nondim] + real :: s ! The evaluated function value [nondim] s = x/L scurve = (3. - 2.*s) * (s*s) @@ -675,10 +689,10 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables character(len=200) :: filename ! The name of the input file. - real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and pseudo-meridional - 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] + real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-1 ~> Pa] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-1 ~> Pa] + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and monthly cycles. integer :: time_lev ! The time level that is used for a field. @@ -689,7 +703,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 + Pa_to_RLZ_T2 = 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) @@ -728,7 +742,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, scale=Pa_conversion) + timelevel=time_lev, scale=Pa_to_RLZ_T2) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=js,je ; do I=is-1,Ieq @@ -762,7 +776,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) 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, & - scale=Pa_conversion) + scale=Pa_to_RLZ_T2) 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) @@ -772,7 +786,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) 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, & - scale=Pa_conversion) + scale=Pa_to_RLZ_T2) if (CS%wind_scale /= 1.0) then do j=js,je ; do I=Isq,Ieq @@ -830,8 +844,9 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R Z L T-2 ~> Pa]. - real :: temp_y(SZI_(G),SZJ_(G)) ! Psuedo-meridional wind stresses at h-points [R Z L T-2 ~> Pa]. - real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R Z L T-2 ~> Pa]. + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: i, j call callTree_enter("wind_forcing_by_data_override, MOM_surface_forcing.F90") @@ -842,12 +857,12 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) CS%dataOverrideIsInitialized = .True. endif - Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 ! CS%wind_scale is ignored here because it is not set in this mode. - call data_override(G%Domain, 'taux', temp_x, day, scale=Pa_conversion) - call data_override(G%Domain, 'tauy', temp_y, day, scale=Pa_conversion) + call data_override(G%Domain, 'taux', temp_x, day, scale=Pa_to_RLZ_T2) + call data_override(G%Domain, 'tauy', temp_y, day, scale=Pa_to_RLZ_T2) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) 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)) @@ -857,7 +872,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) enddo ; enddo if (CS%read_gust_2d) then - call data_override(G%Domain, 'gust', CS%gust, day, scale=Pa_conversion) + call data_override(G%Domain, 'gust', CS%gust, day, scale=Pa_to_RLZ_T2) do j=G%jsc,G%jec ; do i=G%isc,G%iec forces%ustar(i,j) = sqrt((sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + & CS%gust(i,j)) * US%L_to_Z / CS%Rho0) @@ -884,24 +899,23 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - temp, & ! A 2-d temporary work array with various units. - SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value [degC]. - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value [ppt]. - 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]. + temp ! A 2-d temporary work array in various units of [Q R Z T-1 ~> W m-2] or + ! [R Z T-1 ~> kg m-2 s-1] +!#CTRL# real, dimension(SZI_(G),SZJ_(G)) :: & +!#CTRL# SST_anom, & ! Instantaneous sea surface temperature anomalies from a +!#CTRL# ! target (observed) value [degC]. +!#CTRL# SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target +!#CTRL# ! (observed) value [ppt]. +!#CTRL# SSS_mean ! A (mean?) salinity about which to normalize local salinity +!#CTRL# ! anomalies when calculating restorative precipitation anomalies [ppt]. + real :: rhoXcp ! reference density times heat capacity [Q R degC-1 ~> J m-3 degC-1] integer :: time_lev_daily ! time levels to read for fields with daily cycle @@ -914,7 +928,6 @@ 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_m2s_to_RZ_T if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p @@ -965,14 +978,14 @@ 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%evaporation_file, CS%evap_var, fluxes%evap(:,:), & - G%Domain, timelevel=time_lev, scale=-kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=-US%kg_m2s_to_RZ_T) do j=js,je ; do i=is,ie fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(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, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) endif CS%evap_last_lev = time_lev @@ -1026,9 +1039,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, scale=kg_m2_s_conversion) + fluxes%fprec(:,:), G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) call MOM_read_data(CS%rain_file, CS%rain_var, & - fluxes%lprec(:,:), G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + fluxes%lprec(:,:), G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) 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) @@ -1043,20 +1056,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, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T*US%m_to_L**2) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T*US%m_to_L**2) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) call MOM_read_data(CS%runoff_file, CS%frunoff_var, fluxes%frunoff(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) endif CS%runoff_last_lev = time_lev @@ -1083,8 +1096,8 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) CS%buoy_last_lev_read = time_lev_daily ! mask out land points and compute heat content of water fluxes - ! assume liquid precip enters ocean at SST - ! assume frozen precip enters ocean at 0degC + ! assume liquid precipitation enters ocean at SST + ! assume frozen precipitation enters ocean at 0degC ! assume liquid runoff enters ocean at SST ! assume solid runoff (calving) enters ocean at 0degC ! mass leaving the ocean has heat_content determined in MOM_diabatic_driver.F90 @@ -1149,7 +1162,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, dt, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif call callTree_leave("buoyancy_forcing_from_files") @@ -1162,23 +1175,19 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: & - temp, & ! A 2-d temporary work array with various units. - SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value [degC]. - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value [ppt]. - 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]. +!#CTRL# real, dimension(SZI_(G),SZJ_(G)) :: & +!#CTRL# SST_anom, & ! Instantaneous sea surface temperature anomalies from a +!#CTRL# ! target (observed) value [degC]. +!#CTRL# SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target +!#CTRL# ! (observed) value [ppt]. +!#CTRL# SSS_mean ! A (mean?) salinity about which to normalize local salinity +!#CTRL# ! anomalies when calculating restorative precipitation anomalies [ppt]. real :: rhoXcp ! The mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed @@ -1186,7 +1195,6 @@ 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_m2s_to_RZ_T if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p @@ -1208,10 +1216,10 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo - call data_override(G%Domain, 'snow', fluxes%fprec, day, scale=kg_m2_s_conversion) - call data_override(G%Domain, 'rain', fluxes%lprec, day, scale=kg_m2_s_conversion) - call data_override(G%Domain, 'runoff', fluxes%lrunoff, day, scale=kg_m2_s_conversion) - call data_override(G%Domain, 'calving', fluxes%frunoff, day, scale=kg_m2_s_conversion) + call data_override(G%Domain, 'snow', fluxes%fprec, day, scale=US%kg_m2s_to_RZ_T) + call data_override(G%Domain, 'rain', fluxes%lprec, day, scale=US%kg_m2s_to_RZ_T) + call data_override(G%Domain, 'runoff', fluxes%lrunoff, day, scale=US%kg_m2s_to_RZ_T) + call data_override(G%Domain, 'calving', fluxes%frunoff, day, scale=US%kg_m2s_to_RZ_T) ! Read the SST and SSS fields for damping. if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then @@ -1281,7 +1289,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, US%T_to_s*dt, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") @@ -1294,7 +1302,7 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call @@ -1337,7 +1345,7 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> 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 structure returned by @@ -1380,13 +1388,15 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> 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 structure returned by !! a previous surface_forcing_init call ! Local variables - real :: y, T_restore, S_restore + real :: y ! The latitude relative to the south normalized by the domain extent [nondim] + real :: T_restore ! The temperature towards which to restore [degC] + real :: S_restore ! The salinity towards which to restore [ppt] integer :: i, j, is, ie, js, je call callTree_enter("buoyancy_forcing_linear, MOM_surface_forcing.F90") @@ -1492,6 +1502,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! This include declares and sets the variable "version". # include "version_variable.h" real :: flux_const_default ! The unscaled value of FLUXCONST [m day-1] + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] 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. @@ -1509,6 +1521,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%diag => diag if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, '') call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & @@ -1706,17 +1720,17 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "With the gyres wind_config, the constant offset in the "//& "zonal wind stress profile: "//& " A in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0) - call get_param(param_file, mdl, "TAUX_SIN_AMP",CS%gyres_taux_sin_amp, & + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + call get_param(param_file, mdl, "TAUX_SIN_AMP", CS%gyres_taux_sin_amp, & "With the gyres wind_config, the sine amplitude in the "//& "zonal wind stress profile: "//& " B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0) - call get_param(param_file, mdl, "TAUX_COS_AMP",CS%gyres_taux_cos_amp, & + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + call get_param(param_file, mdl, "TAUX_COS_AMP", CS%gyres_taux_cos_amp, & "With the gyres wind_config, the cosine amplitude in "//& "the zonal wind stress profile: "//& " C in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0) + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & "With the gyres wind_config, the number of gyres in "//& "the zonal wind stress profile: "//& @@ -1741,7 +1755,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "WIND_SCURVES_TAUX", CS%scurves_taux, & "A list of zonal wind stress values at latitudes "//& "WIND_SCURVES_LATS defining a piecewise scurve profile.", & - units="Pa", fail_if_missing=.true.) + units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) endif if ((trim(CS%wind_config) == "2gyre") .or. & (trim(CS%wind_config) == "1gyre") .or. & @@ -1814,7 +1828,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & - units="Pa", default=0.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & "If true correct a bug in the time-averaging of the gustless wind friction velocity", & default=.true.) @@ -1828,7 +1842,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) filename = trim(CS%inputdir) // trim(gust_file) call MOM_read_data(filename,'gustiness',CS%gust,G%domain, timelevel=1, & - scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa + scale=Pa_to_RLZ_T2) ! units in file should be Pa endif ! All parameter settings are now known. @@ -1846,11 +1860,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C 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 "//& - "wind-stress", units="Pa", fail_if_missing=.true.) + "With wind_config const, this is the constant zonal wind-stress", & + units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) call get_param(param_file, mdl, "CONST_WIND_TAUY", CS%tau_y0, & - "With wind_config const, this is the constant meridional "//& - "wind-stress", units="Pa", fail_if_missing=.true.) + "With wind_config const, this is the constant meridional wind-stress", & + units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) 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) @@ -1894,7 +1908,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C if (trim(CS%wind_config) == "file") & CS%wind_nlev = num_timelevels(CS%wind_file, CS%stress_x_var, min_dims=3) -!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, US, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1907,10 +1921,6 @@ subroutine surface_forcing_end(CS, fluxes) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call type(forcing), optional, intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init, it will be deallocated here. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. if (present(fluxes)) call deallocate_forcing_type(fluxes) diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90 index 940bcd04b4..0af6b126e1 100644 --- a/config_src/drivers/solo_driver/user_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/user_surface_forcing.F90 @@ -27,7 +27,7 @@ module user_surface_forcing !! It can be readily modified for a specific case, and because it is private there !! will be no changes needed in other code (although they will have to be recompiled). type, public :: user_surface_forcing_CS ; private - ! The variables in the cannonical example are used for some common + ! The variables in the canonical example are used for some common ! cases, but do not need to be used. logical :: use_temperature !< If true, temperature and salinity are used as state variables. @@ -104,7 +104,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned @@ -221,7 +221,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) 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 [R ~> kg m-3] that is being restored toward. density_restore = 1030.0*US%kg_m3_to_R fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & @@ -242,8 +242,8 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to !! the control structure for this module -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "user_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index 7e3c6d45b4..9f3950ac7f 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -18,25 +18,30 @@ program MOM_main use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_to_real, real_to_EFP use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT - use MOM_domains, only : MOM_domains_init, MOM_infra_init, MOM_infra_end + use MOM_domains, only : MOM_domain_type, MOM_domains_init, MOM_infra_init, MOM_infra_end + use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : MOM_set_verbosity use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_file_parser, only : open_param_file, close_param_file - use MOM_grid, only : MOM_grid_init, ocean_grid_type use MOM_grid_initialize, only : set_grid_metrics + use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_io, only : MOM_io_init, file_exists, open_file, close_file use MOM_io, only : check_nml_error, io_infra_init, io_infra_end use MOM_io, only : APPEND_FILE, ASCII_FILE, READONLY_FILE, SINGLE_FILE + use MOM_unit_scaling, only : unit_scale_type, unit_no_scaling_init, unit_scaling_end implicit none #include - type(ocean_grid_type) :: grid ! A structure containing metrics and grid info. - - type(param_file_type) :: param_file ! The structure indicating the file(s) + type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain + type(dyn_horgrid_type), pointer :: grid => NULL() ! A structure containing metrics and grid info + type(hor_index_type) :: HI ! A hor_index_type for array extents + type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. + type(unit_scale_type), pointer :: US => NULL() !< A structure containing various unit + ! conversion factors, but in this case all are 1. real :: max_depth ! The maximum ocean depth [m] integer :: verbosity integer :: num_sums @@ -76,14 +81,16 @@ program MOM_main verbosity = 2 ; call read_param(param_file, "VERBOSITY", verbosity) call MOM_set_verbosity(verbosity) - call MOM_domains_init(grid%domain, param_file) + call MOM_domains_init(Domain, param_file) call MOM_io_init(param_file) ! call diag_mediator_init(param_file) - call MOM_grid_init(grid, param_file) + call hor_index_init(Domain, HI, param_file) + call create_dyn_horgrid(grid, HI) + grid%Domain => Domain - is = grid%isc ; ie = grid%iec ; js = grid%jsc ; je = grid%jec - isd = grid%isd ; ied = grid%ied ; jsd = grid%jsd ; jed = grid%jed + is = HI%isc ; ie = HI%iec ; js = HI%jsc ; je = HI%jec + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ! Read all relevant parameters and write them to the model log. call log_version(param_file, "MOM", version, "") @@ -99,8 +106,9 @@ program MOM_main allocate(depth_tot_std(num_sums)) ; depth_tot_std(:) = 0.0 allocate(depth_tot_fastR(num_sums)) ; depth_tot_fastR(:) = 0.0 -! Set up the parameters of the physical domain (i.e. the grid), G - call set_grid_metrics(grid, param_file) +! Set up the parameters of the physical grid + call unit_no_scaling_init(US) + call set_grid_metrics(grid, param_file, US) ! Set up the bottom depth, grid%bathyT either analytically or from file call get_param(param_file, "MOM", "MAXIMUM_DEPTH", max_depth, & @@ -157,14 +165,17 @@ program MOM_main endif enddo + call destroy_dyn_horgrid(grid) + call unit_scaling_end(US) call io_infra_end ; call MOM_infra_end contains !> This subroutine sets up the benchmark test case topography for debugging subroutine benchmark_init_topog_local(D, G, param_file, max_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: D !< The ocean bottom depth in m + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters real, intent(in) :: max_depth !< The maximum ocean depth [m] @@ -172,6 +183,7 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! + real :: m_to_Z ! A dimensional rescaling factor. real :: x, y ! This include declares and sets the variable "version". # include "version_variable.h" @@ -180,12 +192,14 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call log_version(param_file, mdl, version) + m_to_Z = 1.0 ! ; if (present(US)) m_to_Z = US%m_to_Z + + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) PI = 4.0*atan(1.0) - D0 = max_depth / 0.5; + D0 = max_depth / 0.5 ! Calculate the depth of the bottom. do i=is,ie ; do j=js,je diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 index 4d2e4183f7..6bd445ae8b 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 @@ -42,7 +42,7 @@ subroutine generic_tracer_init(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid integer, intent(in) :: jsd !< Data start index in j direction integer, intent(in) :: jed !< Data end index in j direction integer, intent(in) :: nk !< Number of levels in k direction - integer, intent(in) :: ntau !< Unknown + integer, intent(in) :: ntau !< The number of tracer time levels (always 1 for MOM6) integer, intent(in) :: axes(3) !< Domain axes? type(time_type), intent(in) :: init_time !< Time real, dimension(:,:,:),target, intent(in) :: grid_tmask !< Mask @@ -61,7 +61,7 @@ end subroutine generic_tracer_coupler_get !> Unknown subroutine generic_tracer_coupler_accumulate(IOB_struc, weight, model_time) type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure - real, intent(in) :: weight !< Unknown + real, intent(in) :: weight !< A weight for accumulating these fluxes type(time_type), optional,intent(in) :: model_time !< Time end subroutine generic_tracer_coupler_accumulate @@ -69,44 +69,53 @@ end subroutine generic_tracer_coupler_accumulate subroutine generic_tracer_source(Temp,Salt,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,& grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,& frunoff,grid_ht, current_wave_stress, sosga) - real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] - real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] - real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Unknown - real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] - real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth - integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain - integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain - integer, intent(in) :: tau !< Time step index of %field - real, intent(in) :: dtts !< Unknown - real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Unknown + real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] + real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] + real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Mass per unit area of each layer [kg m-2] + real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] + real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth [m] + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + integer, intent(in) :: tau !< Time step index of %field + real, intent(in) :: dtts !< The time step for this call [s] + real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Grid cell areas [m2] type(time_type), intent(in) :: model_time !< Time - integer, intent(in) :: nbands !< Unknown - real, dimension(:), intent(in) :: max_wavelength_band !< Unknown - real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Shortwave penetration - real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown - real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown - real, optional , intent(in) :: sosga !< Global average sea surface salinity + integer, intent(in) :: nbands !< The number of bands of penetrating shortwave radiation + real, dimension(:), intent(in) :: max_wavelength_band !< The maximum wavelength in each band + !! of penetrating shortwave radiation [nm] + real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Penetrating shortwave radiation per band [W m-2]. + !! The wavelength or angular direction band is the first index. + real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Opacity of seawater averaged over each band [m-1]. + !! The wavelength or angular direction band is the first index. + real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Any internal or geothermal heat + !! sources that are applied to the ocean integrated + !! over this timestep [degC kg m-2] + real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Rate of iceberg calving [kg m-2 s-1] + real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown, and presently unused by MOM6 + real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown, and presently unused by MOM6 + real, optional , intent(in) :: sosga !< Global average sea surface salinity [ppt] end subroutine generic_tracer_source !> Update the tracers from bottom fluxes subroutine generic_tracer_update_from_bottom(dt, tau, model_time) - real, intent(in) :: dt !< Time step increment + real, intent(in) :: dt !< Time step increment [s] integer, intent(in) :: tau !< Time step index used for the concentration field type(time_type), intent(in) :: model_time !< Time end subroutine generic_tracer_update_from_bottom !> Vertically diffuse all generic tracers for GOLD ocean subroutine generic_tracer_vertdiff_G(h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau) - real, dimension(:,:,:), intent(in) :: h_old !< Unknown - real, dimension(:,:,:), intent(in) :: ea !< Unknown - real, dimension(:,:,:), intent(in) :: eb !< Unknown - real, intent(in) :: dt !< Unknown - real, intent(in) :: kg_m2_to_H !< Unknown - real, intent(in) :: m_to_H !< Unknown - integer, intent(in) :: tau !< Unknown + real, dimension(:,:,:), intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: ea !< The amount of fluid entrained from the layer + !! above during this call [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: eb !< The amount of fluid entrained from the layer + !! below during this call [H ~> m or kg m-2] + real, intent(in) :: dt !< The amount of time covered by this call [s] + real, intent(in) :: kg_m2_to_H !< A unit conversion factor from mass per unit + !! area to thickness units [H m2 kg-1 ~> m3 kg-1 or 1] + real, intent(in) :: m_to_H !< A unit conversion factor from heights to + !! thickness units [H m-1 ~> 1 or kg m-3] + integer, intent(in) :: tau !< The time level to work on (always 1 for MOM6) end subroutine generic_tracer_vertdiff_G !> Set the coupler values for each generic tracer @@ -115,11 +124,11 @@ subroutine generic_tracer_coupler_set(IOB_struc, ST,SS,rho,ilb,jlb,tau, dzt, sos integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain integer, intent(in) :: tau !< Time step index of %field - real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [deg C] - real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [psu] + real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [degC] + real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [ppt] real, dimension(ilb:,jlb:,:,:), intent(in) :: rho !< Ocean density [kg m-3] real, dimension(ilb:,jlb:,:), optional, intent(in) :: dzt !< Layer thickness [m] - real, optional, intent(in) :: sosga !< Unknown + real, optional, intent(in) :: sosga !< Global mean sea surface salinity [ppt] type(time_type),optional, intent(in) :: model_time !< Time end subroutine generic_tracer_coupler_set diff --git a/config_src/external/drifters/MOM_particles.F90 b/config_src/external/drifters/MOM_particles.F90 new file mode 100644 index 0000000000..135f5d284c --- /dev/null +++ b/config_src/external/drifters/MOM_particles.F90 @@ -0,0 +1,59 @@ +!> A set of dummy interfaces for compiling the MOM6 drifters code +module MOM_particles_mod + +use MOM_grid, only : ocean_grid_type +use MOM_time_manager, only : time_type, get_date, operator(-) +use MOM_variables, only : thermo_var_ptrs + + +use particles_types_mod, only: particles, particles_gridded + +public particles_run, particles_init, particles_save_restart, particles_end + +contains + +!> Initializes particles container "parts" +subroutine particles_init(parts, Grid, Time, dt, u, v) + ! Arguments + type(particles), pointer, intent(out) :: parts !< Container for all types and memory + type(ocean_grid_type), target, intent(in) :: Grid !< Grid type from parent model + type(time_type), intent(in) :: Time !< Time type from parent model + real, intent(in) :: dt !< particle timestep in seconds + real, dimension(:,:,:),intent(in) :: u !< Zonal velocity field + real, dimension(:,:,:),intent(in) :: v !< Meridional velocity field + +end subroutine particles_init + +!> The main driver the steps updates particles +subroutine particles_run(parts, time, uo, vo, ho, tv, stagger) + ! Arguments + type(particles), pointer :: parts !< Container for all types and memory + type(time_type), intent(in) :: time !< Model time + real, dimension(:,:,:),intent(in) :: uo !< Ocean zonal velocity (m/s) + real, dimension(:,:,:),intent(in) :: vo !< Ocean meridional velocity (m/s) + real, dimension(:,:,:),intent(in) :: ho !< Ocean layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< structure containing pointers to available thermodynamic fields + integer, optional, intent(in) :: stagger !< Flag for whether velocities are staggered + +end subroutine particles_run + + +!>Save particle locations (and sometimes other vars) to restart file +subroutine particles_save_restart(parts,temp,salt) +! Arguments +type(particles), pointer :: parts !< Container for all types and memory +real,dimension(:,:,:),optional,intent(in) :: temp !< Optional container for temperature +real,dimension(:,:,:),optional,intent(in) :: salt !< Optional container for salinity + +end subroutine particles_save_restart + +!> Deallocate all memory and disassociated pointer +subroutine particles_end(parts,temp,salt) +! Arguments +type(particles), pointer :: parts !< Container for all types and memory +real,dimension(:,:,:),optional,intent(in) :: temp !< Optional container for temperature +real,dimension(:,:,:),optional,intent(in) :: salt !< Optional container for salinity + +end subroutine particles_end + +end module MOM_particles_mod diff --git a/config_src/external/drifters/MOM_particles_types.F90 b/config_src/external/drifters/MOM_particles_types.F90 new file mode 100644 index 0000000000..b7bc01acb9 --- /dev/null +++ b/config_src/external/drifters/MOM_particles_types.F90 @@ -0,0 +1,161 @@ +!> Dummy data structures and methods for drifters package +module particles_types_mod + +use MOM_grid, only : ocean_grid_type +use mpp_domains_mod, only: domain2D + + +!> Container for gridded fields +type :: particles_gridded + type(domain2D), pointer :: domain !< MPP parallel domain + integer :: halo !< Nominal halo width + integer :: isc !< Start i-index of computational domain + integer :: iec !< End i-index of computational domain + integer :: jsc !< Start j-index of computational domain + integer :: jec !< End j-index of computational domain + integer :: isd !< Start i-index of data domain + integer :: ied !< End i-index of data domain + integer :: jsd !< Start j-index of data domain + integer :: jed !< End j-index of data domain + integer :: isg !< Start i-index of global domain + integer :: ieg !< End i-index of global domain + integer :: jsg !< Start j-index of global domain + integer :: jeg !< End j-index of global domain + integer :: is_offset=0 !< add to i to recover global i-index + integer :: js_offset=0 !< add to j to recover global j-index + integer :: my_pe !< MPI PE index + integer :: pe_N !< MPI PE index of PE to the north + integer :: pe_S !< MPI PE index of PE to the south + integer :: pe_E !< MPI PE index of PE to the east + integer :: pe_W !< MPI PE index of PE to the west + logical :: grid_is_latlon !< Flag to say whether the coordinate is in lat-lon degrees, or meters + logical :: grid_is_regular !< Flag to say whether point in cell can be found assuming regular Cartesian grid + real :: Lx !< Length of the domain in x direction + real, dimension(:,:), allocatable :: lon !< Longitude of cell corners (degree E) + real, dimension(:,:), allocatable :: lat !< Latitude of cell corners (degree N) + real, dimension(:,:), allocatable :: lonc !< Longitude of cell centers (degree E) + real, dimension(:,:), allocatable :: latc !< Latitude of cell centers (degree N) + real, dimension(:,:), allocatable :: dx !< Length of cell edge (m) + real, dimension(:,:), allocatable :: dy !< Length of cell edge (m) + real, dimension(:,:), allocatable :: area !< Area of cell (m^2) + real, dimension(:,:), allocatable :: msk !< Ocean-land mask (1=ocean) + real, dimension(:,:), allocatable :: cos !< Cosine from rotation matrix to lat-lon coords + real, dimension(:,:), allocatable :: sin !< Sine from rotation matrix to lat-lon coords + real, dimension(:,:), allocatable :: ocean_depth !< Depth of ocean (m) + real, dimension(:,:), allocatable :: uo !< Ocean zonal flow (m/s) + real, dimension(:,:), allocatable :: vo !< Ocean meridional flow (m/s) + real, dimension(:,:), allocatable :: tmp !< Temporary work space + real, dimension(:,:), allocatable :: tmpc !< Temporary work space + real, dimension(:,:), allocatable :: parity_x !< X component of vector point from i,j to i+1,j+1 + real, dimension(:,:), allocatable :: parity_y !< Y component of vector point from i,j to i+1,j+1 + ! (For detecting tri-polar fold) + integer, dimension(:,:), allocatable :: particle_counter_grd !< Counts particles created for naming purposes + !>@{ + !! Diagnostic handle + integer :: id_uo=-1, id_vo=-1, id_unused=-1 + integer :: id_count=-1, id_chksum=-1 + !>@} + +end type particles_gridded + + +!>xyt is a data structure containing particle position and velocity fields. +type :: xyt + real :: lon !< Longitude of particle (degree N or unit of grid coordinate) + real :: lat !< Latitude of particle (degree N or unit of grid coordinate) + real :: day !< Day of this record (days) + real :: lat_old !< Previous latitude + real :: lon_old !< Previous longitude + real :: uvel !< Zonal velocity of particle (m/s) + real :: vvel !< Meridional velocity of particle (m/s) + real :: uvel_old !< Previous zonal velocity component (m/s) + real :: vvel_old !< Previous meridional velocity component (m/s) + integer :: year !< Year of this record + integer :: particle_num !< Current particle number + integer(kind=8) :: id = -1 !< Particle Identifier + type(xyt), pointer :: next=>null() !< Pointer to the next position in the list +end type xyt + +!>particle types are data structures describing a tracked particle +type :: particle + type(particle), pointer :: prev=>null() !< Previous link in list + type(particle), pointer :: next=>null() !< Next link in list +! State variables (specific to the particles, needed for restarts) + real :: lon !< Longitude of particle (degree N or unit of grid coordinate) + real :: lat !< Latitude of particle (degree E or unit of grid coordinate) + real :: depth !< Depth of particle + real :: uvel !< Zonal velocity of particle (m/s) + real :: vvel !< Meridional velocity of particle (m/s) + real :: lon_old !< previous lon (degrees) + real :: lat_old !< previous lat (degrees) + real :: uvel_old !< previous uvel + real :: vvel_old !< previous vvel + real :: start_lon !< starting longitude where particle was created + real :: start_lat !< starting latitude where particle was created + real :: start_day !< origination position (degrees) and day + integer :: start_year !< origination year + real :: halo_part !< equal to zero for particles on the computational domain, and 1 for particles on the halo + integer(kind=8) :: id !< particle identifier + integer(kind=8) :: drifter_num !< particle identifier + integer :: ine !< nearest i-index in NE direction (for convenience) + integer :: jne !< nearest j-index in NE direction (for convenience) + real :: xi !< non-dimensional x-coordinate within current cell (0..1) + real :: yj !< non-dimensional y-coordinate within current cell (0..1) + real :: uo !< zonal ocean velocity + real :: vo !< meridional ocean velocity + !< by the particle (m/s) + type(xyt), pointer :: trajectory=>null() !< Trajectory for this particle +end type particle + + +!>A buffer structure for message passing +type :: buffer + integer :: size=0 !< Size of buffer + real, dimension(:,:), pointer :: data !< Buffer memory +end type buffer + +!> A wrapper for the particle linked list (since an array of pointers is not allowed) +type :: linked_list + type(particle), pointer :: first=>null() !< Pointer to the beginning of a linked list of parts +end type linked_list + + +!> A grand data structure for the particles in the local MOM domain +type :: particles !; private + type(particles_gridded) :: grd !< Container with all gridded data + type(linked_list), dimension(:,:), allocatable :: list !< Linked list of particles + type(xyt), pointer :: trajectories=>null() !< A linked list for detached segments of trajectories + real :: dt !< Time-step between particle calls + integer :: current_year !< Current year (years) + real :: current_yearday !< Current year-day, 1.00-365.99, (days) + integer :: traj_sample_hrs !< Period between sampling for trajectories (hours) + integer :: traj_write_hrs !< Period between writing of trajectories (hours) + integer :: verbose_hrs !< Period between terminal status reports (hours) + !>@{ + !! Handles for clocks + integer :: clock, clock_mom, clock_the, clock_int, clock_cal, clock_com, clock_ini, clock_ior, clock_iow, clock_dia + integer :: clock_trw, clock_trp + !>@} + logical :: restarted=.false. !< Indicate whether we read state from a restart or not + logical :: Runge_not_Verlet=.True. !< True=Runge-Kutta, False=Verlet. + logical :: ignore_missing_restart_parts=.False. !< True allows the model to ignore particles missing in the restart. + logical :: halo_debugging=.False. !< Use for debugging halos (remove when its working) + logical :: save_short_traj=.false. !< True saves only lon,lat,time,id in particle_trajectory.nc + logical :: ignore_traj=.False. !< If true, then model does not write trajectory data at all + logical :: use_new_predictive_corrective =.False. !< Flag to use Bob's predictive corrective particle scheme + !Added by Alon + integer(kind=8) :: debug_particle_with_id = -1 !< If positive, monitors a part with this id + type(buffer), pointer :: obuffer_n=>null() !< Buffer for outgoing parts to the north + type(buffer), pointer :: ibuffer_n=>null() !< Buffer for incoming parts from the north + type(buffer), pointer :: obuffer_s=>null() !< Buffer for outgoing parts to the south + type(buffer), pointer :: ibuffer_s=>null() !< Buffer for incoming parts from the south + type(buffer), pointer :: obuffer_e=>null() !< Buffer for outgoing parts to the east + type(buffer), pointer :: ibuffer_e=>null() !< Buffer for incoming parts from the east + type(buffer), pointer :: obuffer_w=>null() !< Buffer for outgoing parts to the west + type(buffer), pointer :: ibuffer_w=>null() !< Buffer for incoming parts from the west + type(buffer), pointer :: obuffer_io=>null() !< Buffer for outgoing parts during i/o + type(buffer), pointer :: ibuffer_io=>null() !< Buffer for incoming parts during i/o +end type particles + + +end module particles_types_mod diff --git a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 index 47d7bbedaa..0c42c577b4 100644 --- a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 @@ -71,23 +71,29 @@ subroutine cpu_clock_end(id) end subroutine cpu_clock_end !> Returns the integer handle for a named CPU clock. -integer function cpu_clock_id( name, synchro_flag, grain ) +integer function cpu_clock_id(name, sync, grain) character(len=*), intent(in) :: name !< The unique name of the CPU clock - integer, optional, intent(in) :: synchro_flag !< An integer flag that controls whether the PEs - !! are synchronized before the cpu clocks start counting. - !! Synchronization occurs before the start of a clock if this - !! is odd, while additional (expensive) statistics can set - !! for other values. If absent, the default is taken from the - !! settings for FMS. + logical, optional, intent(in) :: sync !< A flag that controls whether the + !! PEs are synchronized before the cpu clocks start counting. + !! Synchronization occurs before the start of a clock if this + !! is enabled, while additional (expensive) statistics can + !! set for other values. + !! If absent, the default is taken from the settings for FMS. integer, optional, intent(in) :: grain !< The timing granularity for this clock, usually set to !! the values of CLOCK_COMPONENT, CLOCK_ROUTINE, CLOCK_LOOP, etc. - if (present(synchro_flag)) then - cpu_clock_id = mpp_clock_id(name, flags=synchro_flag, grain=grain) - else - cpu_clock_id = mpp_clock_id(name, flags=clock_flag_default, grain=grain) + integer :: clock_flags + + clock_flags = clock_flag_default + if (present(sync)) then + if (sync) then + clock_flags = ibset(clock_flags, 0) + else + clock_flags = ibclr(clock_flags, 0) + endif endif + cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id end module MOM_cpu_clock_infra diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index 590637158f..7eff4597f3 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -1716,13 +1716,13 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & symmetry=symmetric_dom, xextent=xextent, yextent=yextent, name=dom_name) endif - if ((MD_in%io_layout(1) + MD_in%io_layout(2) > 0) .and. & - (MD_in%layout(1)*MD_in%layout(2) > 1)) then - call mpp_define_io_domain(mpp_domain, MD_in%io_layout) - else - call mpp_define_io_domain(mpp_domain, (/ 1, 1 /) ) + if (MD_in%layout(1) * MD_in%layout(2) > 1) then + if ((MD_in%io_layout(1) + MD_in%io_layout(2) > 0)) then + call mpp_define_io_domain(mpp_domain, MD_in%io_layout) + else + call mpp_define_io_domain(mpp_domain, [1, 1] ) + endif endif - end subroutine clone_MD_to_d2D !> Returns the index ranges that have been stored in a MOM_domain_type diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index 1501f3171b..f956f9fa51 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -137,15 +137,12 @@ logical function MOM_file_exists(filename, MOM_Domain) end function MOM_file_exists !> Returns true if the named file or its domain-decomposed variant exists. -logical function FMS_file_exists(filename, domain, no_domain) +logical function FMS_file_exists(filename) character(len=*), intent(in) :: filename !< The name of the file being inquired about - type(domain2d), optional, intent(in) :: domain !< The mpp domain2d that describes the decomposition - logical, optional, intent(in) :: no_domain !< This file does not use domain decomposition -! This function uses the fms_io function file_exist to determine whether -! a named file (or its decomposed variant) exists. - - FMS_file_exists = file_exist(filename, domain, no_domain) + ! This function uses the fms_io function file_exist to determine whether + ! a named file (or its decomposed variant) exists. + FMS_file_exists = file_exist(filename) end function FMS_file_exists !> indicates whether an I/O handle is attached to an open file diff --git a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 index 47d7bbedaa..0c42c577b4 100644 --- a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 @@ -71,23 +71,29 @@ subroutine cpu_clock_end(id) end subroutine cpu_clock_end !> Returns the integer handle for a named CPU clock. -integer function cpu_clock_id( name, synchro_flag, grain ) +integer function cpu_clock_id(name, sync, grain) character(len=*), intent(in) :: name !< The unique name of the CPU clock - integer, optional, intent(in) :: synchro_flag !< An integer flag that controls whether the PEs - !! are synchronized before the cpu clocks start counting. - !! Synchronization occurs before the start of a clock if this - !! is odd, while additional (expensive) statistics can set - !! for other values. If absent, the default is taken from the - !! settings for FMS. + logical, optional, intent(in) :: sync !< A flag that controls whether the + !! PEs are synchronized before the cpu clocks start counting. + !! Synchronization occurs before the start of a clock if this + !! is enabled, while additional (expensive) statistics can + !! set for other values. + !! If absent, the default is taken from the settings for FMS. integer, optional, intent(in) :: grain !< The timing granularity for this clock, usually set to !! the values of CLOCK_COMPONENT, CLOCK_ROUTINE, CLOCK_LOOP, etc. - if (present(synchro_flag)) then - cpu_clock_id = mpp_clock_id(name, flags=synchro_flag, grain=grain) - else - cpu_clock_id = mpp_clock_id(name, flags=clock_flag_default, grain=grain) + integer :: clock_flags + + clock_flags = clock_flag_default + if (present(sync)) then + if (sync) then + clock_flags = ibset(clock_flags, 0) + else + clock_flags = ibclr(clock_flags, 0) + endif endif + cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id end module MOM_cpu_clock_infra diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 0b8c19d836..62a43ab99b 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -17,6 +17,7 @@ module MOM_io_infra use fms2_io_mod, only : get_variable_dimension_names, is_dimension_registered, get_dimension_size use fms2_io_mod, only : is_dimension_unlimited, register_axis, unlimited use fms2_io_mod, only : get_global_io_domain_indices +use fms_io_utils_mod, only : fms2_file_exist => file_exists use fms_mod, only : write_version_number, open_namelist_file, check_nml_error use fms_io_mod, only : file_exist, field_exist, field_size, read_data @@ -170,15 +171,12 @@ logical function MOM_file_exists(filename, MOM_Domain) end function MOM_file_exists !> Returns true if the named file or its domain-decomposed variant exists. -logical function FMS_file_exists(filename, domain, no_domain) +logical function FMS_file_exists(filename) character(len=*), intent(in) :: filename !< The name of the file being inquired about - type(domain2d), optional, intent(in) :: domain !< The mpp domain2d that describes the decomposition - logical, optional, intent(in) :: no_domain !< This file does not use domain decomposition -! This function uses the fms_io function file_exist to determine whether -! a named file (or its decomposed variant) exists. - - FMS_file_exists = file_exist(filename, domain, no_domain) + ! This function uses the fms_io function file_exist to determine whether + ! a named file (or its decomposed variant) exists. + FMS_file_exists = fms2_file_exist(filename) end function FMS_file_exists !> indicates whether an I/O handle is attached to an open file diff --git a/docs/about.rst b/docs/about.rst index 27c92b20fd..984e5776e8 100644 --- a/docs/about.rst +++ b/docs/about.rst @@ -8,7 +8,7 @@ Here is where to find particular documentation: Download, compile and run Installation documentation is in the form of user-driven (editable) wiki attached to the MOM6-examples GitHub repository. - Goto https://github.com/NOAA-GFDL/MOM6-examples/wiki and look at "Getting Started". + Go to https://github.com/NOAA-GFDL/MOM6-examples/wiki and look at "Getting Started". Installation, compilation and running are platform specific operations for which we can only provide templates (as is done in on the wiki) but for which MOM6 developers cannot possibly support since every platform is different. Normally @@ -31,4 +31,4 @@ Repository policies Policies governing how the repositories are organized and operated live at https://github.com/NOAA-GFDL/MOM6-examples/wiki/MOM6-repository-policies. Developer guide - Beyond the API reference above, developer specific wiki pages are attached to the `MOM6 code repository `. + Beyond the API reference above, developer specific wiki pages are attached to the `MOM6 code repository `_. diff --git a/docs/conf.py b/docs/conf.py index d705e19878..4407d88356 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2020, MOM6 developers' +copyright = u'2017-2022, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/docs/images/channel_drag.png b/docs/images/channel_drag.png new file mode 100644 index 0000000000..a665034ff0 Binary files /dev/null and b/docs/images/channel_drag.png differ diff --git a/docs/images/consortium.png b/docs/images/consortium.png index b349caf287..abe48e5b1d 100644 Binary files a/docs/images/consortium.png and b/docs/images/consortium.png differ diff --git a/docs/parameterizations_vertical.rst b/docs/parameterizations_vertical.rst index 4705cf6c48..ff0784b698 100644 --- a/docs/parameterizations_vertical.rst +++ b/docs/parameterizations_vertical.rst @@ -14,9 +14,13 @@ K-profile parameterization (KPP) Energetic Planetary Boundary Layer (ePBL) A energetically constrained boundary layer scheme following :cite:`reichl2018`. Implemented in MOM_energetic_PBL. + :ref:`EPBL` + Bulk mixed layer (BML) A 2-layer bulk mixed layer used in pure-isopycnal model. Implemented in MOM_bulk_mixed_layer. + :ref:`BML` + Interior and bottom-driven mixing --------------------------------- diff --git a/docs/zotero.bib b/docs/zotero.bib index bb400542b8..c0c7ee3bd9 100644 --- a/docs/zotero.bib +++ b/docs/zotero.bib @@ -2684,3 +2684,57 @@ @techreport{griffies2015a pages = {98 pp}, institution = {NOAA GFDL} } + +@inbook{niiler1977, + author = {P. P. Niiler and E. B. Kraus}, + chapter = {One-dimesional models of the upper ocean}, + title = {Modelling and Prediction of the Upper Layers of the Ocean}, + year = {1977}, + editor = {E. B. Kraus}, + publisher = {Pergamon Press} +} + +@article{oberhuber1993, + doi = {10.1175/1520-0485(1993)023<0830:sotacw>2.0.co;2}, + year = 1993, + publisher = {American Meteorological Society}, + volume = {23}, + number = {5}, + pages = {830--845}, + author = {J. M. Oberhuber}, + title = {Simulation of the Atlantic Circulation with a Coupled Sea Ice-Mixed Layer-Isopycnal General Circulation Model. Part {II}: Model Experiment}, + journal = {J. Phys. Oceanography} +} + +@techreport{muller2003, + doi = {10.21236/ada618366}, + year = 2003, + publisher = {Defense Technical Information Center}, + author = {P. Muller}, + institution = {School of Ocean and Earth Science and Technology}, + title = {A{\textquotesingle}ha Huliko{\textquotesingle}a Workshop Series} +} + +@article{wang2003, + doi = {10.1029/2003gl017869}, + year = 2003, + publisher = {American Geophysical Union ({AGU})}, + volume = {30}, + number = {18}, + author = {D. Wang}, + title = {Entrainment laws and a bulk mixed layer model of rotating convection derived from large-eddy simulations}, + journal = {Geophys. Res. Lett.} +} + +@article{kraus1967, + doi = {10.3402/tellusa.v19i1.9753}, + year = 1967, + publisher = {Informa {UK} Limited}, + volume = {19}, + number = {1}, + pages = {98--106}, + author = {E. B. Kraus and J. S. Turner}, + title = {A one-dimensional model of the seasonal thermocline {II}. The general theory and its consequences}, + journal = {Tellus} +} + diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 93696d3879..72afad16df 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -293,7 +293,7 @@ subroutine adjustGridForIntegrity( CS, G, GV, h ) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid thickness that - !! are to be adjusted [H ~> m or kg-2] + !! are to be adjusted [H ~> m or kg m-2] call inflate_vanished_layers_old( CS%regridCS, G, GV, h(:,:,:) ) end subroutine adjustGridForIntegrity @@ -334,7 +334,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta_preale - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] integer :: nk, i, j, k, isc, iec, jsc, jec logical :: ice_shelf @@ -378,7 +378,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) call diag_update_remap_grids(CS%diag) endif ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, -dzRegrid, & + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, dzRegrid, & u, v, CS%show_call_tree, dt ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") @@ -405,7 +405,7 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, OBC, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -413,7 +413,7 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, OBC, dt) real, optional, intent(in) :: dt !< Time step between calls to ALE_main [T ~> s] ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] integer :: nk, i, j, k, isc, iec, jsc, jec nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec @@ -459,21 +459,21 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) type(ALE_CS), pointer :: CS !< Regridding parameters and options type(ocean_grid_type), intent(in ) :: G !< Ocean grid informations type(verticalGrid_type), intent(in ) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites [Z2 T-1 ~> m2 s-1] logical, intent(in ) :: debug !< If true, then turn checksums type(ocean_OBC_type), pointer :: OBC !< Open boundary structure ! Local variables integer :: nk, i, j, k, isc, iec, jsc, jec - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2] real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZK_(GV)) :: h_src - real, dimension(SZK_(GV)) :: h_dest, uh_dest - real, dimension(SZK_(GV)) :: temp_vec + real, dimension(SZK_(GV)) :: h_src ! Source grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: h_dest ! Destination grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: temp_vec ! Transports on the destination grid [H L2 ~> m3 or kg] nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec dzRegrid(:,:,:) = 0.0 @@ -540,10 +540,10 @@ subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options type(ocean_OBC_type), pointer :: OBC !< Open boundary structure @@ -615,7 +615,7 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variable structure real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] logical, optional, intent(in) :: debug !< If true, show the call tree real, dimension(SZI_(G),SZJ_(G)), optional, intent(in):: frac_shelf_h !< Fractional ice shelf coverage [nondim] ! Local variables @@ -654,7 +654,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Original thicknesses [H ~> m or kg-2] + intent(inout) :: h !< Original thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) integer, intent(in) :: n !< Number of times to regrid real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -732,52 +732,57 @@ end subroutine ALE_regrid_accelerated !! new grids. When velocity components need to be remapped, thicknesses at !! velocity points are taken to be arithmetic averages of tracer thicknesses. !! This routine is called during initialization of the model at time=0, to -!! remap initiali conditions to the model grid. It is also called during a +!! remap initial conditions to the model grid. It is also called during a !! time step to update the state. subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, OBC, & - dxInterface, u, v, debug, dt) + dzInterface, u, v, debug, dt) type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(in) :: dxInterface !< Change in interface position - !! [H ~> m or kg-2] + optional, intent(in) :: dzInterface !< Change in interface position + !! [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] logical, optional, intent(in) :: debug !< If true, show the call tree real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s] + ! Local variables - integer :: i, j, k, m - integer :: nz, ntr - real, dimension(GV%ke+1) :: dx - real, dimension(GV%ke) :: h1, u_column - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont - real, dimension(SZI_(G), SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: ppt2mks - real, dimension(GV%ke) :: h2 - real :: h_neglect, h_neglect_edge + real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to + ! a velocity point [H ~> m or kg m-2] + real, dimension(GV%ke) :: h1 ! A column of initial thicknesses [H ~> m or kg m-2] + real, dimension(GV%ke) :: h2 ! A column of updated thicknesses [H ~> m or kg m-2] + real, dimension(GV%ke) :: u_column ! A column of properties, like tracer concentrations + ! or velocities, being remapped [various units] + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc ! The rate of change of concentrations [Conc T-1 ~> Conc s-1] + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont ! The rate of change of cell-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] or + ! cell thickness [H T-1 ~> m s-1 or Conc kg m-2 s-1] + real, dimension(SZI_(G), SZJ_(G)) :: work_2d ! The rate of change of column-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] logical :: show_call_tree type(tracer_type), pointer :: Tr => NULL() + integer :: i, j, k, m, nz, ntr show_call_tree = .false. if (present(debug)) show_call_tree = debug if (show_call_tree) call callTree_enter("remap_all_state_vars(), MOM_ALE.F90") - ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dxInterface. Otherwise, - ! u and v can be remapped without dxInterface - if ( .not. present(dxInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm "// & + ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise, + ! u and v can be remapped without dzInterface + if ( .not. present(dzInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then + call MOM_error(FATAL, "remap_all_state_vars: dzInterface must be present if using old algorithm "// & "and u/v are to be remapped") endif @@ -790,7 +795,6 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif nz = GV%ke - ppt2mks = 0.001 ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr @@ -856,20 +860,20 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap u velocity component if ( present(u) ) then - !$OMP parallel do default(shared) private(h1,h2,dx,u_column) + !$OMP parallel do default(shared) private(h1,h2,dz,u_column) do j = G%jsc,G%jec ; do I = G%iscB,G%iecB ; if (G%mask2dCu(I,j)>0.) then ! Build the start and final grids h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i+1,j,:) ) if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i+1,j,:) ) + dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i+1,j,:) ) do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo else h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) endif if (associated(OBC)) then - if (OBC%segnum_u(I,j) .ne. 0) then + if (OBC%segnum_u(I,j) /= 0) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) @@ -889,20 +893,20 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap v velocity component if ( present(v) ) then - !$OMP parallel do default(shared) private(h1,h2,dx,u_column) + !$OMP parallel do default(shared) private(h1,h2,dz,u_column) do J = G%jscB,G%jecB ; do i = G%isc,G%iec ; if (G%mask2dCv(i,j)>0.) then ! Build the start and final grids h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i,j+1,:) ) if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i,j+1,:) ) + dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i,j+1,:) ) do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo else h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) endif if (associated(OBC)) then - if (OBC%segnum_v(i,J) .ne. 0) then + if (OBC%segnum_v(i,J) /= 0) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) @@ -940,10 +944,10 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure integer, intent(in) :: nk_src !< Number of levels on source grid real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid logical, optional, intent(in) :: all_cells !< If false, only reconstruct for !! non-vanished cells. Use all vanished diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 35dcdaa819..94d7852851 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1275,8 +1275,8 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel !! [H ~> m or kg m-2] type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional - !! ice shelf coverage [nodim] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice + !! shelf coverage [nondim] ! Local variables integer :: nz integer :: i, j, k @@ -1412,14 +1412,14 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional - !! ice shelf coverage [nodim] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice shelf + !! coverage [nondim] ! Local variables real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [Pa] + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] integer :: i, j, k, nki real :: depth, nominalDepth real :: h_neglect, h_neglect_edge diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 016e4016eb..4d70f925aa 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -98,7 +98,7 @@ end subroutine set_hycom_params subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_col, z_col_new, zScale, h_neglect, h_neglect_edge) type(hycom_CS), intent(in) :: CS !< Coordinate control structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) real, dimension(nz), intent(in) :: T !< Temperature of column [degC] diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 6c9934ce38..4a9872d429 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -95,7 +95,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: T !< Temperature for source column [degC] real, dimension(nz), intent(in) :: S !< Salinity for source column [ppt] - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(CS%nk+1), & intent(inout) :: z_interface !< Absolute positions of interfaces real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (positive upward in the same @@ -208,7 +208,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ real, dimension(nz), intent(in) :: h !< Layer thicknesses in Z coordinates [Z ~> m] real, dimension(nz), intent(in) :: T !< T for column [degC] real, dimension(nz), intent(in) :: S !< S for column [ppt] - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 5cfa09213f..23a390456e 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -181,7 +181,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & nz, depth, h_col, T_col, S_col, p_col, z_col, z_col_new, & h_neglect, h_neglect_edge) type(slight_CS), intent(in) :: CS !< Coordinate control structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: H_to_pres !< A conversion factor from thicknesses to !! scaled pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] real, intent(in) :: H_subroundoff !< GV%H_subroundoff diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4072cf54a0..c36c0545e1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -76,11 +76,14 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_dyn_horgrid, only : rotate_dyn_horgrid use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze, EOS_domain use MOM_fixed_initialization, only : MOM_initialize_fixed use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_forcing_type, only : deallocate_mech_forcing, deallocate_forcing_type use MOM_forcing_type, only : rotate_forcing, rotate_mech_forcing +use MOM_forcing_type, only : copy_common_forcing_fields, set_derived_forcing_fields +use MOM_forcing_type, only : homogenize_forcing, homogenize_mech_forcing use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init @@ -124,11 +127,10 @@ module MOM use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state use MOM_tracer_flow_control, only : tracer_flow_control_end use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid -use MOM_transcribe_grid, only : rotate_dyngrid use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state -use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_variables, only : rotate_surface_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd @@ -137,6 +139,8 @@ module MOM use MOM_wave_interface, only : wave_parameters_CS, waves_end use MOM_wave_interface, only : Update_Stokes_Drift +use MOM_porous_barriers, only : porous_widths + ! ODA modules use MOM_oda_driver_mod, only : ODA_CS, oda, init_oda, oda_end use MOM_oda_driver_mod, only : set_prior_tracer, set_analysis_time, apply_oda_tracer_increments @@ -151,6 +155,7 @@ module MOM use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf +use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end implicit none ; private @@ -166,7 +171,7 @@ module MOM !>@{ 3-d state field diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 !>@} - !> 2-d state field diagnotic ID + !> 2-d state field diagnostic ID integer :: id_ssh_inst = -1 end type MOM_diag_IDs @@ -186,10 +191,10 @@ 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 [T m ~> s m]. + !< A running time integral of the sea surface height [T Z ~> 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] + !! with a correction for the inverse barometer [Z ~> m] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step [H ~> m or kg m-2] @@ -204,6 +209,8 @@ module MOM type(ocean_grid_type) :: G_in !< Input grid metric type(ocean_grid_type), pointer :: G => NULL() !< Model grid metric logical :: rotate_index = .false. !< True if index map is rotated + logical :: homogenize_forcings = .false. !< True if all inputs are homogenized + logical :: update_ustar = .false. !< True to update ustar from homogenized tau type(verticalGrid_type), pointer :: & GV => NULL() !< structure containing vertical grid info @@ -227,8 +234,7 @@ module MOM type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing type(vertvisc_type) :: visc !< structure containing vertical viscosities, !! bottom drag viscosities, and related fields - type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields - !! related to the Mesoscale Eddy Kinetic Energy + type(MEKE_type) :: MEKE !< Fields related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time @@ -248,7 +254,7 @@ module MOM 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 + integer :: nstep_tot = 0 !< The total number of dynamic timesteps taken !! so far in this run segment logical :: count_calls = .false. !< If true, count the calls to step_MOM, rather than the !! number of dynamics steps in nstep_tot @@ -277,7 +283,8 @@ module MOM type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied - !! by ice shelf [nondim] + !! by ice shelf [nondim] + real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2] real, dimension(:,:,:), pointer :: & h_pre_dyn => NULL(), & !< The thickness before the transports [H ~> m or kg m-2]. T_pre_dyn => NULL(), & !< Temperature before the transports [degC]. @@ -329,7 +336,9 @@ module MOM real :: bad_val_col_thick !< Minimum column thickness before triggering bad value message [Z ~> m] logical :: answers_2018 !< If true, use expressions for the surface properties that recover !! the answers from the end of 2018. Otherwise, use more appropriate - !! expressions that differ at roundoff for non-Boussinsq cases. + !! expressions that differ at roundoff for non-Boussinesq cases. + logical :: use_particles !< Turns on the particles package + character(len=10) :: particle_type !< Particle types include: surface(default), profiling and sail drone. type(MOM_diag_IDs) :: IDs !< Handles used for diagnostics. type(transport_diag_IDs) :: transport_IDs !< Handles used for transport diagnostics. @@ -345,21 +354,19 @@ module MOM !< Pointer to the control structure used for the unsplit RK2 dynamics type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL() !< Pointer to the control structure used for the mode-split RK2 dynamics - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() + type(thickness_diffuse_CS) :: thickness_diffuse_CSp !< Pointer to the control structure used for the isopycnal height diffusive transport. !! This is also common referred to as Gent-McWilliams diffusion - type(mixedlayer_restrat_CS), pointer :: mixedlayer_restrat_CSp => NULL() + type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp !< Pointer to the control structure used for the mixed layer restratification - type(set_visc_CS), pointer :: set_visc_CSp => NULL() + type(set_visc_CS) :: set_visc_CSp !< Pointer to the control structure used to set viscosities type(diabatic_CS), pointer :: diabatic_CSp => NULL() !< Pointer to the control structure for the diabatic driver - type(MEKE_CS), pointer :: MEKE_CSp => NULL() + type(MEKE_CS) :: MEKE_CSp !< Pointer to the control structure for the MEKE updates - type(VarMix_CS), pointer :: VarMix => NULL() - !< Pointer to the control structure for the variable mixing module - type(Barotropic_CS), pointer :: Barotropic_CSp => NULL() - !< Pointer to the control structure for the barotropic module + type(VarMix_CS) :: VarMix + !< Control structure for the variable mixing module type(tracer_registry_type), pointer :: tracer_Reg => NULL() !< Pointer to the MOM tracer registry type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() @@ -386,7 +393,7 @@ module MOM ! Pointers to control structures used for diagnostics type(sum_output_CS), pointer :: sum_output_CSp => NULL() !< Pointer to the globally summed output control structure - type(diagnostics_CS), pointer :: diagnostics_CSp => NULL() + type(diagnostics_CS) :: diagnostics_CSp !< Pointer to the MOM diagnostics control structure type(offline_transport_CS), pointer :: offline_CSp => NULL() !< Pointer to the offline tracer transport control structure @@ -397,6 +404,16 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors + type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) & + :: por_face_areaU !< fractional open area of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) & + :: por_face_areaV !< fractional open area of V-faces [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) & + :: por_layer_widthU !< fractional open width of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) & + :: por_layer_widthV !< fractional open width of V-faces [nondim] + type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure end type MOM_control_struct @@ -483,7 +500,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS 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 :: wt_end, wt_beg ! Fractional weights of the future pressure at the end + ! and beginning of the current time step [nondim] 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 [T ~> s]. @@ -504,7 +522,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. 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] + ssh ! sea surface height, which may be based on eta_av [Z ~> m] real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] @@ -566,6 +584,20 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS fluxes => fluxes_in endif + ! Homogenize the forces + if (CS%homogenize_forcings) then + ! Homogenize all forcing and fluxes fields. + call homogenize_mech_forcing(forces, G, US, GV%Rho0, CS%update_ustar) + ! Note the following computes the mean ustar as the mean of ustar rather than + ! ustar of the mean of tau. + call homogenize_forcing(fluxes, G) + if (CS%update_ustar) then + ! These calls corrects the ustar values + call copy_common_forcing_fields(forces, fluxes, G) + call set_derived_forcing_fields(forces, fluxes, G, US, GV%Rho0) + endif + endif + ! First determine the time step that is consistent with this call and an ! integer fraction of time_interval. if (do_dyn) then @@ -635,7 +667,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS CS%time_in_cycle = 0.0 do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then 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 calc_depth_function(G, CS%VarMix) @@ -860,7 +892,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, dZref=G%Z_ref) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -1020,6 +1052,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_por ! layer interface heights + !! for porous topo. [Z ~> m or 1/eta_to_m] G => CS%G ; GV => CS%GV ; US => CS%US ; IDs => CS%IDs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1034,7 +1068,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & 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)) & + if (CS%VarMix%use_variable_mixing) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1048,14 +1082,16 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call diag_update_remap_grids(CS%diag) endif + !update porous barrier fractional cell metrics + call porous_widths(h, CS%tv, G, GV, US, eta_por, CS%pbv) + ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then 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, & - CS%set_visc_CSp, symmetrize=.true.) + call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") call disable_averaging(CS%diag) @@ -1078,7 +1114,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & CS%eta_av_bc, G, GV, US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, & - CS%MEKE, CS%thickness_diffuse_CSp, waves=waves) + CS%MEKE, CS%thickness_diffuse_CSp, CS%pbv, waves=waves) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT @@ -1092,22 +1128,27 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%use_RK2) then call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE, CS%pbv) else call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, CS%pbv, Waves=Waves) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") endif ! -------------------------------------------------- end SPLIT + if (CS%use_particles .and. CS%do_dynamics) then ! Run particles whether or not stepping is split + call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model + endif + + if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) - if (associated(CS%VarMix)) & + if (CS%VarMix%use_variable_mixing) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1195,7 +1236,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) @@ -1291,6 +1332,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & integer :: halo_sz ! The size of a halo where data must be valid. integer :: i, j, k, is, ie, js, je, nz + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_por ! layer interface heights + !! for porous topo. [Z ~> m or 1/eta_to_m] + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_thermo(), MOM.F90") @@ -1326,7 +1370,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics ! and set_viscous_BBL is called as a part of the dynamic stepping. call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, symmetrize=.true.) + !update porous barrier fractional cell metrics + call porous_widths(h, CS%tv, G, GV, US, eta_por, CS%pbv) + call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") endif @@ -1347,7 +1393,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS,OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS, CS%OBC, Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1421,7 +1467,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) @@ -1466,7 +1512,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval + real, intent(in) :: time_interval !< time interval [s] type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM ! Local pointers @@ -1494,12 +1540,12 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! 3D pointers real, dimension(:,:,:), pointer :: & - uhtr => NULL(), vhtr => NULL(), & - eatr => NULL(), ebtr => NULL(), & - h_end => NULL() + uhtr => NULL(), & ! Accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] + vhtr => NULL(), & ! Accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] + eatr => NULL(), & ! Layer entrainment rates across the interface above [H ~> m or kg m-2] + ebtr => NULL(), & ! Layer entrainment rates across the interface below [H ~> m or kg m-2] + h_end => NULL() ! Layer thicknesses at the end of a step [H ~> m or kg m-2] - ! 2D Array for diagnostics - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end type(time_type) :: Time_end ! End time of a segment, as a time type ! Grid-related pointer assignments @@ -1544,47 +1590,48 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & ! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm) ! call update_transport_from_arrays(CS%offline_CSp) - call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) + call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm) ! Apply any fluxes into the ocean call offline_fw_fluxes_into_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) if (.not.CS%diabatic_first) then - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport - call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif endif ! The functions related to column physics of tracers is performed separately in ALE mode if (do_vertical) then - call offline_diabatic_ale(fluxes, Time_start, Time_end, CS%offline_CSp, CS%h, eatr, ebtr) + call offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS%offline_CSp, & + CS%h, eatr, ebtr) endif ! Last thing that needs to be done is the final ALE remapping if (last_iter) then if (CS%diabatic_first) then - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport and perform the remaining advection - call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -1601,7 +1648,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) ! These diagnostic can be used to identify which grid points did not converge within ! the specified number of advection sub iterations - call post_offline_convergence_diags(CS%offline_CSp, CS%h, h_end, uhtr, vhtr) + call post_offline_convergence_diags(G, GV, CS%offline_CSp, CS%h, h_end, uhtr, vhtr) ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses ! stored from the forward run @@ -1620,9 +1667,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif - call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) - call offline_advection_layer(fluxes, Time_start, time_interval, CS%offline_CSp, & - CS%h, eatr, ebtr, uhtr, vhtr) + call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm) + call offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then call tracer_hordiff(h_end, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & @@ -1688,7 +1735,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(hor_index_type), pointer :: HI => NULL() ! A hor_index_type for array extents type(hor_index_type), target :: HI_in ! HI on the input grid type(verticalGrid_type), pointer :: GV => NULL() - type(dyn_horgrid_type), pointer :: dG => NULL() + type(dyn_horgrid_type), pointer :: dG => NULL(), test_dG => NULL() type(dyn_horgrid_type), pointer :: dG_in => NULL() type(diag_ctrl), pointer :: diag => NULL() type(unit_scale_type), pointer :: US => NULL() @@ -1696,9 +1743,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: turns ! Number of grid quarter-turns ! Initial state on the input index map - real, allocatable, dimension(:,:,:) :: u_in, v_in, h_in - real, allocatable, dimension(:,:), target :: frac_shelf_in - real, allocatable, dimension(:,:,:), target :: T_in, S_in + real, allocatable :: u_in(:,:,:) ! Initial zonal velocities [L T-1 ~> m s-1] + real, allocatable :: v_in(:,:,:) ! Initial meridional velocities [L T-1 ~> m s-1] + real, allocatable :: h_in(:,:,:) ! Initial layer thicknesses [H ~> m or kg m-2] + real, allocatable, target :: frac_shelf_in(:,:) ! Initial fraction of the total cell area occupied + ! by an ice shelf [nondim] + real, allocatable, target :: mass_shelf_in(:,:) ! Initial mass of ice shelf contained within a grid cell + ! [R Z ~> kg m-2] + real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [degC] + real, allocatable, target :: S_in(:,:,:) ! Initial salinities [ppt] + type(ocean_OBC_type), pointer :: OBC_in => NULL() type(sponge_CS), pointer :: sponge_in_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL() @@ -1709,7 +1763,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB - real :: dtbt ! The barotropic timestep [s] + real :: dtbt ! If negative, this specifies the barotropic timestep as a fraction + ! of the maximum stable value [nondim]. real, allocatable, dimension(:,:) :: eta ! free surface height or column mass [H ~> m or kg m-2] real, allocatable, dimension(:,:) :: area_shelf_in ! area occupied by ice shelf [L2 ~> m2] @@ -1730,7 +1785,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: bulkmixedlayer ! If true, a refined bulk mixed layer scheme is used ! with nkml sublayers and nkbl buffer layer. - logical :: use_temperature ! If true, temp and saln used as state variables. + logical :: use_temperature ! If true, temperature and salinity used as state variables. logical :: use_frazil ! If true, liquid seawater freezes if temp below freezing, ! with accumulated heat deficit returned to surface ocean. logical :: bound_salinity ! If true, salt is added to keep salinity above @@ -1752,12 +1807,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the - ! calculation. This can be altered during the course - ! of the run via calls to set_first_direction. + ! calculation. integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt + real :: conv2watt ! A conversion factor from temperature fluxes to heat + ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] + real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: flux_units, S_flux_units @@ -2024,7 +2080,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "direction updates occur first in directionally split parts of the calculation. "//& "If this is true, FIRST_DIRECTION applies at the start of a new run or if "//& "the next first direction can not be found in the restart file.", default=.false.) - call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", CS%check_bad_sfc_vals, & "If true, check the surface state for ridiculous values.", & default=.false.) @@ -2097,6 +2152,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If true, enables the ice shelf model.", default=.false.) endif + call get_param(param_file, "MOM", "USE_PARTICLES", CS%use_particles, & + "If true, use the particles package.", default=.false.) + CS%ensemble_ocean=.false. call get_param(param_file, "MOM", "ENSEMBLE_OCEAN", CS%ensemble_ocean, & "If False, The model is being run in serial mode as a single realization. "//& @@ -2106,6 +2164,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("MOM parameters read (initialize_MOM)") + call get_param(param_file, "MOM", "HOMOGENIZE_FORCINGS", CS%homogenize_forcings, & + "If True, homogenize the forces and fluxes.", default=.false.) + call get_param(param_file, "MOM", "UPDATE_USTAR",CS%update_ustar, & + "If True, update ustar from homogenized tau when using the "//& + "HOMOGENIZE_FORCINGS option. Note that this will not work "//& + "with a non-zero gustiness factor.", default=.false., & + do_not_log=.not.CS%homogenize_forcings) + ! Grid rotation test call get_param(param_file, "MOM", "ROTATE_INDEX", CS%rotate_index, & "Enable rotation of the horizontal indices.", default=.false., & @@ -2119,6 +2185,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (num_PEs() /= 1) & call MOM_error(FATAL, "Index rotation is only supported on one PE.") + ! Alternate_first_direction is not permitted with index rotation. + ! This feature can be added later in the future if needed. + if (CS%alternate_first_direction) & + call MOM_error(FATAL, "Alternating_first_direction is not compatible with index rotation.") + call get_param(param_file, "MOM", "INDEX_TURNS", turns, & "Number of counterclockwise quarter-turn index rotations.", & default=1, debuggingParam=.true.) @@ -2145,14 +2216,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Swap axes for quarter and 3-quarter turns if (CS%rotate_index) then allocate(CS%G) - call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, & - domain_name="MOM_rot") - first_direction = modulo(first_direction + turns, 2) + call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, domain_name="MOM_rot") else CS%G => G_in endif - ! TODO: It is unlikey that test_grid_copy and rotate_index would work at the + ! TODO: It is unlikely that test_grid_copy and rotate_index would work at the ! same time. It may be possible to enable both but for now we prevent it. if (test_grid_copy .and. CS%rotate_index) & call MOM_error(FATAL, "Grid cannot be copied during index rotation.") @@ -2171,19 +2240,34 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & local_indexing=.not.global_indexing) call create_dyn_horgrid(dG_in, HI_in, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G_in%Domain, dG_in%Domain) + ! Also allocate the input ocean_grid_type type at this point based on the same information. + call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) ! Allocate initialize time-invariant MOM variables. call MOM_initialize_fixed(dG_in, US, OBC_in, param_file, .false., dirs%output_directory) + ! Copy the grid metrics and bathymetry to the ocean_grid_type + call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) + call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - ! Determine HI and dG for the model index map. + call verticalGridInit( param_file, CS%GV, US ) + GV => CS%GV + + ! Shift from using the temporary dynamic grid type to using the final (potentially static) + ! and properly rotated ocean-specific grid type and horizontal index type. if (CS%rotate_index) then allocate(HI) call rotate_hor_index(HI_in, turns, HI) + ! NOTE: If indices are rotated, then G and G_in must both be initialized separately, and + ! the dynamic grid must be created to handle the grid rotation. G%domain has already been + ! initialized above. + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) call create_dyn_horgrid(dG, HI, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G%Domain, dG%Domain) - call rotate_dyngrid(dG_in, dG, US, turns) + call rotate_dyn_horgrid(dG_in, dG, US, turns) + call copy_dyngrid_to_MOM_grid(dG, G, US) + if (associated(OBC_in)) then ! TODO: General OBC index rotations is not yet supported. if (modulo(turns, 4) /= 1) & @@ -2191,18 +2275,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & allocate(CS%OBC) call rotate_OBC_config(OBC_in, dG_in, CS%OBC, dG, turns) endif + + call destroy_dyn_horgrid(dG) else + ! If not rotated, then G_in and G are the same grid. HI => HI_in - dG => dG_in + G => G_in CS%OBC => OBC_in endif - - call verticalGridInit( param_file, CS%GV, US ) - GV => CS%GV - - ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. - if (CS%debug .or. dG%symmetric) & - call clone_MOM_domain(dG%Domain, dG%Domain_aux, symmetric=.false.) + ! dG_in is retained for now so that it can be used with write_ocean_geometry_file() below. call callTree_waypoint("grids initialized (initialize_MOM)") @@ -2211,9 +2292,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call tracer_registry_init(param_file, CS%tracer_Reg) ! Allocate and initialize space for the primary time-varying MOM variables. - is = dG%isc ; ie = dG%iec ; js = dG%jsc ; je = dG%jec ; nz = GV%ke - isd = dG%isd ; ied = dG%ied ; jsd = dG%jsd ; jed = dG%jed - IsdB = dG%IsdB ; IedB = dG%IedB ; JsdB = dG%JsdB ; JedB = dG%JedB + is = HI%isc ; ie = HI%iec ; js = HI%jsc ; je = HI%jec ; nz = GV%ke + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed + IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H @@ -2250,12 +2331,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else conv2salt = GV%H_to_kg_m2 endif - call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & + call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & flux_units='W', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) - call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, dG%HI, GV, & + call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_S, registry_diags=.true., flux_nameroot='S', & flux_units=S_flux_units, flux_longname='Salt', & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & @@ -2311,10 +2392,20 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 ! -G%Z_ref CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0 + !allocate porous topography variables + ALLOC_(CS%por_face_areaU(IsdB:IedB,jsd:jed,nz)) ; CS%por_face_areaU(:,:,:) = 1.0 + ALLOC_(CS%por_face_areaV(isd:ied,JsdB:JedB,nz)) ; CS%por_face_areaV(:,:,:) = 1.0 + ALLOC_(CS%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1)) ; CS%por_layer_widthU(:,:,:) = 1.0 + ALLOC_(CS%por_layer_widthV(isd:ied,JsdB:JedB,nz+1)) ; CS%por_layer_widthV(:,:,:) = 1.0 + CS%pbv%por_face_areaU => CS%por_face_areaU; CS%pbv%por_face_areaV=> CS%por_face_areaV + CS%pbv%por_layer_widthU => CS%por_layer_widthU; CS%pbv%por_layer_widthV => CS%por_layer_widthV ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate ! initialization routine for tv. - if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state, US) + if (use_EOS) then + allocate(CS%tv%eqn_of_state) + call EOS_init(param_file, CS%tv%eqn_of_state, US) + endif if (use_temperature) then allocate(CS%tv%TempxPmE(isd:ied,jsd:jed), source=0.0) if (use_geothermal) then @@ -2328,24 +2419,24 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call restart_init(param_file, restart_CSp) call set_restart_fields(GV, US, param_file, CS, restart_CSp) if (CS%split) then - call register_restarts_dyn_split_RK2(dG%HI, GV, param_file, & + call register_restarts_dyn_split_RK2(HI, GV, param_file, & CS%dyn_split_RK2_CSp, restart_CSp, CS%uh, CS%vh) elseif (CS%use_RK2) then - call register_restarts_dyn_unsplit_RK2(dG%HI, GV, param_file, & - CS%dyn_unsplit_RK2_CSp, restart_CSp) + call register_restarts_dyn_unsplit_RK2(HI, GV, param_file, & + CS%dyn_unsplit_RK2_CSp) else - call register_restarts_dyn_unsplit(dG%HI, GV, param_file, & - CS%dyn_unsplit_CSp, restart_CSp) + call register_restarts_dyn_unsplit(HI, GV, param_file, & + CS%dyn_unsplit_CSp) endif ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(dG%HI, GV, US, param_file, CS%tracer_flow_CSp, & + call call_tracer_register(HI, GV, US, param_file, CS%tracer_flow_CSp, & CS%tracer_Reg, restart_CSp) - call MEKE_alloc_register_restart(dG%HI, param_file, CS%MEKE, restart_CSp) - call set_visc_register_restarts(dG%HI, GV, param_file, CS%visc, restart_CSp) - call mixedlayer_restrat_register_restarts(dG%HI, param_file, & + call MEKE_alloc_register_restart(HI, param_file, CS%MEKE, restart_CSp) + call set_visc_register_restarts(HI, GV, param_file, CS%visc, restart_CSp) + call mixedlayer_restrat_register_restarts(HI, param_file, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%rotate_index .and. associated(OBC_in) .and. use_temperature) then @@ -2374,33 +2465,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This needs the number of tracers and to have called any code that sets whether ! reservoirs are used. - call open_boundary_register_restarts(dg%HI, GV, CS%OBC, CS%tracer_Reg, & + call open_boundary_register_restarts(HI, GV, CS%OBC, CS%tracer_Reg, & param_file, restart_CSp, use_temperature) endif call callTree_waypoint("restart registration complete (initialize_MOM)") call restart_registry_lock(restart_CSp) - ! Shift from using the temporary dynamic grid type to using the final - ! (potentially static) ocean-specific grid type. - ! The next line would be needed if G%Domain had not already been init'd above: - ! call clone_MOM_domain(dG%Domain, G%Domain) - - ! NOTE: If indices are rotated, then G and G_in must both be initialized. - ! If not rotated, then G_in and G are the same grid. - if (CS%rotate_index) then - call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G, US) - call destroy_dyn_horgrid(dG) - endif - call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) - if (.not. CS%rotate_index) G => G_in - + ! Write out all of the grid data used by this run. new_sim = determine_is_new_run(dirs%input_filename, dirs%restart_input_dir, G_in, restart_CSp) write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. new_sim)) - - ! Write out all of the grid data used by this run. if (write_geom_files) call write_ocean_geometry_file(dG_in, param_file, dirs%output_directory, US=US) call destroy_dyn_horgrid(dG_in) @@ -2417,8 +2491,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif ! Set a few remaining fields that are specific to the ocean grid type. - call set_first_direction(G, first_direction) - CS%first_dir_restart = real(G%first_direction) + if (CS%rotate_index) then + call set_first_direction(G, modulo(first_direction + turns, 2)) + else + call set_first_direction(G, modulo(first_direction, 2)) + endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) @@ -2448,14 +2525,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr) allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) + allocate(mass_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) - call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) + allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) + call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) ! MOM_initialize_state is using the unrotated metric call rotate_array(CS%frac_shelf_h, -turns, frac_shelf_in) + call rotate_array(CS%mass_shelf, -turns, mass_shelf_in) call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & sponge_in_CSp, ALE_sponge_in_CSp, oda_incupd_in_CSp, OBC_in, Time_in, & - frac_shelf_h=frac_shelf_in) + frac_shelf_h=frac_shelf_in, mass_shelf = mass_shelf_in) else call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2467,11 +2547,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%tv%S => CS%S endif - ! Reset the first direction if it was found in a restart file. - if (CS%first_dir_restart > -0.5) & - call set_first_direction(G, NINT(CS%first_dir_restart)) - ! Store the first direction for the next time a restart file is written. - CS%first_dir_restart = real(G%first_direction) + ! Reset the first direction if it was found in a restart file + if (CS%first_dir_restart > -1.0) then + call set_first_direction(G, modulo(NINT(CS%first_dir_restart) + turns, 2)) + else + CS%first_dir_restart = real(modulo(first_direction, 2)) + endif call rotate_initial_state(u_in, v_in, h_in, T_in, S_in, use_temperature, & turns, CS%u, CS%v, CS%h, CS%T, CS%S) @@ -2498,25 +2579,35 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & deallocate(S_in) endif if (use_ice_shelf) & - deallocate(frac_shelf_in) + deallocate(frac_shelf_in,mass_shelf_in) else if (use_ice_shelf) then call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) - call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) + allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) + call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp,CS%oda_incupd_CSp, CS%OBC, Time_in, & - frac_shelf_h=CS%frac_shelf_h) + frac_shelf_h=CS%frac_shelf_h, mass_shelf=CS%mass_shelf) else call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp, CS%OBC, Time_in) endif + + ! Reset the first direction if it was found in a restart file. + if (CS%first_dir_restart > -1.0) then + call set_first_direction(G, NINT(CS%first_dir_restart)) + else + CS%first_dir_restart = real(modulo(first_direction, 2)) + endif endif - if (use_ice_shelf .and. CS%debug) & + if (use_ice_shelf .and. CS%debug) then call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0) + call hchksum(CS%mass_shelf, "MOM:mass_shelf", G%HI, haloshift=0,scale=US%RZ_to_kg_m2) + endif call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") @@ -2526,16 +2617,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (test_grid_copy) then ! Copy the data from the temporary grid to the dyn_hor_grid to CS%G. - call create_dyn_horgrid(dG, G%HI) - call clone_MOM_domain(G%Domain, dG%Domain) + call create_dyn_horgrid(test_dG, G%HI) + call clone_MOM_domain(G%Domain, test_dG%Domain) call clone_MOM_domain(G%Domain, CS%G%Domain) call MOM_grid_init(CS%G, param_file, US) - call copy_MOM_grid_to_dyngrid(G, dg, US) - call copy_dyngrid_to_MOM_grid(dg, CS%G, US) + call copy_MOM_grid_to_dyngrid(G, test_dG, US) + call copy_dyngrid_to_MOM_grid(test_dG, CS%G, US) - call destroy_dyn_horgrid(dG) + call destroy_dyn_horgrid(test_dG) call MOM_grid_end(G) ; deallocate(G) G => CS%G @@ -2645,7 +2736,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & CS%thickness_diffuse_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & - CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt, cont_stencil=CS%cont_stencil) + CS%visc, dirs, CS%ntrunc, CS%pbv, calc_dtbt=calc_dtbt, cont_stencil=CS%cont_stencil) if (CS%dtbt_reset_period > 0.0) then CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. @@ -2660,14 +2751,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & - param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + param_file, diag, CS%dyn_unsplit_RK2_CSp, & + CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & - param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + param_file, diag, CS%dyn_unsplit_CSp, & + CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) endif @@ -2740,10 +2831,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Setup some initial parameterizations and also assign some of the subtypes call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & - diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & - tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & + diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & + tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug ) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US) endif !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM @@ -2816,11 +2907,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then + if (query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z /= US%m_to_Z_restart) ) then + Z_rescale = US%m_to_Z / US%m_to_Z_restart + do j=js,je ; do i=is,ie + CS%ave_ssh_ibc(i,j) = Z_rescale * CS%ave_ssh_ibc(i,j) + enddo ; enddo + endif + else if (CS%split) then - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, dZref=G%Z_ref) else - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, dZref=G%Z_ref) endif endif if (CS%split) deallocate(eta) @@ -2878,6 +2976,11 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) call fix_restart_scaling(GV) call fix_restart_unit_scaling(US) + + if (CS%use_particles) then + call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v) + endif + ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) @@ -2924,7 +3027,7 @@ subroutine register_diags(Time, G, GV, US, IDs, diag) 'Layer Thickness after the dynamics update', thickness_units, conversion=GV%H_to_MKS, & v_extensive=.true.) IDs%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, & - Time, 'Instantaneous Sea Surface Height', 'm') + Time, 'Instantaneous Sea Surface Height', 'm', conversion=US%Z_to_m) end subroutine register_diags !> Set up CPU clock IDs for timing various subroutines. @@ -3044,39 +3147,39 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [m] - real, dimension(:,:), optional, pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] - logical, optional, intent(in) :: use_EOS !< If true, calculate the density for + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [Z ~> m] + real, dimension(:,:), pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] + logical, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. real :: Rho_conv(SZI_(G)) ! The density used to convert surface pressure to ! a corrected effective SSH [R ~> kg m-3]. - real :: IgR0 ! The SSH conversion factor from R L2 T-2 to m [m T2 R-1 L-2 ~> m Pa-1]. + real :: IgR0 ! The SSH conversion factor from R L2 T-2 to Z [Z T2 R-1 L-2 ~> m Pa-1]. logical :: calc_rho integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec EOSdom(:) = EOS_domain(G%HI) - if (present(p_atm)) then ; if (associated(p_atm)) then - calc_rho = associated(tv%eqn_of_state) - if (present(use_EOS) .and. calc_rho) calc_rho = use_EOS + if (associated(p_atm)) then + calc_rho = use_EOS .and. associated(tv%eqn_of_state) ! Correct the output sea surface height for the contribution from the ice pressure. do j=js,je if (calc_rho) then call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, & tv%eqn_of_state, EOSdom) do i=is,ie - IgR0 = US%Z_to_m / (Rho_conv(i) * GV%g_Earth) + IgR0 = 1.0 / (Rho_conv(i) * GV%g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo else + IgR0 = 1.0 / (GV%Rho0 * GV%g_Earth) do i=is,ie - ssh(i,j) = ssh(i,j) + p_atm(i,j) * (US%Z_to_m / (GV%Rho0 * GV%g_Earth)) + ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo endif enddo - endif ; endif + endif end subroutine adjust_ssh_for_p_atm @@ -3110,7 +3213,7 @@ subroutine extract_surface_state(CS, sfc_state_in) !! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1] ! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1. real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [Z degC ~> m degC] - logical :: use_temperature !< If true, temp and saln used as state variables. + logical :: use_temperature !< If true, temperature and salinity are used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB @@ -3157,7 +3260,7 @@ subroutine extract_surface_state(CS, sfc_state_in) sfc_state%S_is_absS = CS%tv%S_is_absS do j=js,je ; do i=is,ie - sfc_state%sea_lev(i,j) = US%m_to_Z*CS%ave_ssh_ibc(i,j) + sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) enddo ; enddo if (allocated(sfc_state%frazil) .and. associated(CS%tv%frazil)) then ; do j=js,je ; do i=is,ie @@ -3454,7 +3557,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3463,7 +3566,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif @@ -3496,10 +3599,18 @@ end subroutine extract_surface_state !> Rotate initialization fields from input to rotated arrays. subroutine rotate_initial_state(u_in, v_in, h_in, T_in, S_in, & use_temperature, turns, u, v, h, T, S) - real, dimension(:,:,:), intent(in) :: u_in, v_in, h_in, T_in, S_in - logical, intent(in) :: use_temperature - integer, intent(in) :: turns - real, dimension(:,:,:), intent(out) :: u, v, h, T, S + real, dimension(:,:,:), intent(in) :: u_in !< Zonal velocity on the initial grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(in) :: v_in !< Meridional velocity on the initial grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(in) :: h_in !< Layer thickness on the initial grid [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: T_in !< Temperature on the initial grid [degC] + real, dimension(:,:,:), intent(in) :: S_in !< Salinity on the initial grid [ppt] + logical, intent(in) :: use_temperature !< If true, temperature and salinity are active + integer, intent(in) :: turns !< The number quarter-turns to apply + real, dimension(:,:,:), intent(out) :: u !< Zonal velocity on the rotated grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(out) :: v !< Meridional velocity on the rotated grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(out) :: h !< Layer thickness on the rotated grid [H ~> m or kg m-2] + real, dimension(:,:,:), intent(out) :: T !< Temperature on the rotated grid [degC] + real, dimension(:,:,:), intent(out) :: S !< Salinity on the rotated grid [ppt] call rotate_vector(u_in, v_in, turns, u, v) call rotate_array(h_in, turns, h) @@ -3538,7 +3649,7 @@ subroutine get_MOM_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp) type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type real, optional, intent(out) :: C_p !< The heat capacity [J kg degC-1] real, optional, intent(out) :: C_p_scaled !< The heat capacity in scaled - !! units [Q degC-1 ~> J kg degC-1] + !! units [Q degC-1 ~> J kg-1 degC-1] logical, optional, intent(out) :: use_temp !< True if temperature is a state variable if (present(G)) G => CS%G_in @@ -3570,10 +3681,18 @@ end subroutine get_ocean_stocks subroutine MOM_end(CS) type(MOM_control_struct), intent(inout) :: CS !< MOM control structure + if (CS%use_particles) then + call particles_save_restart(CS%particles) + endif + call MOM_sum_output_end(CS%sum_output_CSp) if (CS%use_ALE_algorithm) call ALE_end(CS%ALE_CSp) + !deallocate porous topography variables + DEALLOC_(CS%por_face_areaU) ; DEALLOC_(CS%por_face_areaV) + DEALLOC_(CS%por_layer_widthU) ; DEALLOC_(CS%por_layer_widthV) + ! NOTE: Allocated in PressureForce_FV_Bouss if (associated(CS%tv%varT)) deallocate(CS%tv%varT) @@ -3588,7 +3707,6 @@ subroutine MOM_end(CS) endif call MOM_diagnostics_end(CS%diagnostics_CSp, CS%ADp, CS%CDp) - deallocate(CS%diagnostics_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) @@ -3600,26 +3718,15 @@ subroutine MOM_end(CS) call end_dyn_unsplit(CS%dyn_unsplit_CSp) endif - call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - deallocate(CS%thickness_diffuse_CSp) - - if (associated(CS%VarMix)) then - call VarMix_end(CS%VarMix) - deallocate(CS%VarMix) + if (CS%use_particles) then + call particles_end(CS%particles) + deallocate(CS%particles) endif - if (associated(CS%mixedlayer_restrat_CSp)) & - deallocate(CS%mixedlayer_restrat_CSp) - - if (associated(CS%set_visc_CSp)) & - call set_visc_end(CS%visc, CS%set_visc_CSp) - - if (associated(CS%MEKE_CSp)) deallocate(CS%MEKE_CSp) - - if (associated(CS%MEKE)) then - call MEKE_end(CS%MEKE) - deallocate(CS%MEKE) - endif + call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) + call VarMix_end(CS%VarMix) + call set_visc_end(CS%visc, CS%set_visc_CSp) + call MEKE_end(CS%MEKE) if (associated(CS%tv%internal_heat)) deallocate(CS%tv%internal_heat) if (associated(CS%tv%TempxPmE)) deallocate(CS%tv%TempxPmE) @@ -3824,29 +3931,48 @@ end subroutine MOM_end !! !! \verbatim !! ../MOM +!! |-- ac !! |-- config_src -!! | |-- coupled_driver -!! | |-- dynamic -!! | `-- solo_driver -!! |-- examples -!! | |-- CM2G +!! | |-- drivers +!! | ! |-- FMS_cap +!! | ! |-- ice_solo_driver +!! | ! |-- mct_cap +!! | ! |-- nuopc_cap +!! | ! |-- solo_driver +!! | ! `-- unit_drivers +!! | |-- external +!! | ! |-- drifters +!! | ! |-- GFDL_ocean_BGC +!! | ! `-- ODA_hooks +!! | |-- infra +!! | ! |-- FMS1 +!! | ! `-- FMS2 +!! | `-- memory +!! | ! |-- dynamic_nonsymmetric +!! | ! `-- dynamic_symmetric +!! |-- docs +!! |-- pkg +!! | |-- CVMix-src !! | |-- ... -!! | `-- torus_advection_test +!! | `-- MOM6_DA_hooks !! `-- src +!! |-- ALE !! |-- core !! |-- diagnostics !! |-- equation_of_state !! |-- framework !! |-- ice_shelf !! |-- initialization +!! |-- ocean_data_assim !! |-- parameterizations +!! | |-- CVMix !! | |-- lateral !! | `-- vertical !! |-- tracer !! `-- user !! \endverbatim !! -!! Rather than describing each file here, each directory contents +!! Rather than describing each file here, selected directory contents !! will be described to give a broad overview of the MOM code !! structure. !! @@ -3855,27 +3981,35 @@ end subroutine MOM_end !! Only one or two of these directories are used in compiling any, !! particular run. !! -!! * config_src/coupled_driver: +!! * config_src/drivers/FMS-cap: !! The files here are used to couple MOM as a component in a larger !! run driven by the FMS coupler. This includes code that converts !! various forcing fields into the code structures and flux and unit !! conventions used by MOM, and converts the MOM surface fields !! back to the forms used by other FMS components. !! -!! * config_src/dynamic: -!! The only file here is the version of MOM_memory.h that is used -!! for dynamic memory configurations of MOM. +!! * config_src/drivers/nuopc-cap: +!! The files here are used to couple MOM as a component in a larger +!! run driven by the NUOPC coupler. This includes code that converts +!! various forcing fields into the code structures and flux and unit +!! conventions used by MOM, and converts the MOM surface fields +!! back to the forms used by other NUOPC components. !! -!! * config_src/solo_driver: +!! * config_src/drivers/solo_driver: !! The files here are include the _main driver that is used when !! MOM is configured as an ocean-only model, as well as the files !! that specify the surface forcing in this configuration. !! -!! The directories under examples provide a large number of working -!! configurations of MOM, along with reference solutions for several -!! different compilers on GFDL's latest large computer. The versions -!! of MOM_memory.h in these directories need not be used if dynamic -!! memory allocation is desired, and the answers should be unchanged. +!! * config_src/external: +!! The files here are mostly just stubs, so that MOM6 can compile +!! with calls to the public interfaces external packages, but +!! without actually requiring those packages themselves. In more +!! elaborate configurations, would be linked to the actual code for +!! those external packages rather than these simple stubs. +!! +!! * config_src/memory/dynamic-symmetric: +!! The only file here is the version of MOM_memory.h that is used +!! for dynamic memory configurations of MOM. !! !! The directories under src contain most of the MOM files. These !! files are used in every configuration using MOM. @@ -3888,7 +4022,7 @@ end subroutine MOM_end !! subroutine argument lists. !! !! * src/diagnostics: -!! The files here calculate various diagnostics that are anciliary +!! The files here calculate various diagnostics that are ancilliary !! to the model itself. While most of these diagnostics do not !! directly affect the model's solution, there are some, like the !! calculation of the deformation radius, that are used in some @@ -3945,13 +4079,19 @@ end subroutine MOM_end !! to build an appropriate makefile, and path_names should be edited !! to reflect the actual location of the desired source code. !! +!! The separate MOM-examples git repository provides a large number +!! of working configurations of MOM, along with reference solutions for several +!! different compilers on GFDL's latest large computer. The versions +!! of MOM_memory.h in these directories need not be used if dynamic +!! memory allocation is desired, and the answers should be unchanged. +!! !! !! There are 3 publicly visible subroutines in this file (MOM.F90). !! * step_MOM steps MOM over a specified interval of time. !! * MOM_initialize calls initialize and does other initialization !! that does not warrant user modification. !! * extract_surface_state determines the surface (bulk mixed layer -!! if traditional isoycnal vertical coordinate) properties of the +!! if traditional isopycnal vertical coordinate) properties of the !! current model state and packages pointers to these fields into an !! exported structure. !! diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e4d97ab53a..19f14ceac3 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -6,6 +6,8 @@ module MOM_CoriolisAdv !> \author Robert Hallberg, April 1994 - June 2002 use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -14,7 +16,7 @@ module MOM_CoriolisAdv use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : accel_diag_ptrs +use MOM_variables, only : accel_diag_ptrs, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -25,6 +27,7 @@ module MOM_CoriolisAdv !> Control structure for mom_coriolisadv type, public :: CoriolisAdv_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. integer :: Coriolis_Scheme !< Selects the discretization for the Coriolis terms. !! Valid values are: !! - SADOURNY75_ENERGY - Sadourny, 1975 @@ -117,8 +120,8 @@ module MOM_CoriolisAdv contains !> Calculates the Coriolis and momentum advection contributions to the acceleration. -subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure +subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] @@ -134,7 +137,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -161,7 +165,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H L2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], + KEy, & ! The meridional gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEy = d/dy KE. vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -169,7 +173,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) ! [H L2 T-1 ~> m3 s-1 or kg s-1]. ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb - ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. + ! discretization [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1] rel_vort, & ! Relative vorticity at q-points [T-1 ~> s-1]. @@ -202,51 +206,33 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uhm, vhm ! The input estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme. + real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme [nondim] - real :: Fe_m2 ! Nondimensional temporary variables asssociated with - real :: rat_lin ! the ARAKAWA_LAMB_BLEND scheme. + real :: Fe_m2 ! Temporary variable associated with the ARAKAWA_LAMB_BLEND scheme [nondim] + real :: rat_lin ! Temporary variable associated with the ARAKAWA_LAMB_BLEND scheme [nondim] real :: rat_m1 ! The ratio of the maximum neighboring inverse thickness - ! to the minimum inverse thickness minus 1. rat_m1 >= 0. + ! to the minimum inverse thickness minus 1 [nondim]. rat_m1 >= 0. real :: AL_wt ! The relative weight of the Arakawa & Lamb scheme to the - ! Arakawa & Hsu scheme, nondimensional between 0 and 1. + ! Arakawa & Hsu scheme [nondim], between 0 and 1. real :: Sad_wt ! The relative weight of the Sadourny energy scheme to - ! the other two with the ARAKAWA_LAMB_BLEND scheme, - ! nondimensional between 0 and 1. + ! the other two with the ARAKAWA_LAMB_BLEND scheme [nondim], + ! between 0 and 1. real :: Heff1, Heff2 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. real :: UHeff, VHeff ! More temporary variables [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: QUHeff,QVHeff ! More temporary variables [H L2 T-1 s-1 ~> m3 s-2 or kg s-2]. + real :: QUHeff,QVHeff ! More temporary variables [H L2 T-2 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz -! Diagnostics for fractional thickness-weighted terms - real, allocatable, dimension(:,:) :: & - hf_gKEu_2d, hf_gKEv_2d, & ! Depth sum of hf_gKEu, hf_gKEv [L T-2 ~> m s-2]. - hf_rvxu_2d, hf_rvxv_2d ! Depth sum of hf_rvxu, hf_rvxv [L T-2 ~> m s-2]. - - !real, allocatable, dimension(:,:,:) :: & - ! hf_gKEu, hf_gKEv, & ! accel. due to KE gradient x fract. thickness [L T-2 ~> m s-2]. - ! hf_rvxu, hf_rvxv ! accel. due to RV x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - -! Diagnostics for thickness multiplied momentum budget terms - real, allocatable, dimension(:,:,:) :: h_gKEu, h_gKEv ! h x gKEu, h x gKEv [H L T-2 ~> m2 s-2]. - real, allocatable, dimension(:,:,:) :: h_rvxv, h_rvxu ! h x rvxv, h x rvxu [H L T-2 ~> m2 s-2]. - -! Diagnostics for depth-integrated momentum budget terms - real, dimension(SZIB_(G),SZJ_(G)) :: intz_gKEu_2d, intz_rvxv_2d ! [H L T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G)) :: intz_gKEv_2d, intz_rvxu_2d ! [H L T-2 ~> m2 s-2]. - ! To work, the following fields must be set outside of the usual ! is to ie range before this subroutine is called: ! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), ! uh(is-1,ie,js:je+1) and vh(is:ie+1,js-1:je). - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_CoriolisAdv: Module must be initialized before it is used.") + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke vol_neglect = GV%H_subroundoff * (1e-4 * US%m_to_L)**2 @@ -285,7 +271,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,GV,CS,AD,Area_h,Area_q,& - !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel) + !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel, & + !$OMP pbv) do k=1,nz ! Here the second order accurate layer potential vorticities, q, @@ -306,10 +293,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j=Jsq,Jeq+1 ; do I=is-1,ie - uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * ((G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) enddo ; enddo do J=js-1,je ; do i=Isq,Ieq+1 - vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * ((G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k)) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -352,9 +339,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j,k) + vh_center(i,J) = (G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k)) * v(i,J,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = (G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k)) * v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -391,9 +378,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i,j,k) + uh_center(I,j) = (G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)) * u(I,j,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = (G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)) * u(I,j,k) * h(i+1,j,k) endif enddo endif @@ -672,7 +659,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif enddo ; enddo endif - ! Add in the additonal terms with Arakawa & Lamb. + ! Add in the additional terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = CAu(I,j,k) + & @@ -872,148 +859,27 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Diagnostics for terms multiplied by fractional thicknesses ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (CS%id_hf_gKEu > 0) then - ! allocate(hf_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_gKEu(I,j,k) = AD%gradKEu(I,j,k) * AD%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_gKEu, hf_gKEu, CS%diag) - !endif - - !if (CS%id_hf_gKEv > 0) then - ! allocate(hf_gKEv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_gKEv(i,J,k) = AD%gradKEv(i,J,k) * AD%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_gKEv, hf_gKEv, CS%diag) - !endif - - if (CS%id_hf_gKEu_2d > 0) then - allocate(hf_gKEu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_gKEu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_gKEu_2d(I,j) = hf_gKEu_2d(I,j) + AD%gradKEu(I,j,k) * AD%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_gKEu_2d, hf_gKEu_2d, CS%diag) - deallocate(hf_gKEu_2d) - endif - - if (CS%id_hf_gKEv_2d > 0) then - allocate(hf_gKEv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_gKEv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_gKEv_2d(i,J) = hf_gKEv_2d(i,J) + AD%gradKEv(i,J,k) * AD%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_gKEv_2d, hf_gKEv_2d, CS%diag) - deallocate(hf_gKEv_2d) - endif - - if (CS%id_intz_gKEu_2d > 0) then - intz_gKEu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_gKEu_2d(I,j) = intz_gKEu_2d(I,j) + AD%gradKEu(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_gKEu_2d, intz_gKEu_2d, CS%diag) - endif - - if (CS%id_intz_gKEv_2d > 0) then - intz_gKEv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_gKEv_2d(i,J) = intz_gKEv_2d(i,J) + AD%gradKEv(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_gKEv_2d, intz_gKEv_2d, CS%diag) - endif - - !if (CS%id_hf_rvxv > 0) then - ! allocate(hf_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_rvxv(I,j,k) = AD%rv_x_v(I,j,k) * AD%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_rvxv, hf_rvxv, CS%diag) - !endif - - !if (CS%id_hf_rvxu > 0) then - ! allocate(hf_rvxu(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_rvxu(i,J,k) = AD%rv_x_u(i,J,k) * AD%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_rvxu, hf_rvxu, CS%diag) - !endif - - if (CS%id_hf_rvxv_2d > 0) then - allocate(hf_rvxv_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_rvxv_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_rvxv_2d(I,j) = hf_rvxv_2d(I,j) + AD%rv_x_v(I,j,k) * AD%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_rvxv_2d, hf_rvxv_2d, CS%diag) - deallocate(hf_rvxv_2d) - endif - - if (CS%id_hf_rvxu_2d > 0) then - allocate(hf_rvxu_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_rvxu_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_rvxu_2d(i,J) = hf_rvxu_2d(i,J) + AD%rv_x_u(i,J,k) * AD%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_rvxu_2d, hf_rvxu_2d, CS%diag) - deallocate(hf_rvxu_2d) - endif - - if (CS%id_h_gKEu > 0) then - allocate(h_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_gKEu(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_gKEu(I,j,k) = AD%gradKEu(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_gKEu, h_gKEu, CS%diag) - deallocate(h_gKEu) - endif - if (CS%id_h_gKEv > 0) then - allocate(h_gKEv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_gKEv(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_gKEv(i,J,k) = AD%gradKEv(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_gKEv, h_gKEv, CS%diag) - deallocate(h_gKEv) - endif - - if (CS%id_h_rvxv > 0) then - allocate(h_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_rvxv(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_rvxv(I,j,k) = AD%rv_x_v(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_rvxv, h_rvxv, CS%diag) - deallocate(h_rvxv) - endif - if (CS%id_h_rvxu > 0) then - allocate(h_rvxu(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_rvxu(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_rvxu(i,J,k) = AD%rv_x_u(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_rvxu, h_rvxu, CS%diag) - deallocate(h_rvxu) - endif - - if (CS%id_intz_rvxv_2d > 0) then - intz_rvxv_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_rvxv_2d(I,j) = intz_rvxv_2d(I,j) + AD%rv_x_v(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_rvxv_2d, intz_rvxv_2d, CS%diag) - endif - - if (CS%id_intz_rvxu_2d > 0) then - intz_rvxu_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_rvxu_2d(i,J) = intz_rvxu_2d(i,J) + AD%rv_x_u(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_rvxu_2d, intz_rvxu_2d, CS%diag) - endif + ! The code is retained for debugging purposes in the future. + ! if (CS%id_hf_gKEu > 0) call post_product_u(CS%id_hf_gKEu, AD%gradKEu, AD%diag_hfrac_u, G, nz, CS%diag) + ! if (CS%id_hf_gKEv > 0) call post_product_v(CS%id_hf_gKEv, AD%gradKEv, AD%diag_hfrac_v, G, nz, CS%diag) + ! if (CS%id_hf_rvxv > 0) call post_product_u(CS%id_hf_rvxv, AD%rv_x_v, AD%diag_hfrac_u, G, nz, CS%diag) + ! if (CS%id_hf_rvxu > 0) call post_product_v(CS%id_hf_rvxu, AD%rv_x_u, AD%diag_hfrac_v, G, nz, CS%diag) + + if (CS%id_hf_gKEu_2d > 0) call post_product_sum_u(CS%id_hf_gKEu_2d, AD%gradKEu, AD%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_gKEv_2d > 0) call post_product_sum_v(CS%id_hf_gKEv_2d, AD%gradKEv, AD%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_intz_gKEu_2d > 0) call post_product_sum_u(CS%id_intz_gKEu_2d, AD%gradKEu, AD%diag_hu, G, nz, CS%diag) + if (CS%id_intz_gKEv_2d > 0) call post_product_sum_v(CS%id_intz_gKEv_2d, AD%gradKEv, AD%diag_hv, G, nz, CS%diag) + + if (CS%id_hf_rvxv_2d > 0) call post_product_sum_u(CS%id_hf_rvxv_2d, AD%rv_x_v, AD%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_rvxu_2d > 0) call post_product_sum_v(CS%id_hf_rvxu_2d, AD%rv_x_u, AD%diag_hfrac_v, G, nz, CS%diag) + + if (CS%id_h_gKEu > 0) call post_product_u(CS%id_h_gKEu, AD%gradKEu, AD%diag_hu, G, nz, CS%diag) + if (CS%id_h_gKEv > 0) call post_product_v(CS%id_h_gKEv, AD%gradKEv, AD%diag_hv, G, nz, CS%diag) + if (CS%id_h_rvxv > 0) call post_product_u(CS%id_h_rvxv, AD%rv_x_v, AD%diag_hu, G, nz, CS%diag) + if (CS%id_h_rvxu > 0) call post_product_v(CS%id_h_rvxu, AD%rv_x_u, AD%diag_hv, G, nz, CS%diag) + + if (CS%id_intz_rvxv_2d > 0) call post_product_sum_u(CS%id_intz_rvxv_2d, AD%rv_x_v, AD%diag_hu, G, nz, CS%diag) + if (CS%id_intz_rvxu_2d > 0) call post_product_sum_v(CS%id_intz_rvxu_2d, AD%rv_x_u, AD%diag_hv, G, nz, CS%diag) endif end subroutine CorAdCalc @@ -1021,7 +887,7 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] @@ -1034,7 +900,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. @@ -1057,7 +923,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) )*0.25*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then - ! The following discretization of KE is based on the one-dimensinal Gudonov + ! The following discretization of KE is based on the one-dimensional Gudonov ! scheme which does not take into account any geometric factors do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2 = up*up @@ -1067,7 +933,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) KE(i,j) = ( max(up2,um2) + max(vp2,vm2) ) *0.5 enddo ; enddo elseif (CS%KE_Scheme == KE_GUDONOV) then - ! The following discretization of KE is based on the one-dimensinal Gudonov + ! The following discretization of KE is based on the one-dimensional Gudonov ! scheme but has been adapted to take horizontal grid factors into account do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*G%areaCu(I-1,j) @@ -1104,16 +970,16 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) end subroutine gradKE -!> Initializes the control structure for coriolisadv_cs +!> Initializes the control structure for MOM_CoriolisAdv subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics - type(CoriolisAdv_CS), pointer :: CS !< Control structure fro MOM_CoriolisAdv + type(accel_diag_ptrs), target, intent(inout) :: AD !< Storage for acceleration diagnostics + type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1125,12 +991,7 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "CoriolisAdv_init called with associated control structure.") - return - endif - allocate(CS) - + CS%initialized = .true. CS%diag => diag ; CS%Time => Time ! Read all relevant parameters and write them to the model log. @@ -1260,153 +1121,118 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & 'Zonal Acceleration from Grad. Kinetic Energy', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_gKEu > 0) call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) CS%id_gKEv = register_diag_field('ocean_model', 'gKEv', diag%axesCvL, Time, & 'Meridional Acceleration from Grad. Kinetic Energy', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_gKEv > 0) call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) CS%id_rvxu = register_diag_field('ocean_model', 'rvxu', diag%axesCvL, Time, & 'Meridional Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_rvxu > 0) call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, & 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_gKEu > 0) then - ! call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif - - !CS%id_hf_gKEv = register_diag_field('ocean_model', 'hf_gKEv', diag%axesCvL, Time, & - ! 'Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & - ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_gKEv > 0) then - ! call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif - CS%id_hf_gKEu_2d = register_diag_field('ocean_model', 'hf_gKEu_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_gKEu_2d > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif + !CS%id_hf_gKEv = register_diag_field('ocean_model', 'hf_gKEv', diag%axesCvL, Time, & + ! 'Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_gKEv_2d = register_diag_field('ocean_model', 'hf_gKEv_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_gKEv_2d > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif CS%id_h_gKEu = register_diag_field('ocean_model', 'h_gKEu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_gKEu > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif - CS%id_intz_gKEu_2d = register_diag_field('ocean_model', 'intz_gKEu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_gKEu_2d > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_gKEv = register_diag_field('ocean_model', 'h_gKEv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_gKEv > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif - CS%id_intz_gKEv_2d = register_diag_field('ocean_model', 'intz_gKEv_2d', diag%axesCv1, Time, & 'Depth-integral of Meridional Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_gKEv_2d > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif !CS%id_hf_rvxu = register_diag_field('ocean_model', 'hf_rvxu', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_rvxu > 0) then - ! call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif - - !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & - ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_rvxv > 0) then - ! call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif - CS%id_hf_rvxu_2d = register_diag_field('ocean_model', 'hf_rvxu_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_rvxu_2d > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif + !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & + ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & + ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxv_2d = register_diag_field('ocean_model', 'hf_rvxv_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_rvxv_2d > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_rvxu = register_diag_field('ocean_model', 'h_rvxu', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_rvxu > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif - CS%id_intz_rvxu_2d = register_diag_field('ocean_model', 'intz_rvxu_2d', diag%axesCv1, Time, & 'Depth-integral of Meridional Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_rvxu_2d > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif CS%id_h_rvxv = register_diag_field('ocean_model', 'h_rvxv', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_rvxv > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif - CS%id_intz_rvxv_2d = register_diag_field('ocean_model', 'intz_rvxv_2d', diag%axesCu1, Time, & 'Depth-integral of Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_rvxv_2d > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) + + ! Allocate memory needed for the diagnostics that have been enabled. + if ((CS%id_gKEu > 0) .or. (CS%id_hf_gKEu_2d > 0) .or. & + ! (CS%id_hf_gKEu > 0) .or. & + (CS%id_h_gKEu > 0) .or. (CS%id_intz_gKEu_2d > 0)) then + call safe_alloc_ptr(AD%gradKEu, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_gKEv > 0) .or. (CS%id_hf_gKEv_2d > 0) .or. & + ! (CS%id_hf_gKEv > 0) .or. & + (CS%id_h_gKEv > 0) .or. (CS%id_intz_gKEv_2d > 0)) then + call safe_alloc_ptr(AD%gradKEv, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_rvxu > 0) .or. (CS%id_hf_rvxu_2d > 0) .or. & + ! (CS%id_hf_rvxu > 0) .or. & + (CS%id_h_rvxu > 0) .or. (CS%id_intz_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%rv_x_u, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_rvxv > 0) .or. (CS%id_hf_rvxv_2d > 0) .or. & + ! (CS%id_hf_rvxv > 0) .or. & + (CS%id_h_rvxv > 0) .or. (CS%id_intz_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%rv_x_v, IsdB, IedB, jsd, jed, nz) + endif + + if ((CS%id_hf_gKEv_2d > 0) .or. & + ! (CS%id_hf_gKEv > 0) .or. (CS%id_hf_rvxu > 0) .or. & + (CS%id_hf_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%diag_hfrac_v, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_hf_gKEu_2d > 0) .or. & + ! (CS%id_hf_gKEu > 0) .or. (CS%id_hf_rvxv > 0) .or. & + (CS%id_hf_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%diag_hfrac_u, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_h_gKEu > 0) .or. (CS%id_intz_gKEu_2d > 0) .or. & + (CS%id_h_rvxv > 0) .or. (CS%id_intz_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%diag_hu, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_h_gKEv > 0) .or. (CS%id_intz_gKEv_2d > 0) .or. & + (CS%id_h_rvxu > 0) .or. (CS%id_intz_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%diag_hv, isd, ied, JsdB, JedB, nz) endif end subroutine CoriolisAdv_init !> Destructor for coriolisadv_cs subroutine CoriolisAdv_end(CS) - type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure fro MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure for MOM_CoriolisAdv end subroutine CoriolisAdv_end !> \namespace mom_coriolisadv diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 2316bb9725..844d9db4bc 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -8,10 +8,10 @@ module MOM_PressureForce use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_PressureForce_FV, only : PressureForce_FV_Bouss, PressureForce_FV_nonBouss -use MOM_PressureForce_FV, only : PressureForce_FV_init, PressureForce_FV_end +use MOM_PressureForce_FV, only : PressureForce_FV_init use MOM_PressureForce_FV, only : PressureForce_FV_CS use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss -use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end +use MOM_PressureForce_Mont, only : PressureForce_Mont_init use MOM_PressureForce_Mont, only : PressureForce_Mont_CS use MOM_tidal_forcing, only : tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type @@ -22,16 +22,16 @@ module MOM_PressureForce #include -public PressureForce, PressureForce_init, PressureForce_end +public PressureForce, PressureForce_init !> Pressure force control structure type, public :: PressureForce_CS ; private logical :: Analytic_FV_PGF !< If true, use the analytic finite volume form !! (Adcroft et al., Ocean Mod. 2008) of the PGF. !> Control structure for the analytically integrated finite volume pressure force - type(PressureForce_FV_CS), pointer :: PressureForce_FV_CSp => NULL() + type(PressureForce_FV_CS) :: PressureForce_FV !> Control structure for the Montgomery potential form of pressure force - type(PressureForce_Mont_CS), pointer :: PressureForce_Mont_CSp => NULL() + type(PressureForce_Mont_CS) :: PressureForce_Mont end type PressureForce_CS contains @@ -48,10 +48,9 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] - type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure - real, dimension(:,:), & - optional, pointer :: p_atm !< The pressure at the ice-ocean or + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer @@ -62,18 +61,18 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e if (CS%Analytic_FV_PGF) then if (GV%Boussinesq) then - call PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV_CSp, & + call PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV, & ALE_CSp, p_atm, pbce, eta) else - call PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV_CSp, & + call PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV, & ALE_CSp, p_atm, pbce, eta) endif else if (GV%Boussinesq) then - call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont, & p_atm, pbce, eta) else - call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont, & p_atm, pbce, eta) endif endif @@ -88,17 +87,11 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_CS), pointer :: CS !< Pressure force control structure - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tide control structure + type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure + type(tidal_forcing_CS), intent(inout), optional :: tides_CSp !< Tide control structure #include "version_variable.h" character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ANALYTIC_FV_PGF", CS%Analytic_FV_PGF, & @@ -110,25 +103,13 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) if (CS%Analytic_FV_PGF) then call PressureForce_FV_init(Time, G, GV, US, param_file, diag, & - CS%PressureForce_FV_CSp, tides_CSp) + CS%PressureForce_FV, tides_CSp) else call PressureForce_Mont_init(Time, G, GV, US, param_file, diag, & - CS%PressureForce_Mont_CSp, tides_CSp) + CS%PressureForce_Mont, tides_CSp) endif - end subroutine PressureForce_init -!> Deallocate the pressure force control structure -subroutine PressureForce_end(CS) - type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure - - if (CS%Analytic_FV_PGF) then - call PressureForce_FV_end(CS%PressureForce_FV_CSp) - else - call PressureForce_Mont_end(CS%PressureForce_Mont_CSp) - endif -end subroutine PressureForce_end - !> \namespace mom_pressureforce !! !! This thin module provides a branch to two forms of the horizontal accelerations diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 23e58272ed..2a79486a5f 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -24,7 +24,7 @@ module MOM_PressureForce_FV #include -public PressureForce_FV_init, PressureForce_FV_end +public PressureForce_FV_init public PressureForce_FV_Bouss, PressureForce_FV_nonBouss ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional @@ -34,6 +34,7 @@ module MOM_PressureForce_FV !> Finite volume pressure gradient control structure type, public :: PressureForce_FV_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation [R ~> kg m-3]. @@ -80,13 +81,13 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> kg/m2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(in) :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies @@ -109,9 +110,9 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [L2 T-2 ~> m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer [R L4 Z-4 ~> Pa m2 s-2]. + ! the pressure anomaly at the top of the layer [R L4 T-4 ~> Pa m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - dp, & ! The (positive) change in pressure across a layer [R L2 Z-2 ~> Pa]. + dp, & ! The (positive) change in pressure across a layer [R L2 T-2 ~> Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. @@ -137,7 +138,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [R L2 T-2 ~> Pa]. - real :: I_gEarth ! The inverse of GV%g_Earth [L2 Z L-2 ~> s2 m-1] + real :: I_gEarth ! The inverse of GV%g_Earth [T2 Z L-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref [R-1 ~> m3 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -148,9 +149,11 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real :: alpha_ref ! A reference specific volume [R-1 ~> m3 kg-1] that is used ! to reduce the impact of truncation errors. real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. - real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H) [H T2 R-1 L-2 ~> H Pa-1]. - real :: H_to_RL2_T2 ! A factor to convert from thicknesss units (H) to pressure units [R L2 T-2 H-1 ~> Pa H-1]. -! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] + real :: Pa_to_H ! A factor to convert from Pa to the thickness units (H) + ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1]. + real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure + ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. +! real :: oneatm ! 1 standard atmosphere of pressure in [R L2 T-2 ~> Pa] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -161,14 +164,14 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.") + if (CS%Stanley_T2_det_coeff>=0.) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//& "implemented in non-Boussinesq mode.") - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif + use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) use_ALE = .false. if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS @@ -184,6 +187,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ p(i,j,1) = p_atm(i,j) enddo ; enddo else + ! oneatm = 101325.0 * US%kg_m3_to_R * US%m_s_to_L_T**2 ! 1 atm scaled to [R L2 T-2 ~> Pa] !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 p(i,j,1) = 0.0 ! or oneatm @@ -196,7 +200,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are - ! lighter than the the buffer layer with the properties of the buffer + ! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. if (nkmb>0) then @@ -227,7 +231,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! If regridding is activated, do a linear reconstruction of salinity ! and temperature across each layer. The subscripts 't' and 'b' refer ! to top and bottom values within each layer (these are the only degrees - ! of freedeom needed to know the linear profile). + ! of freedom needed to know the linear profile). if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) @@ -241,7 +245,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Calculate 4 integrals through the layer that are required in the ! subsequent calculation. if (use_EOS) then - if ( use_ALE ) then + if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & @@ -302,7 +306,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth * e_tidal(i,j) @@ -423,9 +427,9 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(in) :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies @@ -498,11 +502,10 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_PressureForce_FV_Bouss: Module must be initialized before it is used.") - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif + use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) do i=Isq,Ieq+1 ; p0(i) = 0.0 ; enddo use_ALE = .false. @@ -571,7 +574,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) endif ! Here layer interface heights, e, are calculated. @@ -593,7 +596,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are -! lighter than the the buffer layer with the properties of the buffer +! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. @@ -652,7 +655,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! If regridding is activated, do a linear reconstruction of salinity ! and temperature across each layer. The subscripts 't' and 'b' refer ! to top and bottom values within each layer (these are the only degrees - ! of freedeom needed to know the linear profile). + ! of freedom needed to know the linear profile). if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) @@ -694,7 +697,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! assumed when regridding is activated. Otherwise, the previous version ! is used, whereby densities within each layer are constant no matter ! where the layers are located. - if ( use_ALE ) then + if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & @@ -807,23 +810,17 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + type(PressureForce_FV_CS), intent(inout) :: CS !< Finite volume PGF control structure + type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - + CS%initialized = .true. CS%diag => diag ; CS%Time => Time - if (present(tides_CSp)) then - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp - endif + if (present(tides_CSp)) & + CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_FV" call log_version(param_file, mdl, version, "") @@ -883,13 +880,6 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS end subroutine PressureForce_FV_init -!> Deallocates the finite volume pressure gradient control structure -subroutine PressureForce_FV_end(CS) - type(PressureForce_FV_CS), pointer :: CS !< Finite volume pressure control structure that - !! will be deallocated in this subroutine. - if (associated(CS)) deallocate(CS) -end subroutine PressureForce_FV_end - !> \namespace mom_pressureforce_fv !! !! Provides the Boussinesq and non-Boussinesq forms of horizontal accelerations diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 05e68aef12..18ea07b313 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -21,7 +21,7 @@ module MOM_PressureForce_Mont #include public PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss, Set_pbce_Bouss -public Set_pbce_nonBouss, PressureForce_Mont_init, PressureForce_Mont_end +public Set_pbce_nonBouss, PressureForce_Mont_init ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -30,6 +30,7 @@ module MOM_PressureForce_Mont !> Control structure for the Montgomery potential form of pressure gradient type, public :: PressureForce_Mont_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation [R ~> kg m-3]. @@ -39,9 +40,9 @@ module MOM_PressureForce_Mont type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() !< Zonal accelerations due to pressure gradients + real, allocatable :: PFu_bc(:,:,:) !< Zonal accelerations due to pressure gradients !! deriving from density gradients within layers [L T-2 ~> m s-2]. - real, pointer :: PFv_bc(:,:,:) => NULL() !< Meridional accelerations due to pressure gradients + real, allocatable :: PFv_bc(:,:,:) !< Meridional accelerations due to pressure gradients !! deriving from density gradients within layers [L T-2 ~> m s-2]. !>@{ Diagnostic IDs integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 @@ -70,8 +71,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) [L T-2 ~> m s-2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or + type(PressureForce_Mont_CS), intent(inout) :: CS !< Control structure for Montgomery potential PGF + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in @@ -133,13 +134,13 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif - is_split = .false. ; if (present(pbce)) is_split = .true. + use_p_atm = associated(p_atm) + is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_PressureForce_Mont: Module must be initialized before it is used.") + if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_nonBouss: The Montgomery form of the pressure force "//& @@ -202,7 +203,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo ; enddo endif - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) @@ -218,7 +219,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Calculate in-situ specific volumes (alpha_star). ! With a bulk mixed layer, replace the T & S of any layers that are - ! lighter than the the buffer layer with the properties of the buffer + ! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. if (nkmb>0) then @@ -322,14 +323,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ((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 + if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((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 - if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -366,9 +367,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [L T-2 ~> m s2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or + !! (equal to -dM/dy) [L T-2 ~> m s-2]. + type(PressureForce_Mont_CS), intent(inout) :: CS !< Control structure for Montgomery potential PGF + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies @@ -378,7 +379,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the - ! corrected e times (G_Earth/Rho0) [m2 Z-1 s-2 ~> m s-2]. + ! corrected e times (G_Earth/Rho0) [L2 Z-1 T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in m. ! e may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility @@ -421,13 +422,13 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif - is_split = .false. ; if (present(pbce)) is_split = .true. + use_p_atm = associated(p_atm) + is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_PressureForce_Mont: Module must be initialized before it is used.") + if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_Bouss: The Montgomery form of the pressure force "//& @@ -450,7 +451,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) endif ! Here layer interface heights, e, are calculated. @@ -474,7 +475,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! Calculate in-situ densities (rho_star). ! With a bulk mixed layer, replace the T & S of any layers that are -! lighter than the the buffer layer with the properties of the buffer +! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. @@ -557,14 +558,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + & e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_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 + if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + & e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -631,7 +632,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) 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 Z-1 T-2 R-1 ~> m4 s-2 kg-1] - real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] + real :: Rho0xG ! g_Earth * Rho0 [R L2 Z-1 T-2 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost @@ -826,8 +827,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + type(PressureForce_Mont_CS), intent(inout) :: CS !< Montgomery PGF control structure + type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! Local variables logical :: use_temperature, use_EOS @@ -835,16 +836,10 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ # include "version_variable.h" character(len=40) :: mdl ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - + CS%initialized = .true. CS%diag => diag ; CS%Time => Time - if (present(tides_CSp)) then - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp - endif + if (present(tides_CSp)) & + CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_Mont" call log_version(param_file, mdl, version, "") @@ -864,14 +859,10 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ 'Density Gradient Zonal Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) CS%id_PFv_bc = register_diag_field('ocean_model', 'PFv_bc', diag%axesCvL, Time, & 'Density Gradient Meridional Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) - if (CS%id_PFu_bc > 0) then - call safe_alloc_ptr(CS%PFu_bc,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) - CS%PFu_bc(:,:,:) = 0.0 - endif - if (CS%id_PFv_bc > 0) then - call safe_alloc_ptr(CS%PFv_bc,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) - CS%PFv_bc(:,:,:) = 0.0 - endif + if (CS%id_PFu_bc > 0) & + allocate(CS%PFu_bc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.) + if (CS%id_PFv_bc > 0) & + allocate(CS%PFv_bc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.) endif if (CS%tides) then @@ -886,12 +877,6 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ end subroutine PressureForce_Mont_init -!> Deallocates the Montgomery-potential form of PGF control structure -subroutine PressureForce_Mont_end(CS) - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - if (associated(CS)) deallocate(CS) -end subroutine PressureForce_Mont_end - !>\namespace mom_pressureforce_mont !! !! Provides the Boussunesq and non-Boussinesq forms of the horizontal diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index abc2e228f6..3cb1ebf399 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1,4 +1,4 @@ -!> Baropotric solver +!> Barotropic solver module MOM_barotropic ! This file is part of MOM6. See LICENSE.md for the license. @@ -6,7 +6,7 @@ module MOM_barotropic use MOM_debugging, only : hchksum, uvchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field -use MOM_diag_mediator, only : safe_alloc_ptr, diag_ctrl, enable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averaging use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain use MOM_domains, only : To_All, Scalar_Pair, AGRID, CORNER, MOM_domain_type use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type @@ -67,22 +67,22 @@ module MOM_barotropic !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type - real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, - !! as set by the open boundary conditions [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, - !! as set by the open boundary conditions [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain - !! at a u-point with an open boundary condition [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain - !! at a v-point with an open boundary condition [H ~> m or kg m-2]. + real, allocatable :: Cg_u(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, allocatable :: Cg_v(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, allocatable :: H_u(:,:) !< The total thickness at the u-points [H ~> m or kg m-2]. + real, allocatable :: H_v(:,:) !< The total thickness at the v-points [H ~> m or kg m-2]. + real, allocatable :: uhbt(:,:) !< The zonal barotropic thickness fluxes specified + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, allocatable :: vhbt(:,:) !< The meridional barotropic thickness fluxes specified + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, allocatable :: ubt_outer(:,:) !< The zonal velocities just outside the domain, + !! as set by the open boundary conditions [L T-1 ~> m s-1]. + real, allocatable :: vbt_outer(:,:) !< The meridional velocities just outside the domain, + !! as set by the open boundary conditions [L T-1 ~> m s-1]. + real, allocatable :: eta_outer_u(:,:) !< The surface height outside of the domain + !! at a u-point with an open boundary condition [H ~> m or kg m-2]. + real, allocatable :: eta_outer_v(:,:) !< The surface height outside of the domain + !! at a v-point with an open boundary condition [H ~> m or kg m-2]. logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point. logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point. !>@{ Index ranges for the open boundary conditions @@ -98,7 +98,7 @@ module MOM_barotropic type(group_pass_type) :: pass_eta_outer !< Structure for group halo pass end type BT_OBC_type -!> The barotropic stepping control stucture +!> The barotropic stepping control structure type, public :: barotropic_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu !< The fraction of the total column thickness interpolated to u grid points in each layer [nondim]. @@ -132,8 +132,8 @@ module MOM_barotropic !< A limit on the rate at which eta_cor can be applied while avoiding instability !! [H T-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & - ua_polarity, & !< Test vector components for checking grid polarity. - va_polarity, & !< Test vector components for checking grid polarity. + ua_polarity, & !< Test vector components for checking grid polarity [nondim] + va_polarity, & !< Test vector components for checking grid polarity [nondim] bathyT !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m] real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will @@ -149,15 +149,15 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1]. - real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. - real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. + real, allocatable :: frhatu1(:,:,:) !< Predictor step values of frhatu stored for diagnostics [nondim] + real, allocatable :: frhatv1(:,:,:) !< Predictor step values of frhatv stored for diagnostics [nondim] type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. 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. + !! should used [nondim]. The default is 0.98. 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 @@ -166,7 +166,7 @@ module MOM_barotropic integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic !! time step the last time btstep was called. real :: bebt !< A nondimensional number, from 0 to 1, that - !! determines the gravity wave time stepping scheme. + !! determines the gravity wave time stepping scheme [nondim]. !! 0.0 gives a forward-backward scheme, while 1.0 !! give backward Euler. In practice, bebt should be !! of order 0.2 or greater. @@ -190,7 +190,7 @@ module MOM_barotropic logical :: integral_bt_cont !< If true, use the time-integrated velocity over the barotropic steps !! to determine the integrated transports used to update the continuity !! equation. Otherwise the transports are the sum of the transports - !! based on ]a series of instantaneous velocities and the BT_CONT_TYPE + !! based on a series of instantaneous velocities and the BT_CONT_TYPE !! for transports. This is only valid if a BT_CONT_TYPE is used. logical :: Nonlinear_continuity !< If true, the barotropic continuity equation !! uses the full ocean thickness for transport. @@ -209,7 +209,7 @@ module MOM_barotropic !! barotropic step when calculating the surface stress contribution to !! the barotropic acclerations. Otherwise use the depth based on bathyT. real :: BT_Coriolis_scale !< A factor by which the barotropic Coriolis acceleration anomaly - !! terms are scaled. + !! terms are scaled [nondim]. logical :: answers_2018 !< If true, use expressions for the barotropic solver that recover !! the answers from the end of 2018. Otherwise, use more efficient !! or general expressions. @@ -225,7 +225,10 @@ module MOM_barotropic !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. - real :: G_extra !< A nondimensional factor by which gtot is enhanced. + logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the + !! barotropic solver has the wrong sign, replicating a long-standing + !! bug. + real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim]. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are !! given by the parameters defined below: @@ -252,10 +255,10 @@ module MOM_barotropic !! truncated to maxvel [L T-1 ~> m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will !! be truncated when they are large enough that the - !! corresponding CFL number exceeds this value, nondim. + !! corresponding CFL number exceeds this value [nondim]. real :: maxCFL_BT_cont !< The maximum permitted CFL number associated with the !! barotropic accelerations from the summed velocities - !! times the time-derivatives of thicknesses. The + !! times the time-derivatives of thicknesses [nondim]. The !! default is 0.1, and there will probably be real !! problems if this were set close to 1. logical :: BT_cont_bounds !< If true, use the BT_cont_type variables to set limits @@ -318,7 +321,7 @@ module MOM_barotropic end type barotropic_CS -!> A desciption of the functional dependence of transport at a u-point +!> A description of the functional dependence of transport at a u-point type, private :: local_BT_cont_u_type real :: FA_u_EE !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east [H L ~> m2 or kg m-1]. @@ -335,16 +338,16 @@ module MOM_barotropic !! the time-integrated barotropic velocity [L ~> m], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: uh_WW !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent !! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg]. real :: uh_EE !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent !! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg]. end type local_BT_cont_u_type -!> A desciption of the functional dependence of transport at a v-point +!> A description of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: FA_v_NN !< The effective open face area for meridional barotropic transport !! drawing from locations far to the north [H L ~> m2 or kg m-1]. @@ -361,9 +364,9 @@ module MOM_barotropic !! the time-integrated barotropic velocity [L ~> m], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: vh_crvN !< The curvature of face area with velocity for flow from the north [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: vh_SS !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent !! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg]. real :: vh_NN !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent @@ -406,8 +409,8 @@ module MOM_barotropic subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, & eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, & eta_out, uhbtav, vhbtav, G, GV, US, CS, & - visc_rem_u, visc_rem_v, etaav, ADp, OBC, BT_cont, eta_PF_start, & - taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) + visc_rem_u, visc_rem_v, ADp, OBC, BT_cont, eta_PF_start, & + taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0, etaav) 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 @@ -444,41 +447,40 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass !! fluxes averaged through the barotropic steps - !! [H L2 T-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps - !! [H L2 T-1 ~> m3 or kg s-1]. - type(barotropic_CS), pointer :: CS !< The control structure returned by a - !! previous call to barotropic_init. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: visc_rem_u !< Both the fraction of the momentum !! originally in a layer that remains after a time-step of !! viscosity, and the fraction of a time-step's worth of a !! barotropic acceleration that a layer experiences after - !! viscosity is applied, in the zonal direction. Nondimensional - !! between 0 (at the bottom) and 1 (far above the bottom). + !! viscosity is applied, in the zonal direction [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above). real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass - !! averaged over the barotropic integration [H ~> m or kg m-2]. - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers - type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure. - type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe + type(accel_diag_ptrs), pointer :: ADp !< Acceleration diagnostic pointers + type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure. + type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic !! flow. - real, dimension(:,:), optional, pointer :: eta_PF_start !< The eta field consistent with the pressure + real, dimension(:,:), pointer :: eta_PF_start !< The eta field consistent with the pressure !! 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 + real, dimension(:,:), pointer :: taux_bot !< The zonal bottom frictional stress from !! ocean to the seafloor [R L Z T-2 ~> Pa]. - real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress + real, dimension(:,:), pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor [R L Z T-2 ~> Pa]. - real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference + real, dimension(:,:,:), 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 + real, dimension(:,:,:), pointer :: u_uh0 !< The velocities used to calculate !! uh0 [L T-1 ~> m s-1] - real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference + real, dimension(:,:,:), pointer :: vh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate + real, dimension(:,:,:), pointer :: v_vh0 !< The velocities used to calculate !! vh0 [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass + !! averaged over the barotropic integration [H ~> m or kg m-2]. ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -487,19 +489,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: wt_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! wt_u and wt_v are the real :: wt_v(SZI_(G),SZJB_(G),SZK_(GV)) ! normalized weights to ! be used in calculating barotropic velocities, possibly with - ! sums less than one due to viscous losses. Nondimensional. + ! sums less than one due to viscous losses [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - av_rem_u, & ! The weighted average of visc_rem_u, nondimensional. - tmp_u, & ! A temporary array at u points. + av_rem_u, & ! The weighted average of visc_rem_u [nondim] + tmp_u, & ! A temporary array at u points [L T-2 ~> m s-2] or [nondim] ubt_st, & ! The zonal barotropic velocity at the start of timestep [L T-1 ~> m s-1]. ubt_dt ! The zonal barotropic velocity tendency [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & - av_rem_v, & ! The weighted average of visc_rem_v, nondimensional. - tmp_v, & ! A temporary array at v points. + av_rem_v, & ! The weighted average of visc_rem_v [nondim] + tmp_v, & ! A temporary array at v points [L T-2 ~> m s-2] or [nondim] vbt_st, & ! The meridional barotropic velocity at the start of timestep [L T-1 ~> m s-1]. vbt_dt ! The meridional barotropic velocity tendency [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - tmp_h, & ! A temporary array at h points. + tmp_h, & ! A temporary array at h points [nondim] e_anom ! The anomaly in the sea surface height or column mass ! averaged between the beginning and end of the time step, ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2]. @@ -510,8 +512,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIBW_(CS),SZJW_(CS)) :: & ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains - ! after a time step, the remainder being lost to bottom drag. - ! bt_rem_u is a nondimensional number between 0 and 1. + ! after a time step, the remainder being lost to bottom drag [nondim]. + ! bt_rem_u is between 0 and 1. BT_force_u, & ! The vertical average of all of the u-accelerations that are ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the @@ -528,8 +530,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, uhbt_int, & ! The running time integral of uhbt over the time steps [H L2 ~> m3]. ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1]. ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]. - azon, bzon, & ! _zon & _mer are the values of the Coriolis force which - czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav, + azon, bzon, & ! _zon and _mer are the values of the Coriolis force which + czon, dzon, & ! are applied to the neighboring values of vbtav and ubtav, amer, bmer, & ! respectively to get the barotropic inertial rotation cmer, dmer, & ! [T-1 ~> s-1]. Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]. @@ -546,7 +548,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1]. bt_rem_v, & ! The fraction of the barotropic meridional velocity that ! remains after a time step, the rest being lost to bottom - ! drag. bt_rem_v is a nondimensional number between 0 and 1. + ! drag [nondim]. bt_rem_v is between 0 and 1. BT_force_v, & ! The vertical average of all of the v-accelerations that are ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the @@ -620,24 +622,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vhbt_prev, vhbt_sum_prev, & ! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1] vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m] vhbt_int_prev ! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3] - real :: mass_to_Z ! The depth unit conversion 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 :: mass_to_Z ! The inverse of the 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 :: 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 + ! when project_velocity is true [nondim]. For now be_proj is set ! to equal bebt, as they have similar roles and meanings. real :: Idt ! The inverse of dt [T-1 ~> s-1]. real :: det_de ! The partial derivative due to self-attraction and loading - ! of the reference geopotential with the sea surface height. + ! of the reference geopotential with the sea surface height [nondim]. ! This is typically ~0.09 or less. real :: dgeo_de ! The constant of proportionality between geopotential and - ! sea surface height. It is a nondimensional number of - ! order 1. For stability, this may be made larger - ! than the physical problem would suggest. - real :: Instep ! The inverse of the number of barotropic time steps to take. + ! sea surface height [nondim]. It is of order 1, but for + ! stability this may be made larger than the physical + ! problem would suggest. + real :: Instep ! The inverse of the number of barotropic time steps to take [nondim]. real :: wt_end ! The weighting of the final value of eta_PF [nondim] integer :: nstep ! The number of barotropic time steps to take. type(time_type) :: & @@ -672,9 +673,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1] - real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 - real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans - real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans + real, allocatable :: wt_vel(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average velocities [nondim] + real, allocatable :: wt_eta(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average the average of eta [nondim] + real, allocatable :: wt_accel(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average accelerations [nondim] + real, allocatable :: wt_trans(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average transports [nondim] + real, allocatable :: wt_accel2(:) ! A potentially un-normalized copy of wt_accel [nondim] + real :: sum_wt_vel ! The sum of the raw weights used to find average velocities [nondim] + real :: sum_wt_eta ! The sum of the raw weights used to find average the average of eta [nondim] + real :: sum_wt_accel ! The sum of the raw weights used to find average accelerations [nondim] + real :: sum_wt_trans ! The sum of the raw weights used to find average transports [nondim] + real :: I_sum_wt_vel ! The inverse of the sum of the raw weights used to find average velocities [nondim] + real :: I_sum_wt_eta ! The inverse of the sum of the raw weights used to find the average of eta [nondim] + real :: I_sum_wt_accel ! The inverse of the sum of the raw weights used to find average accelerations [nondim] + real :: I_sum_wt_trans ! The inverse of the sum of the raw weights used to find average transports [nondim] real :: dt_filt ! The half-width of the barotropic filter [T ~> s]. real :: trans_wt1, trans_wt2 ! The weights used to compute ubt_trans and vbt_trans integer :: nfilter @@ -692,8 +707,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, integer :: ioff, joff integer :: l_seg - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%module_is_initialized) call MOM_error(FATAL, & "btstep: Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -706,12 +722,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Idt = 1.0 / dt accel_underflow = CS%vel_underflow * Idt - use_BT_cont = .false. - if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) + use_BT_cont = associated(BT_cont) integral_BT_cont = use_BT_cont .and. CS%integral_BT_cont - interp_eta_PF = .false. - if (present(eta_PF_start)) interp_eta_PF = (associated(eta_PF_start)) + interp_eta_PF = associated(eta_PF_start) project_velocity = CS%BT_project_velocity @@ -725,11 +739,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, find_PF = (do_ave .and. ((CS%id_PFu_bt > 0) .or. (CS%id_PFv_bt > 0))) find_Cor = (do_ave .and. ((CS%id_Coru_bt > 0) .or. (CS%id_Corv_bt > 0))) - add_uh0 = .false. - if (present(uh0)) add_uh0 = associated(uh0) - if (add_uh0 .and. .not.(present(vh0) .and. present(u_uh0) .and. & - present(v_vh0))) call MOM_error(FATAL, & - "btstep: vh0, u_uh0, and v_vh0 must be present if uh0 is used.") + add_uh0 = associated(uh0) if (add_uh0 .and. .not.(associated(vh0) .and. associated(u_uh0) .and. & associated(v_vh0))) call MOM_error(FATAL, & "btstep: vh0, u_uh0, and v_vh0 must be associated if uh0 is used.") @@ -742,7 +752,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, apply_OBCs = .false. ; CS%BT_OBC%apply_u_OBCs = .false. ; CS%BT_OBC%apply_v_OBCs = .false. apply_OBC_open = .false. apply_OBC_flather = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then CS%BT_OBC%apply_u_OBCs = OBC%open_u_BCs_exist_globally .or. OBC%specified_u_BCs_exist_globally CS%BT_OBC%apply_v_OBCs = OBC%open_v_BCs_exist_globally .or. OBC%specified_v_BCs_exist_globally apply_OBC_flather = open_boundary_query(OBC, apply_Flather_OBC=.true.) @@ -753,7 +763,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (apply_OBC_flather .and. .not.GV%Boussinesq) call MOM_error(FATAL, & "btstep: Flather open boundary conditions have not yet been "// & "implemented for a non-Boussinesq model.") - endif ; endif + endif num_cycles = 1 if (CS%use_wide_halos) & @@ -775,8 +785,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Idtbt = 1.0 / dtbt bebt = CS%bebt be_proj = CS%bebt - mass_accel_to_Z = 1.0 / GV%Rho0 - mass_to_Z = US%m_to_Z / GV%Rho0 + mass_to_Z = 1.0 / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -1048,7 +1057,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + det_de + CS%G_extra + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + det_de + CS%G_extra + else + dgeo_de = (1.0 - det_de) + CS%G_extra + endif else dgeo_de = 1.0 + CS%G_extra endif @@ -1067,9 +1080,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie) else if (CS%Nonlinear_continuity) then - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1, eta) else - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1) endif endif @@ -1123,10 +1136,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (integral_BT_cont) then call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, US, MS, halo=1+ievf-ie, dt_baroclinic=dt) + G, US, MS, 1+ievf-ie, dt_baroclinic=dt) else call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, US, MS, halo=1+ievf-ie) + G, US, MS, 1+ievf-ie) endif endif if (integral_BT_cont) then @@ -1242,7 +1255,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - BT_force_u(I,j) = forces%taux(I,j) * mass_accel_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) else BT_force_u(I,j) = 0.0 endif ; enddo ; enddo @@ -1268,21 +1281,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - BT_force_v(i,J) = forces%tauy(i,J) * mass_accel_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) else BT_force_v(i,J) = 0.0 endif ; enddo ; enddo - if (present(taux_bot) .and. present(tauy_bot)) then - if (associated(taux_bot) .and. associated(tauy_bot)) then - !$OMP parallel do default(shared) - do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then - BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) - endif ; enddo ; enddo - !$OMP parallel do default(shared) - do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then - BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) - endif ; enddo ; enddo - endif + if (associated(taux_bot) .and. associated(tauy_bot)) then + !$OMP parallel do default(shared) + do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then + BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) + endif ; enddo ; enddo + !$OMP parallel do default(shared) + do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then + BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) + endif ; enddo ; enddo endif ! bc_accel_u & bc_accel_v are only available on the potentially @@ -1556,7 +1567,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, associated(forces%rigidity_ice_v)) H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf if (ice_is_rigid .and. use_BT_cont) & - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0) if (ice_is_rigid) then !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength) do j=js,je ; do i=is,ie @@ -1769,7 +1780,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. & (CS%Nonlin_cont_update_period > 0)) then if ((n>1) .and. (mod(n-1,CS%Nonlin_cont_update_period) == 0)) & - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1+iev-ie, eta) endif if (integral_BT_cont) then @@ -2674,33 +2685,33 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%id_frhatv1 > 0) CS%frhatv1(:,:,:) = CS%frhatv(:,:,:) endif - if ((present(ADp)) .and. (associated(ADp%diag_hfrac_u))) then + if (associated(ADp%diag_hfrac_u)) then do k=1,nz ; do j=js,je ; do I=is-1,ie ADp%diag_hfrac_u(I,j,k) = CS%frhatu(I,j,k) enddo ; enddo ; enddo endif - if ((present(ADp)) .and. (associated(ADp%diag_hfrac_v))) then + if (associated(ADp%diag_hfrac_v)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%diag_hfrac_v(i,J,k) = CS%frhatv(i,J,k) enddo ; enddo ; enddo endif - if ((present(ADp)) .and. (present(BT_cont)) .and. (associated(ADp%diag_hu))) then + if (use_BT_cont .and. associated(ADp%diag_hu)) then do k=1,nz ; do j=js,je ; do I=is-1,ie ADp%diag_hu(I,j,k) = BT_cont%h_u(I,j,k) enddo ; enddo ; enddo endif - if ((present(ADp)) .and. (present(BT_cont)) .and. (associated(ADp%diag_hv))) then + if (use_BT_cont .and. associated(ADp%diag_hv)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%diag_hv(i,J,k) = BT_cont%h_v(i,J,k) enddo ; enddo ; enddo endif - if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + if (associated(ADp%visc_rem_u)) then do k=1,nz ; do j=js,je ; do I=is-1,ie ADp%visc_rem_u(I,j,k) = visc_rem_u(I,j,k) enddo ; enddo ; enddo endif - if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + if (associated(ADp%visc_rem_u)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%visc_rem_v(i,J,k) = visc_rem_v(i,J,k) enddo ; enddo ; enddo @@ -2719,7 +2730,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) 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(barotropic_CS), pointer :: CS !< Barotropic control structure. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: pbce !< The baroclinic pressure @@ -2768,8 +2779,9 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) character(len=200) :: mesg integer :: i, j, k, is, ie, js, je, nz - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%module_is_initialized) call MOM_error(FATAL, & "set_dtbt: Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed @@ -2783,16 +2795,20 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) if (use_BT_cont) then - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0) elseif (CS%Nonlinear_continuity .and. present(eta)) then - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta=eta, halo=0) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, eta=eta) else - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, add_max=add_SSH) endif det_de = 0.0 if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + else + dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de) + endif if (present(pbce)) then do j=js,je ; do i=is,ie gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0 @@ -2912,13 +2928,9 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1] real :: uhbt_int_new ! The updated time-integrated zonal transport [H L2 ~> m3] real :: vhbt_int_new ! The updated time-integrated meridional transport [H L2 ~> m3] - real :: h_in ! The inflow thickess [H ~> m or kg m-2]. - real :: cff, Cx, Cy, tau - real :: dhdt, dhdx, dhdy + real :: h_in ! The inflow thickness [H ~> m or kg m-2]. real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1] integer :: i, j, is, ie, js, je - real, dimension(SZIB_(G),SZJB_(G)) :: grad - real, parameter :: eps = 1.0e-20 is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo if (.not.(BT_OBC%apply_u_OBCs .or. BT_OBC%apply_v_OBCs)) return @@ -3041,7 +3053,7 @@ end subroutine apply_velocity_OBCs !! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, & integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type. + type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -3260,12 +3272,21 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. + optional, intent(in) :: h_u !< The specified effective thicknesses at u-points, + !! perhaps scaled down to account for viscosity and + !! fractional open areas [H ~> m or kg m-2]. These + !! are used here as non-normalized weights for each + !! layer that are converted the normalized weights + !! for determining the barotropic accelerations. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(in) :: h_v !< The specified thicknesses at v-points [H ~> m or kg m-2]. + optional, intent(in) :: h_v !< The specified effective thicknesses at v-points, + !! perhaps scaled down to account for viscosity and + !! fractional open areas [H ~> m or kg m-2]. These + !! are used here as non-normalized weights for each + !! layer that are converted the normalized weights + !! for determining the barotropic accelerations. logical, optional, intent(in) :: may_use_default !< An optional logical argument !! to indicate that the default velocity point !! thicknesses may be used for this particular @@ -3283,11 +3304,11 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: h_harm ! The harmonic mean thicknesses [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: wt_arith ! The nondimensional weight for the arithmetic mean thickness. + real :: wt_arith ! The weight for the arithmetic mean thickness [nondim]. ! The harmonic mean uses a weight of (1 - wt_arith). - real :: Rh ! A ratio of summed thicknesses, nondim. - real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity and - real :: e_v(SZI_(G),SZK_(GV)+1) ! v-velocity points [H ~> m or kg m-2]. + real :: Rh ! A ratio of summed thicknesses [nondim] + real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity points [H ~> m or kg m-2] + real :: e_v(SZI_(G),SZK_(GV)+1) ! The interface heights at v-velocity points [H ~> m or kg m-2] real :: D_shallow_u(SZI_(G)) ! The height of the shallower of the adjacent bathymetric depths ! around a u-point (positive upward) [H ~> m or kg m-2] real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths @@ -3301,8 +3322,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! This section interpolates thicknesses onto u & v grid points with the ! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-). - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%module_is_initialized) call MOM_error(FATAL, & "btcalc: Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return use_default = .false. @@ -3563,7 +3585,7 @@ function find_duhbt_du(u, BTC) result(duhbt_du) !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real :: duhbt_du !< The zonal barotropic face area [L H ~> m2] + real :: duhbt_du !< The zonal barotropic face area [L H ~> m2 or kg m-1] if (u == 0.0) then duhbt_du = 0.5*(BTC%FA_u_E0 + BTC%FA_u_W0) ! Note the potential discontinuity here. @@ -3582,7 +3604,7 @@ end function find_duhbt_du !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True !! this finds the time-integrated velocity that is consistent with a time-integrated transport. -function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) +function uhbt_to_ubt(uhbt, BTC) result(ubt) real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for, !! [H L2 T-1 ~> m3 s-1 or kg s-1] or the time-integrated !! transport [H L2 ~> m3 or kg]. @@ -3590,8 +3612,6 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) !! barotropic transports to be calculated consistently with the !! layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1] or [L ~> m]. - !! The result is not allowed to be dramatically larger than guess. real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1] !! or the time-integrated velocity [L ~> m]. @@ -3606,7 +3626,7 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the - ! maximum increase of vs2, both nondim. + ! maximum increase of vs2, both [nondim]. integer :: itt, max_itt = 20 ! Find the value of ubt that gives uhbt. @@ -3665,18 +3685,6 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) ubt = BTC%uBT_WW + (uhbt - BTC%uh_WW) / BTC%FA_u_WW endif - if (present(guess)) then - dvel = abs(ubt) - vs1*abs(guess) - if (dvel > 0.0) then ! Limit the velocity - if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then - vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1))) - else ! The exp is less than 4e-18 anyway in this case, so neglect it. - vsr = vs2 - endif - ubt = SIGN(vsr * guess, ubt) - endif - endif - end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity, or with @@ -3712,7 +3720,7 @@ function find_dvhbt_dv(v, BTC) result(dvhbt_dv) !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real :: dvhbt_dv !< The meridional barotropic face area [L H ~> m2] + real :: dvhbt_dv !< The meridional barotropic face area [L H ~> m2 or kg m-1] if (v == 0.0) then dvhbt_dv = 0.5*(BTC%FA_v_N0 + BTC%FA_v_S0) ! Note the potential discontinuity here. @@ -3731,7 +3739,7 @@ end function find_dvhbt_dv !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True !! this finds the time-integrated velocity that is consistent with a time-integrated transport. -function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) +function vhbt_to_vbt(vhbt, BTC) result(vbt) real, intent(in) :: vhbt !< The barotropic meridional transport that should be !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1] or the !! time-integrated transport [H L2 ~> m3 or kg]. @@ -3739,8 +3747,6 @@ function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) !! barotropic transports to be calculated consistently !! with the layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real, optional, intent(in) :: guess !< A guess at what vbt will be [L T-1 ~> m s-1] or [L ~> m]. - !! The result is not allowed to be dramatically larger than guess. real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1] !! or the time-integrated velocity [L ~> m]. @@ -3755,7 +3761,7 @@ function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the - ! maximum increase of vs2, both nondim. + ! maximum increase of vs2, both [nondim]. integer :: itt, max_itt = 20 ! Find the value of vbt that gives vhbt. @@ -3814,40 +3820,25 @@ function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) vbt = BTC%vBT_SS + (vhbt - BTC%vh_SS) / BTC%FA_v_SS endif - if (present(guess)) then - dvel = abs(vbt) - vs1*abs(guess) - if (dvel > 0.0) then ! Limit the velocity - if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then - vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1))) - else ! The exp is less than 4e-18 anyway in this case, so neglect it. - vsr = vs2 - endif - vbt = SIGN(guess * vsr, vbt) - endif - endif - end function vhbt_to_vbt !> This subroutine sets up reordered versions of the BT_cont type in the !! local_BT_cont types, which have wide halos properly filled in. subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo, dt_baroclinic) - type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the - !! barotropic solver. - type(memory_size_type), intent(in) :: MS !< A type that describes the - !! memory sizes of the argument - !! arrays. - type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(out) :: BTCL_u !< A structure with the u - !! information from BT_cont. - type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v - !! information from BT_cont. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating - !! the halos of wide arrays. - integer, optional, intent(in) :: halo !< The extra halo size to use here. - real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step - !! [T ~> s], which is provided if - !! INTEGRAL_BT_CONTINUITY is true. + type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the barotropic solver + type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of + !! the argument arrays + type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & + intent(out) :: BTCL_u !< A structure with the u information from BT_cont + type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & + intent(out) :: BTCL_v !< A structure with the v information from BT_cont + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating the halos + !! of wide arrays + integer, intent(in) :: halo !< The extra halo size to use here + real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which + !! is provided if INTEGRAL_BT_CONTINUITY is true. ! Local variables real, dimension(SZIBW_(MS),SZJW_(MS)) :: & @@ -3863,7 +3854,7 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - hs = 1 ; if (present(halo)) hs = max(halo,0) + hs = max(halo,0) dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic ! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays. @@ -3966,7 +3957,7 @@ end subroutine set_local_BT_cont_types !> Adjust_local_BT_cont_types expands the range of velocities with a cubic curve -!! translating velocities into transports to match the inital values of velocities and +!! translating velocities into transports to match the initial values of velocities and !! summed transports when the velocities are larger than the first guesses of the cubic !! transition velocities used to set up the local_BT_cont types. subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & @@ -3988,21 +3979,17 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & intent(out) :: BTCL_v !< A structure with the v information from BT_cont. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, optional, intent(in) :: halo !< The extra halo size to use here. + integer, intent(in) :: halo !< The extra halo size to use here. real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which is !! provided if INTEGRAL_BT_CONTINUITY is true. ! Local variables - real, dimension(SZIBW_(MS),SZJW_(MS)) :: & - u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW - real, dimension(SZIW_(MS),SZJBW_(MS)) :: & - v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim] real, parameter :: C1_3 = 1.0/3.0 integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - hs = 1 ; if (present(halo)) hs = max(halo,0) + hs = max(halo,0) dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic !$OMP parallel do default(shared) @@ -4068,9 +4055,9 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & end subroutine adjust_local_BT_cont_types -!> This subroutine uses the BTCL types to find typical or maximum face +!> This subroutine uses the BT_cont_type to find the maximum face !! areas, which can then be used for finding wave speeds, etc. -subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize) +subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo) type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the !! barotropic solver. type(memory_size_type), intent(in) :: MS !< A type that describes the memory @@ -4080,49 +4067,36 @@ subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize) real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The extra halo size to use here. - logical, optional, intent(in) :: maximize !< If present and true, find the - !! maximum face area for any velocity. ! Local variables - logical :: find_max integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec hs = 1 ; if (present(halo)) hs = max(halo,0) - find_max = .false. ; if (present(maximize)) find_max = maximize - if (find_max) then - do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = max(BT_cont%FA_u_EE(I,j), BT_cont%FA_u_E0(I,j), & - BT_cont%FA_u_W0(I,j), BT_cont%FA_u_WW(I,j)) - enddo ; enddo - do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = max(BT_cont%FA_v_NN(i,J), BT_cont%FA_v_N0(i,J), & - BT_cont%FA_v_S0(i,J), BT_cont%FA_v_SS(i,J)) - enddo ; enddo - else - do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = 0.5 * (BT_cont%FA_u_E0(I,j) + BT_cont%FA_u_W0(I,j)) - enddo ; enddo - do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = 0.5 * (BT_cont%FA_v_N0(i,J) + BT_cont%FA_v_S0(i,J)) - enddo ; enddo - endif + do j=js-hs,je+hs ; do I=is-1-hs,ie+hs + Datu(I,j) = max(BT_cont%FA_u_EE(I,j), BT_cont%FA_u_E0(I,j), & + BT_cont%FA_u_W0(I,j), BT_cont%FA_u_WW(I,j)) + enddo ; enddo + do J=js-1-hs,je+hs ; do i=is-hs,ie+hs + Datv(i,J) = max(BT_cont%FA_v_NN(i,J), BT_cont%FA_v_N0(i,J), & + BT_cont%FA_v_S0(i,J), BT_cont%FA_v_SS(i,J)) + enddo ; enddo end subroutine BT_cont_to_face_areas !> Swap the values of two real variables subroutine swap(a,b) - real, intent(inout) :: a !< The first variable to be swapped. - real, intent(inout) :: b !< The second variable to be swapped. - real :: tmp + real, intent(inout) :: a !< The first variable to be swapped [arbitrary units] + real, intent(inout) :: b !< The second variable to be swapped [arbitrary units] + real :: tmp ! A temporary variable [arbitrary units] tmp = a ; a = b ; b = tmp end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. -subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) +subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1]. @@ -4131,12 +4105,11 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. + type(barotropic_CS), intent(in) :: CS !< Barotropic control structure + integer, intent(in) :: halo !< The halo size to use, default = 1. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly !! or column mass anomaly [H ~> m or kg m-2]. - integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used !! to overestimate the external wave speed) [Z ~> m]. @@ -4144,7 +4117,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2]. integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - hs = 1 ; if (present(halo)) hs = max(halo,0) + hs = max(halo,0) !$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,G,CS,Datu,Datv,add_max) & !$OMP private(H1,H2) @@ -4226,8 +4199,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) !! fluxes (and update the slowly varying part of eta_cor) !! (.true.) or whether to incrementally update the !! corrective fluxes. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous call - !! to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure ! Local variables real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses [H ~> m or kg m-2]. @@ -4237,8 +4209,9 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) ! thicknesses [H ~> m or kg m-2]. integer :: is, ie, js, je, nz, i, j, k - if (.not.associated(CS)) call MOM_error(FATAL, "bt_mass_source: "// & + if (.not.CS%module_is_initialized) call MOM_error(FATAL, "bt_mass_source: "// & "Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -4292,21 +4265,18 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module - !! that is set in register_barotropic_restarts. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. - type(BT_cont_type), optional, & - pointer :: BT_cont !< A structure with elements that describe the + type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of !! barotropic flow. - type(tidal_forcing_CS), optional, & - pointer :: tides_CSp !< A pointer to the control structure of the + type(tidal_forcing_CS), target, optional :: tides_CSp !< A pointer to the control structure of the !! tide module. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1]. @@ -4329,7 +4299,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. - real, allocatable, dimension(:,:) :: lin_drag_h + real :: det_de ! The partial derivative due to self-attraction and loading of the reference + ! geopotential with the sea surface height when tides are enabled. + ! This is typically ~0.09 or less. + real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points + ! that acts on the barotropic flow [Z T-1 ~> m s-1]. + type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity @@ -4357,7 +4332,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%diag => diag ; CS%Time => Time if (present(tides_CSp)) then - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + CS%tides_CSp => tides_CSp endif ! Read all relevant parameters and write them to the model log. @@ -4483,6 +4458,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) + det_de = 0.0 + if (CS%tides .and. associated(CS%tides_CSp)) & + call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) + call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, & + "If true, the tidal self-attraction and loading anomaly in the barotropic "//& + "solver has the wrong sign, replicating a long-standing bug with a scalar "//& + "self-attraction and loading term or the SAL term from a previous simulation.", & + default=.true., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& @@ -4912,8 +4895,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, & 'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) - if (CS%id_frhatu1 > 0) call safe_alloc_ptr(CS%frhatu1, IsdB,IedB,jsd,jed,nz) - if (CS%id_frhatv1 > 0) call safe_alloc_ptr(CS%frhatv1, isd,ied,JsdB,JedB,nz) + if (CS%id_frhatu1 > 0) allocate(CS%frhatu1(IsdB:IedB,jsd:jed,nz), source=0.) + if (CS%id_frhatv1 > 0) allocate(CS%frhatv1(isd:ied,JsdB:JedB,nz), source=0.) if (.NOT.query_initialized(CS%ubtav,"ubtav",restart_CS) .or. & .NOT.query_initialized(CS%vbtav,"vbtav",restart_CS)) then @@ -4964,7 +4947,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, enddo ; enddo endif - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1) if ((CS%bound_BT_corr) .and. .not.(use_BT_Cont_type .and. CS%BT_cont_bounds)) then ! This is not used in most test cases. Were it ever to become more widely used, consider ! replacing maxvel with min(G%dxT(i,j),G%dyT(i,j)) * (CS%maxCFL_BT_cont*Idt) . @@ -4993,7 +4976,7 @@ end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) - type(barotropic_CS), pointer :: CS !< Control structure for this module + type(barotropic_CS), intent(in) :: CS !< Barotropic control structure type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged !! over a baroclinic timestep [L T-1 ~> m s-1] @@ -5029,8 +5012,8 @@ subroutine barotropic_end(CS) DEALLOC_(CS%eta_cor) DEALLOC_(CS%frhatu) ; DEALLOC_(CS%frhatv) - if (associated(CS%frhatu1)) deallocate(CS%frhatu1) - if (associated(CS%frhatv1)) deallocate(CS%frhatv1) + if (allocated(CS%frhatu1)) deallocate(CS%frhatu1) + if (allocated(CS%frhatv1)) deallocate(CS%frhatv1) call deallocate_MOM_domain(CS%BT_domain) ! Allocated in restart registration, prior to timestep initialization @@ -5042,10 +5025,9 @@ end subroutine barotropic_end subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(barotropic_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables type(vardesc) :: vd(3) @@ -5055,13 +5037,6 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB - if (associated(CS)) then - call MOM_error(WARNING, "register_barotropic_restarts called with an associated "// & - "control structure.") - return - endif - allocate(CS) - call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & "If true, adjust the initial conditions for the "//& "barotropic solver to the values from the layered "//& diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index dc89f3f92c..11973f8c02 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -19,7 +19,7 @@ module MOM_boundary_update use MOM_verticalGrid, only : verticalGrid_type use DOME_initialization, only : register_DOME_OBC use tidal_bay_initialization, only : tidal_bay_set_OBC_data, register_tidal_bay_OBC -use tidal_bay_initialization, only : tidal_bay_OBC_end, tidal_bay_OBC_CS +use tidal_bay_initialization, only : tidal_bay_OBC_CS use Kelvin_initialization, only : Kelvin_set_OBC_data, register_Kelvin_OBC use Kelvin_initialization, only : Kelvin_OBC_end, Kelvin_OBC_CS use shelfwave_initialization, only : shelfwave_set_OBC_data, register_shelfwave_OBC @@ -44,7 +44,7 @@ module MOM_boundary_update !>@{ Pointers to the control structures for named OBC specifications type(file_OBC_CS), pointer :: file_OBC_CSp => NULL() type(Kelvin_OBC_CS), pointer :: Kelvin_OBC_CSp => NULL() - type(tidal_bay_OBC_CS), pointer :: tidal_bay_OBC_CSp => NULL() + type(tidal_bay_OBC_CS) :: tidal_bay_OBC type(shelfwave_OBC_CS), pointer :: shelfwave_OBC_CSp => NULL() type(dyed_channel_OBC_CS), pointer :: dyed_channel_OBC_CSp => NULL() !>@} @@ -118,7 +118,7 @@ subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) endif if (CS%use_tidal_bay) CS%use_tidal_bay = & - register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC_CSp, US, & + register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC, US, & OBC%OBC_Reg) if (CS%use_Kelvin) CS%use_Kelvin = & register_Kelvin_OBC(param_file, CS%Kelvin_OBC_CSp, US, & @@ -147,13 +147,13 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) ! if (CS%use_files) & ! call update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (CS%use_tidal_bay) & - call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, G, GV, h, Time) + call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, US, h, Time) if (CS%use_Kelvin) & call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, US, h, Time) if (CS%use_shelfwave) & call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, GV, US, h, Time) if (CS%use_dyed_channel) & - call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, Time) + call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, US, Time) if (OBC%needs_IO_for_data .or. OBC%add_tide_constituents) & call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) @@ -164,7 +164,6 @@ subroutine OBC_register_end(CS) type(update_OBC_CS), pointer :: CS !< Control structure for OBCs if (CS%use_files) call file_OBC_end(CS%file_OBC_CSp) - if (CS%use_tidal_bay) call tidal_bay_OBC_end(CS%tidal_bay_OBC_CSp) if (CS%use_Kelvin) call Kelvin_OBC_end(CS%Kelvin_OBC_CSp) if (associated(CS)) deallocate(CS) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index a1c300c94f..917a4afdc3 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -92,23 +92,21 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is !! used to rescale u and v if present. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. - real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> nondim] or [nondim] + integer :: hs logical :: sym - L_T_to_m_s = 1.0 ; if (present(US)) L_T_to_m_s = US%L_T_to_m_s - ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. hs = 1 ; if (present(haloshift)) hs = haloshift sym = .false. ; if (present(symmetric)) sym = symmetric - call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 480568c545..0852d10cd2 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -5,7 +5,7 @@ module MOM_continuity use MOM_continuity_PPM, only : continuity_PPM, continuity_PPM_init use MOM_continuity_PPM, only : continuity_PPM_stencil -use MOM_continuity_PPM, only : continuity_PPM_end, continuity_PPM_CS +use MOM_continuity_PPM, only : continuity_PPM_CS use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -13,14 +13,14 @@ module MOM_continuity use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : BT_cont_type +use MOM_variables, only : BT_cont_type, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private #include -public continuity, continuity_init, continuity_end, continuity_stencil +public continuity, continuity_init, continuity_stencil !> Control structure for mom_continuity type, public :: continuity_CS ; private @@ -29,7 +29,7 @@ module MOM_continuity !! - PPM - A directionally split piecewise parabolic reconstruction solver. !! The default, PPM, seems most appropriate for use with our current !! time-splitting strategies. - type(continuity_PPM_CS), pointer :: PPM_CSp => NULL() !< Control structure for mom_continuity_ppm + type(continuity_PPM_CS) :: PPM !< Control structure for mom_continuity_ppm end type continuity_CS integer, parameter :: PPM_SCHEME = 1 !< Enumerated constant to select PPM @@ -39,7 +39,7 @@ module MOM_continuity !> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & +subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhbt, vhbt, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -59,15 +59,15 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + type(continuity_CS), intent(in) :: CS !< Control structure for mom_continuity. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The vertically summed volume !! flux through meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< Both the fraction of !! zonal momentum that remains after a time-step of viscosity, and the fraction of a time-step's @@ -96,7 +96,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM, OBC, pbv, uhbt, vhbt, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") @@ -112,19 +112,13 @@ subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + type(continuity_CS), intent(inout) :: CS !< Control structure for mom_continuity. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_continuity" ! This module's name. character(len=20) :: tmpstr - if (associated(CS)) then - call MOM_error(WARNING, "continuity_init called with associated control structure.") - return - endif - allocate(CS) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "CONTINUITY_SCHEME", tmpstr, & @@ -146,7 +140,7 @@ subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM) endif end subroutine continuity_init @@ -154,24 +148,14 @@ end subroutine continuity_init !> continuity_stencil returns the continuity solver stencil size function continuity_stencil(CS) result(stencil) - type(continuity_CS), pointer :: CS !< Module's control structure. + type(continuity_CS), intent(in) :: CS !< Module's control structure. integer :: stencil !< The continuity solver stencil size with the current settings. stencil = 1 if (CS%continuity_scheme == PPM_SCHEME) then - stencil = continuity_PPM_stencil(CS%PPM_CSp) + stencil = continuity_PPM_stencil(CS%PPM) endif - end function continuity_stencil -!> Destructor for continuity_cs. -subroutine continuity_end(CS) - type(continuity_CS), intent(inout) :: CS !< Control structure for mom_continuity. - - if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_end(CS%PPM_CSp) - endif -end subroutine continuity_end - end module MOM_continuity diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d8b6cddaaa..e5bd2f9ae9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -11,14 +11,14 @@ module MOM_continuity_PPM use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : BT_cont_type +use MOM_variables, only : BT_cont_type, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private #include -public continuity_PPM, continuity_PPM_init, continuity_PPM_end, continuity_PPM_stencil +public continuity_PPM, continuity_PPM_init, continuity_PPM_stencil !>@{ CPU time clock IDs integer :: id_clock_update, id_clock_correct @@ -26,6 +26,7 @@ module MOM_continuity_PPM !> Control structure for mom_continuity_ppm type, public :: continuity_PPM_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. type(diag_ctrl), pointer :: diag !< Diagnostics control structure. logical :: upwind_1st !< If true, use a first-order upwind scheme. logical :: monotonic !< If true, use the Colella & Woodward monotonic @@ -40,10 +41,6 @@ module MOM_continuity_PPM real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses [L T-1 ~> m s-1]. - real :: tol_eta_aux !< The tolerance for free-surface height - !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses when calculating - !! the auxiliary corrected velocities [H ~> m or kg m-2]. real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities [nondim] logical :: aggress_adjust !< If true, allow the adjusted velocities to have a !! relative CFL change up to 0.5. False by default. @@ -73,11 +70,10 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhbt, vhbt, & 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(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -91,29 +87,30 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(porous_barrier_ptrs), intent(in) :: pbv !< pointers to porous barrier fractional cell metrics real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_v is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor !< The zonal velocities that give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. @@ -135,8 +132,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O h_min = GV%Angstrom_H - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_continuity_PPM: Module must be initialized before it is used.") + x_first = (MOD(G%first_direction,2) == 0) if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & @@ -149,7 +147,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt, G, GV, 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, OBC, & + pbv%por_face_areaU, uhbt, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -164,7 +163,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, 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, OBC, & + pbv%por_face_areaV, vhbt, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -180,7 +180,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt, G, GV, 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, OBC, & + pbv%por_face_areaV, vhbt, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -192,7 +193,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt, G, GV, 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, OBC, & + pbv%por_face_areaU, uhbt, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -208,7 +210,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & +subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_areaU, uhbt, & 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. @@ -221,22 +223,23 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally in a layer that remains after a !! time-step of viscosity, and the fraction of a time-step's worth of a barotropic - !! acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt !< The summed volume flux through zonal faces - !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor - !< The zonal velocitiess (u with a barotropic correction) + !< The zonal velocities (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, m s-1. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of barotropic flow. @@ -247,15 +250,15 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. du_min_CFL, & ! Min/max limits on du correction - du_max_CFL, & ! to avoid CFL violations + du_max_CFL, & ! to avoid CFL violations [L T-1 ~> m s-1] duhdu_tot_0, & ! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. - visc_rem_max ! The column maximum of visc_rem. + visc_rem_max ! The column maximum of visc_rem [nondim]. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(GV)) :: & - visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. + visc_rem ! A 2-D copy of visc_rem_u or an array of 1's [nondim]. real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H L ~> m2 or kg m-1]. - real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. + real :: FA_u ! A sum of zonal face areas [H L ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step [T-1 ~> s-1]. @@ -272,7 +275,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then ; if (OBC%OBC_pe) then local_specified_BC = OBC%specified_u_BCs_exist_globally local_Flather_OBC = OBC%Flather_u_BCs_exist_globally local_open_BC = OBC%open_u_BCs_exist_globally @@ -293,7 +296,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & enddo ; enddo else call PPM_reconstruction_x(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, CS%simple_2nd, OBC) endif do I=ish-1,ieh ; visc_rem(I,k) = 1.0 ; enddo enddo @@ -302,7 +305,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, 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,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 CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC, & +!$OMP por_face_areaU) & !$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, & !$OMP any_simple_OBC,l_seg) & @@ -317,7 +321,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, 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, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) if (local_specified_BC) then do I=ish-1,ieh l_seg = OBC%segnum_u(I,j) @@ -430,7 +434,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, 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, G, GV, US, CS, visc_rem, & - j, ish, ieh, do_I, uh, OBC=OBC) + j, ish, ieh, do_I, por_face_areaU, uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo @@ -449,7 +453,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, 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, G, GV, US, CS, visc_rem, & - visc_rem_max, j, ish, ieh, do_I) + visc_rem_max, j, ish, ieh, do_I, por_face_areaU) if (any_simple_OBC) then do I=ish-1,ieh l_seg = OBC%segnum_u(I,j) @@ -484,17 +488,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then I = OBC%segment(n)%HI%IsdB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed + do j = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*(G%dy_Cu(I,j)*por_face_areaU(I,j,k)) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 enddo else - do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed + do j = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*(G%dy_Cu(I,j)*por_face_areaU(I,j,k)) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -508,10 +512,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, 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, G, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU, visc_rem_u) else call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU, visc_rem_u) endif endif ; endif @@ -519,14 +523,14 @@ end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & - ish, ieh, do_I, vol_CFL, OBC) + ish, ieh, do_I, vol_CFL, por_face_areaU, 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]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic - !! acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness [H ~> m or kg m-2]. @@ -541,6 +545,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the + real, dimension(SZIB_(G)), intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] !! ratio of face areas to the cell areas when estimating the CFL number. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables @@ -563,21 +568,21 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & 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) * & + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) h_marg = h_L(i+1) + CFL * ((h_R(i+1)-h_L(i+1)) + 3.0*curv_3*(CFL - 1.0)) else uh(I) = 0.0 h_marg = 0.5 * (h_L(i+1) + h_R(i)) endif - duhdu(I) = G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then @@ -587,11 +592,11 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & if (l_seg /= OBC_NONE) then if (OBC%segment(l_seg)%open) then if (OBC%segment(l_seg)%direction == OBC_DIRECTION_E) then - uh(I) = G%dy_Cu(I,j) * u(I) * h(i) - duhdu(I) = G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * h(i) + duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * h(i) * visc_rem(I) else - uh(I) = G%dy_Cu(I,j) * u(I) * h(i+1) - duhdu(I) = G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * h(i+1) + duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h(i+1) * visc_rem(I) endif endif endif @@ -599,9 +604,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & endif end subroutine zonal_flux_layer -!> Sets the effective interface thickness at each zonal velocity point. +!> Sets the effective interface thickness at each zonal velocity point, optionally scaling +!! back these thicknesses to account for viscosity and fractional open areas. subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, & - marginal, visc_rem_u, OBC) + marginal, OBC, por_face_areaU, visc_rem_u) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -611,7 +617,10 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, !! reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_u !< Effective thickness at zonal faces, + !! scaled down to account for the effects of + !! viscoity and the fractional open area + !! [H ~> m or kg m-2]. 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. @@ -619,13 +628,15 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the !! marginal face thicknesses; otherwise report transport-averaged thicknesses. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< Both the fraction of the momentum originally in a layer that remains after !! a time-step of viscosity, and the fraction of a time-step's worth of a - !! barotropic acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + !! barotropic acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above the bottom). ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -654,7 +665,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, 3.0*curv_3*(CFL - 1.0)) else h_avg = 0.5 * (h_L(i+1,j,k) + h_R(i,j,k)) - ! The choice to use the arithmetic mean here is somewhat arbitrariy, but + ! The choice to use the arithmetic mean here is somewhat arbitrarily, but ! it should be noted that h_L(i+1,j,k) and h_R(i,j,k) are usually the same. h_marg = 0.5 * (h_L(i+1,j,k) + h_R(i,j,k)) ! h_marg = (2.0 * h_L(i+1,j,k) * h_R(i,j,k)) / & @@ -665,16 +676,17 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else ; h_u(I,j,k) = h_avg ; endif enddo ; enddo ; enddo if (present(visc_rem_u)) then + ! Scale back the thickness to account for the effects of viscosity and the fractional open + ! thickness to give an appropriate non-normalized weight for each layer in determining the + ! barotropic acceleration. !$OMP parallel do default(shared) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h_u(I,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo ; enddo ; enddo endif local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then - local_open_BC = OBC%open_u_BCs_exist_globally - endif ; endif + if (associated(OBC)) local_open_BC = OBC%open_u_BCs_exist_globally if (local_open_BC) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then @@ -682,7 +694,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_E) then if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h(i,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -692,7 +704,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h(i+1,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -710,7 +722,8 @@ end subroutine zonal_face_thickness !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & du, du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & - j, ish, ieh, do_I_in, uh_3d, OBC) + j, ish, ieh, do_I_in, por_face_areaU, uh_3d, OBC) + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -723,8 +736,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer - !! experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -740,18 +753,20 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! The barotropic velocity adjustment [L T-1 ~> m s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I_in !< !! A logical flag indicating which I values to work on. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: uh_3d !< !! Volume flux through zonal faces = u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(GV)) :: & - uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. + uh_aux, & ! An auxiliary zonal volume flux [H L2 T-1 ~> m3 s-1 or kg s-1]. duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -830,7 +845,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) enddo ; endif if (itt < max_itts) then @@ -860,7 +875,7 @@ end subroutine zonal_flux_adjust !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & - visc_rem_max, j, ish, ieh, do_I) + visc_rem_max, j, ish, ieh, do_I, por_face_areaU) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -882,18 +897,20 @@ 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, 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(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer - !! experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem. + !! experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem [nondim]. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I !< A logical flag indicating !! which I values to work on. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] ! Local variables real, dimension(SZIB_(G)) :: & du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. @@ -912,10 +929,10 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and uhtot_R ! and easterly (uhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by + real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [L H ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. - real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This + real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim]. This ! limiting is necessary to keep the inverse of visc_rem ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used @@ -935,7 +952,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & du_max_CFL, du_min_CFL, dt, G, GV, US, CS, visc_rem, & - j, ish, ieh, do_I) + j, ish, ieh, do_I, por_face_areaU) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently ! negative velocity correction for the easterly-flux, and a sufficiently @@ -976,11 +993,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, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) 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, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) 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, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) 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) @@ -1022,32 +1039,34 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, end subroutine set_zonal_BT_cont !> Calculates the mass or volume fluxes through the meridional faces, and other related quantities. -subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & +subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_face_areaV, vhbt, & visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vh !< Volume flux through meridional - !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1] + !! faces = v*h*dx [H L2 s-1 ~> m3 s-1 or kg s-1] real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type + type(ocean_OBC_type), pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] + real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through + !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_v !< Both the fraction of the momentum !! originally in a layer that remains after a time-step of viscosity, !! and the fraction of a time-step's worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. Nondimensional between - !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through - !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. + !! that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_v is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: v_cor - !< The meridional velocitiess (v with a barotropic correction) + !< The meridional velocities (v with a barotropic correction) !! that give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. @@ -1065,7 +1084,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H L ~> m2 or kg m-1]. - real :: FA_v ! A sum of meridional face areas [H m ~> m2 or kg m-1]. + real :: FA_v ! A sum of meridional face areas [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(GV)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. @@ -1084,11 +1103,11 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then + if (associated(OBC)) then ; if (OBC%OBC_pe) then local_specified_BC = OBC%specified_v_BCs_exist_globally local_Flather_OBC = OBC%Flather_v_BCs_exist_globally local_open_BC = OBC%open_v_BCs_exist_globally - endif ; endif ; endif + endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = GV%ke CFL_dt = CS%CFL_limit_adjust / dt @@ -1105,7 +1124,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; enddo else call PPM_reconstruction_y(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, CS%simple_2nd, OBC) endif do i=ish,ieh ; visc_rem(i,k) = 1.0 ; enddo enddo @@ -1114,7 +1133,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,v,h_in,h_L,h_R,vh,use_visc_rem, & !$OMP visc_rem_v,dt,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 set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC, & +!$OMP por_face_areaV) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & !$OMP is_simple,FAvi,dy_S,any_simple_OBC,l_seg) & @@ -1129,7 +1149,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) if (local_specified_BC) then do i=ish,ieh l_seg = OBC%segnum_v(i,J) @@ -1238,7 +1258,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (present(vhbt)) then call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & - j, ish, ieh, do_I, vh, OBC=OBC) + j, ish, ieh, do_I, por_face_areaV, vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo @@ -1256,13 +1276,13 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (set_BT_cont) then call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,& dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & - visc_rem_max, J, ish, ieh, do_I) + visc_rem_max, J, ish, ieh, do_I, por_face_areaV) if (any_simple_OBC) then do i=ish,ieh l_seg = OBC%segnum_v(i,J) do_I(I) = .false. - if(l_seg /= OBC_NONE) & + if (l_seg /= OBC_NONE) & do_I(i) = (OBC%segment(l_seg)%specified) if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) @@ -1293,7 +1313,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (OBC%segment(n)%direction == OBC_DIRECTION_N) then do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*(G%dx_Cv(i,J)*por_face_areaV(i,J,k)) ; enddo BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1301,7 +1321,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & else do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*(G%dx_Cv(i,J)*por_face_areaV(i,J,k)) ; enddo BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1315,10 +1335,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then if (present(v_cor)) then call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaV, visc_rem_v) else call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaV, visc_rem_v) endif endif ; endif @@ -1326,14 +1346,14 @@ end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & - ish, ieh, do_I, vol_CFL, OBC) + ish, ieh, do_I, vol_CFL, por_face_areaV, 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]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic - !! acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction @@ -1352,6 +1372,8 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & logical, dimension(SZI_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the !! ratio of face areas to the cell areas when estimating the CFL number. + real, dimension(SZI_(G), SZJB_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -1372,7 +1394,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & 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 * & + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(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)) @@ -1380,7 +1402,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & 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 * & + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(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)) ) h_marg = h_L(i,j+1) + CFL * ((h_R(i,j+1)-h_L(i,j+1)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1388,7 +1410,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & vh(i) = 0.0 h_marg = 0.5 * (h_L(i,j+1) + h_R(i,j)) endif - dvhdv(i) = G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then @@ -1398,11 +1420,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & if (l_seg /= OBC_NONE) then if (OBC%segment(l_seg)%open) then if (OBC%segment(l_seg)%direction == OBC_DIRECTION_N) then - vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j) - dvhdv(i) = G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * h(i,j) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h(i,j) * visc_rem(i) else - vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j+1) - dvhdv(i) = G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * h(i,j+1) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h(i,j+1) * visc_rem(i) endif endif endif @@ -1410,19 +1432,22 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & endif end subroutine merid_flux_layer -!> Sets the effective interface thickness at each meridional velocity point. +!> Sets the effective interface thickness at each meridional velocity point, optionally scaling +!! back these thicknesses to account for viscosity and fractional open areas. subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, & - marginal, visc_rem_v, OBC) + marginal, OBC, por_face_areaV, visc_rem_v) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_L !< Left thickness in the reconstruction, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the reconstruction, !! [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Thickness at meridional faces, + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Effective thickness at meridional faces, + !! scaled down to account for the effects of + !! viscoity and the fractional open area !! [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -1431,12 +1456,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the marginal !! face thicknesses; otherwise report transport-averaged thicknesses. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), optional, intent(in) :: visc_rem_v !< Both the fraction !! of the momentum originally in a layer that remains after a time-step of !! viscosity, and the fraction of a time-step's worth of a barotropic - !! acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_v is between 0 (at the bottom) and 1 (far above the bottom). ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -1466,7 +1493,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, 3.0*curv_3*(CFL - 1.0)) else h_avg = 0.5 * (h_L(i,j+1,k) + h_R(i,j,k)) - ! The choice to use the arithmetic mean here is somewhat arbitrariy, but + ! The choice to use the arithmetic mean here is somewhat arbitrarily, but ! it should be noted that h_L(i+1,j,k) and h_R(i,j,k) are usually the same. h_marg = 0.5 * (h_L(i,j+1,k) + h_R(i,j,k)) ! h_marg = (2.0 * h_L(i,j+1,k) * h_R(i,j,k)) / & @@ -1478,16 +1505,17 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, enddo ; enddo ; enddo if (present(visc_rem_v)) then + ! Scale back the thickness to account for the effects of viscosity and the fractional open + ! thickness to give an appropriate non-normalized weight for each layer in determining the + ! barotropic acceleration. !$OMP parallel do default(shared) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h_v(i,J,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo ; enddo ; enddo endif local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then - local_open_BC = OBC%open_v_BCs_exist_globally - endif ; endif + if (associated(OBC)) local_open_BC = OBC%open_v_BCs_exist_globally if (local_open_BC) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_N_or_S) then @@ -1495,7 +1523,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_N) then if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h(i,j,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied @@ -1505,7 +1533,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h(i,j+1,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied @@ -1522,7 +1550,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, G, GV, US, CS, visc_rem, & - j, ish, ieh, do_I_in, vh_3d, OBC) + j, ish, ieh, do_I_in, por_face_areaV, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -1537,8 +1565,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !< Both the fraction of the momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. Non-dimensional - !! between 0 (at the bottom) and 1 (far above the bottom). + !! a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -1551,20 +1579,22 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. logical, dimension(SZI_(G)), & intent(in) :: do_I_in !< A flag indicating which I values to work on. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(inout) :: vh_3d !< Volume flux through meridional !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - vh_aux, & ! An auxiliary meridional volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. - dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. + vh_aux, & ! An auxiliary meridional volume flux [H L2 T-1 ~> m3 s-1 or kg s-1]. + dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & vh_err, & ! Difference between vhbt and the summed vh [H L2 T-1 ~> m3 s-1 or kg s-1]. vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -1642,7 +1672,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) enddo ; endif if (itt < max_itts) then @@ -1672,7 +1702,7 @@ end subroutine meridional_flux_adjust !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & - visc_rem_max, j, ish, ieh, do_I) + visc_rem_max, j, ish, ieh, do_I, por_face_areaV) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. @@ -1694,18 +1724,20 @@ 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, 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(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic - !! acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem. + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem [nondim] integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. logical, dimension(SZI_(G)), intent(in) :: do_I !< A logical flag indicating !! which I values to work on. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] ! Local variables real, dimension(SZI_(G)) :: & dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. @@ -1721,7 +1753,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) vh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. + FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and vhtot_R ! and northerly (vhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: FA_0 ! The effective face area with 0 barotropic transport [H L ~> m2 or kg m-1]. @@ -1732,7 +1764,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used ! in finding the barotropic velocity that changes the - ! flow direction. This is necessary to keep the inverse + ! flow direction [nondim]. This is necessary to keep the inverse ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] @@ -1747,7 +1779,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, do i=ish,ieh ; zeros(i) = 0.0 ; enddo call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & dv_max_CFL, dv_min_CFL, dt, G, GV, US, CS, visc_rem, & - j, ish, ieh, do_I) + j, ish, ieh, do_I, por_face_areaV) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently ! negative velocity correction for the northerly-flux, and a sufficiently @@ -1788,11 +1820,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, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) 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) @@ -1848,22 +1880,23 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. real, parameter :: oneSixth = 1./6. - real :: h_ip1, h_im1 - real :: dMx, dMn + real :: h_ip1, h_im1 ! Neighboring thicknesses or sensibly extrapolated values [H ~> m or kg m-2] + real :: dMx, dMn ! The difference between the local thickness and the maximum (dMx) or + ! minimum (dMn) of the surrounding values [H ~> m or kg m-2] character(len=256) :: mesg integer :: i, j, isl, iel, jsl, jel, n, stencil logical :: local_open_BC type(OBC_segment_type), pointer :: segment => NULL() local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_BC = OBC%open_u_BCs_exist_globally - endif ; endif + endif isl = LB%ish-1 ; iel = LB%ieh+1 ; jsl = LB%jsh ; jel = LB%jeh @@ -1983,22 +2016,23 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. real, parameter :: oneSixth = 1./6. - real :: h_jp1, h_jm1 - real :: dMx, dMn + real :: h_jp1, h_jm1 ! Neighboring thicknesses or sensibly extrapolated values [H ~> m or kg m-2] + real :: dMx, dMn ! The difference between the local thickness and the maximum (dMx) or + ! minimum (dMn) of the surrounding values [H ~> m or kg m-2] character(len=256) :: mesg integer :: i, j, isl, iel, jsl, jel, n, stencil logical :: local_open_BC type(OBC_segment_type), pointer :: segment => NULL() local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif isl = LB%ish ; iel = LB%ieh ; jsl = LB%jsh-1 ; jel = LB%jeh+1 @@ -2116,8 +2150,9 @@ subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) integer, intent(in) :: jie !< End of j index range. ! Local variables - real :: curv, dh, scale - character(len=256) :: mesg + real :: curv ! The grid-normalized curvature of the three thicknesses [H ~> m or kg m-2] + real :: dh ! The difference between the edge thicknesses [H ~> m or kg m-2] + real :: scale ! A scaling factor to reduce the curvature of the fit [nondim] integer :: i,j do j=jis,jie ; do i=iis,iie @@ -2157,9 +2192,12 @@ subroutine PPM_limit_CW84(h_in, h_L, h_R, G, iis, iie, jis, jie) integer, intent(in) :: jie !< End of j index range. ! Local variables - real :: h_i, RLdiff, RLdiff2, RLmean, FunFac - character(len=256) :: mesg - integer :: i,j + real :: h_i ! A copy of the cell-average layer thickness [H ~> m or kg m-2] + real :: RLdiff ! The difference between the input edge values [H ~> m or kg m-2] + real :: RLdiff2 ! The squared difference between the input edge values [H2 ~> m2 or kg2 m-4] + real :: RLmean ! The average of the input edge thicknesses [H ~> m or kg m-2] + real :: FunFac ! A curious product of the thickness slope and curvature [H2 ~> m2 or kg2 m-4] + integer :: i, j do j=jis,jie ; do i=iis,iie ! This limiter monotonizes the parabola following @@ -2204,17 +2242,13 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to !! regulate diagnostic output. - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. -!> This include declares and sets the variable "version". -#include "version_variable.h" - real :: tol_eta_m ! An unscaled version of tol_eta [m]. + type(continuity_PPM_CS), intent(inout) :: CS !< Module's control structure. + + !> This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "continuity_PPM_init called with associated control structure.") - return - endif - allocate(CS) + CS%initialized = .true. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -2242,16 +2276,8 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) "tolerance for SSH is 4 times this value. The default "//& "is 0.5*NK*ANGSTROM, and this should not be set less "//& "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & - default=0.5*GV%ke*GV%Angstrom_m, unscaled=tol_eta_m) - - !### ETA_TOLERANCE_AUX can be obsoleted. - call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & - "The tolerance for free-surface height discrepancies "//& - "between the barotropic solution and the sum of the "//& - "layer thicknesses when calculating the auxiliary "//& - "corrected velocities. By default, this is the same as "//& - "ETA_TOLERANCE, but can be made larger for efficiency.", & - units="m", default=tol_eta_m, scale=GV%m_to_H) + default=0.5*GV%ke*GV%Angstrom_m) + call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies "//& "between the barotropic solution and the sum of the "//& @@ -2292,19 +2318,13 @@ end subroutine continuity_PPM_init !> continuity_PPM_stencil returns the continuity solver stencil size function continuity_PPM_stencil(CS) result(stencil) - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. integer :: stencil !< The continuity solver stencil size with the current settings. stencil = 3 ; if (CS%simple_2nd) stencil = 2 ; if (CS%upwind_1st) stencil = 1 end function continuity_PPM_stencil -!> Destructor for continuity_ppm_cs -subroutine continuity_PPM_end(CS) - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. - deallocate(CS) -end subroutine continuity_PPM_end - !> \namespace mom_continuity_ppm !! !! This module contains the subroutines that advect layer diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 04e151d5a7..8f26918253 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -11,7 +11,6 @@ module MOM_density_integrals use MOM_EOS, only : calculate_spec_vol use MOM_EOS, only : calculate_specific_vol_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg -use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type use MOM_string_functions, only : uppercase use MOM_variables, only : thermo_var_ptrs @@ -56,7 +55,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly @@ -113,7 +112,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly @@ -364,14 +363,14 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer [R L2 Z T-2 ~> Pa Z] + !! top of the layer [R L2 Z T-2 ~> Pa m] real, dimension(SZIB_(HI),SZJ_(HI)), & optional, intent(inout) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -428,13 +427,13 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz(HI%iscB:HI%iecB+1) ! Layer thicknesses at tracer points [Z ~> m] - real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m] - real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m] + real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subgrid locations [Z ~> m] + real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subgrid locations [Z ~> m] real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim] real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC] real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [ppt] real :: z0pres ! The height at which the pressure is zero [Z ~> m] - real :: hWght ! A topographically limited thicknes weight [Z ~> m] + real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] logical :: use_stanley_eos ! True is SGS variance fields exist in tv. @@ -802,11 +801,11 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & !! subtracted out to reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used to calculate !! the pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration [m s-2] + real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] @@ -864,7 +863,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: T_top, T_mn, T_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of T real :: S_top, S_mn, S_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of S real :: z0pres ! The height at which the pressure is zero [Z ~> m] - real :: hWght ! A topographically limited thicknes weight [Z ~> m] + real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n @@ -1137,7 +1136,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, & !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly across @@ -1196,7 +1195,7 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d !! The calculation is mathematically identical with different values of !! alpha_ref, but alpha_ref alters the effects of roundoff, and !! answers do change. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly @@ -1419,7 +1418,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly @@ -1455,9 +1454,12 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: p15(15) ! Pressures at fifteen quadrature points, scaled back to Pa as necessary [Pa] real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1] or [m3 kg-1] real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] - real :: T_top, T_bot, S_top, S_bot, P_top, P_bot + real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [degC] + real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [ppt] + real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom, + ! scaled back to Pa as necessary [Pa] - real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1] + real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] or [m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [R L2 T-2 ~> Pa] real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] @@ -1657,7 +1659,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: rho_ref !< Reference density with which calculation !! are anomalous to [R ~> kg m-3] real, intent(in) :: G_e !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: P_b !< Pressure at the bottom of the cell [R L2 T-2 ~> Pa] real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m] @@ -1736,7 +1738,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real :: fract_dp_at_pos !< The change in pressure from the layer top to !! fractional position pos [R L2 T-2 ~> Pa] ! Local variables diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0532aeac53..f22fb9a862 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -3,7 +3,7 @@ module MOM_dynamics_split_RK2 ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing @@ -14,6 +14,8 @@ module MOM_dynamics_split_RK2 use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE 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 : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v 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 use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR @@ -39,8 +41,7 @@ module MOM_dynamics_split_RK2 use MOM_barotropic, only : barotropic_end use MOM_boundary_update, only : update_OBC_data, update_OBC_CS use MOM_continuity, only : continuity, continuity_CS -use MOM_continuity, only : continuity_init, continuity_end -use MOM_continuity, only : continuity_stencil +use MOM_continuity, only : continuity_init, continuity_stencil use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_CS use MOM_CoriolisAdv, only : CoriolisAdv_init, CoriolisAdv_end use MOM_debugging, only : check_redundant @@ -55,7 +56,7 @@ module MOM_dynamics_split_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_open_boundary, only : open_boundary_test_extern_h, update_OBC_ramp use MOM_PressureForce, only : PressureForce, PressureForce_CS -use MOM_PressureForce, only : PressureForce_init, PressureForce_end +use MOM_PressureForce, only : PressureForce_init use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_CS @@ -149,15 +150,15 @@ module MOM_dynamics_split_RK2 !! dynamically. real :: be !< A nondimensional number from 0.5 to 1 that controls - !! the backward weighting of the time stepping scheme. + !! the backward weighting of the time stepping scheme [nondim] real :: begw !< A nondimensional number from 0 to 1 that controls !! the extent to which the treatment of gravity waves !! is forward-backward (0) or simulated backward - !! Euler (1). 0 is almost always used. + !! Euler (1) [nondim]. 0 is often used. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_OBC !< If true, do debugging calls for open boundary conditions. - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 @@ -165,6 +166,7 @@ module MOM_dynamics_split_RK2 integer :: id_umo_2d = -1, id_vmo_2d = -1 integer :: id_PFu = -1, id_PFv = -1 integer :: id_CAu = -1, id_CAv = -1 + integer :: id_ueffA = -1, id_veffA = -1 ! integer :: id_hf_PFu = -1, id_hf_PFv = -1 integer :: id_h_PFu = -1, id_h_PFv = -1 integer :: id_hf_PFu_2d = -1, id_hf_PFv_2d = -1 @@ -199,23 +201,21 @@ module MOM_dynamics_split_RK2 ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + type(continuity_CS) :: continuity_CSp + !> The CoriolisAdv control structure + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() - !> A pointer to the barotropic stepping control structure - type(barotropic_CS), pointer :: barotropic_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to a structure containing interface height diffusivities - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() - !> A pointer to the vertical viscosity control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() + !> A pointer to the barotropic stepping control structure + type(barotropic_CS) :: barotropic_CSp !> A pointer to the tidal forcing control structure - type(tidal_forcing_CS), pointer :: tides_CSp => NULL() + type(tidal_forcing_CS) :: tides_CSp !> A pointer to the ALE control structure. type(ALE_CS), pointer :: ALE_CSp => NULL() @@ -255,45 +255,46 @@ module MOM_dynamics_split_RK2 !> RK2 splitting for time stepping MOM adiabatic dynamics subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, calc_dtbt, VarMix, & - MEKE, thickness_diffuse_CSp, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + MEKE, thickness_diffuse_CSp, pbv, Waves) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + target, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] + target, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< layer thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic 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 [T ~> s] + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + 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 !< 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 !< surf pressure at the start of this dynamic + real, dimension(:,:), pointer :: p_surf_begin !< Surface pressure at the start of this dynamic !! time step [R L2 T-2 ~> Pa] - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at the end of this dynamic + real, dimension(:,:), pointer :: p_surf_end !< Surface pressure at the end of this dynamic !! time step [R L2 T-2 ~> Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport + target, intent(inout) :: uh !< Zonal volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport + target, intent(inout) :: vh !< Meridional volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + intent(inout) :: uhtr !< Accumulated zonal volume or mass transport !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vhtr !< accumulatated merid volume/mass transport + intent(inout) :: vhtr !< Accumulated meridional volume or mass transport !! since last tracer advection [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< Free surface height or column mass !! averaged over time step [H ~> m or kg m-2] - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to a structure containing + type(MOM_dyn_split_RK2_CS), pointer :: CS !< Module control structure + logical, intent(in) :: calc_dtbt !< If true, recalculate the barotropic time step + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -301,7 +302,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted thickness [H ~> m or kg m-2]. - + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_bc_accel real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each @@ -312,11 +314,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! uh_in and vh_in are the zonal or meridional mass transports that would be ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out - real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out - ! uhbt_out and vhbt_out are the vertically summed transports from the - ! barotropic solver based on its final velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJ_(G)) :: eta_pred ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. @@ -329,46 +326,26 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real :: pres_to_eta ! A factor that converts pressures to the units of eta ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1] real, pointer, dimension(:,:) :: & - p_surf => NULL(), eta_PF_start => NULL(), & - taux_bot => NULL(), tauy_bot => NULL(), & - eta => NULL() + p_surf => NULL(), & ! A pointer to the surface pressure [R L2 T-2 ~> Pa] + eta_PF_start => NULL(), & ! The value of eta that corresponds to the starting pressure + ! for the barotropic solver [H ~> m or kg m-2] + taux_bot => NULL(), & ! A pointer to the zonal bottom stress in some cases [R L Z T-2 ~> Pa] + tauy_bot => NULL(), & ! A pointer to the meridional bottom stress in some cases [R L Z T-2 ~> Pa] + ! This pointer is just used as shorthand for CS%eta. + eta => NULL() ! A pointer to the instantaneous free surface height (in Boussinesq + ! mode) or column mass anomaly (in non-Boussinesq mode) [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & + ! These pointers are used to alter which fields are passed to btstep with various options: + u_ptr => NULL(), & ! A pointer to a zonal velocity [L T-1 ~> m s-1] + v_ptr => NULL(), & ! A pointer to a meridional velocity [L T-1 ~> m s-1] + uh_ptr => NULL(), & ! A pointer to a zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + vh_ptr => NULL(), & ! A pointer to a meridional volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + ! These pointers are just used as shorthand for CS%u_av, CS%v_av, and CS%h_av. 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, allocatable, dimension(:,:,:) :: & - ! hf_PFu, hf_PFv, & ! Pressure force accel. x fract. thickness [L T-2 ~> m s-2]. - ! hf_CAu, hf_CAv, & ! Coriolis force accel. x fract. thickness [L T-2 ~> m s-2]. - ! hf_u_BT_accel, hf_v_BT_accel ! barotropic correction accel. x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - - real, allocatable, dimension(:,:) :: & - hf_PFu_2d, hf_PFv_2d, & ! Depth integeral of hf_PFu, hf_PFv [L T-2 ~> m s-2]. - hf_CAu_2d, hf_CAv_2d, & ! Depth integeral of hf_CAu, hf_CAv [L T-2 ~> m s-2]. - hf_u_BT_accel_2d, hf_v_BT_accel_2d ! Depth integeral of hf_u_BT_accel, hf_v_BT_accel - - ! Diagnostics for thickness x momentum budget terms - real, allocatable, dimension(:,:,:) :: & - h_PFu, h_PFv, & ! Pressure force accel. x thickness [H L T-2 ~> m2 s-2]. - h_CAu, h_CAv, & ! Coriolis force accel. x thickness [H L T-2 ~> m2 s-2]. - h_u_BT_accel, h_v_BT_accel ! barotropic correction accel. x thickness [H L T-2 ~> m2 s-2]. - - ! Dignostics for layer-sum of thickness x momentum budget terms - real, dimension(SZIB_(G),SZJ_(G)) :: & - intz_PFu_2d, intz_CAu_2d, intz_u_BT_accel_2d ! [H L T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G)) :: & - intz_PFv_2d, intz_CAv_2d, intz_v_BT_accel_2d ! [H L T-2 ~> m2 s-2]. - - ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], - real, allocatable, dimension(:,:,:) :: & - PFu_visc_rem, PFv_visc_rem, & ! Pressure force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - CAu_visc_rem, CAv_visc_rem, & ! Coriolis force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - u_BT_accel_visc_rem, v_BT_accel_visc_rem ! barotropic correction accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf @@ -397,7 +374,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ! Update CFL truncation value as function of time - call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) + call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp, US) if (CS%debug) then call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) @@ -418,7 +395,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug_OBC) call open_boundary_test_extern_h(G, GV, CS%OBC, h) ! Update OBC ramp value as function of time - call update_OBC_ramp(Time_local, CS%OBC) + call update_OBC_ramp(Time_local, CS%OBC, US) do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB u_old_rad_OBC(I,j,k) = u_av(I,j,k) @@ -485,7 +462,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -527,8 +504,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo 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 set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) if (CS%debug) then @@ -563,8 +539,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, 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 continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv, & + visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -581,12 +557,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the predictor step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & - u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & - G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, ADp=CS%ADp, & - OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & - taux_bot=taux_bot, tauy_bot=tauy_bot, & - uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, & + CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, & + CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, & + eta_PF_start, taux_bot, tauy_bot, uh_ptr, vh_ptr, u_ptr, v_ptr) if (showCallTree) call callTree_leave("btstep()") call cpu_clock_end(id_clock_btstep) @@ -650,8 +624,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & - CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & + call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv, & + CS%uhbt, CS%vhbt, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") @@ -732,7 +706,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & + MEKE, Varmix, G, GV, US, CS%hor_visc, & OBC=CS%OBC, BT=CS%barotropic_CSp, TD=thickness_diffuse_CSp, & ADp=CS%ADp) call cpu_clock_end(id_clock_horvisc) @@ -741,7 +715,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -782,13 +756,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the corrector step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & - CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & - eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & - CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, ADp=CS%ADp, & - OBC=CS%OBC, BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & - taux_bot=taux_bot, tauy_bot=tauy_bot, & - uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, & + CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, & + CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, & + eta_PF_start, taux_bot, tauy_bot, uh_ptr, vh_ptr, u_ptr, v_ptr, etaav=eta_av) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo call cpu_clock_end(id_clock_btstep) @@ -856,8 +827,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & - CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) + call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv, & + CS%uhbt, CS%vhbt, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids @@ -894,8 +865,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo - ! The time-averaged free surface height has already been set by the last - ! call to btstep. + ! The time-averaged free surface height has already been set by the last call to btstep. + + ! Deallocate this memory to avoid a memory leak. ### We should revisit how this array is declared. -RWH + if (dyn_p_surf .and. associated(eta_PF_start)) deallocate(eta_PF_start) ! Here various terms used in to update the momentum equations are ! offered for time averaging. @@ -912,247 +885,78 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%id_u_BT_accel > 0) call post_data(CS%id_u_BT_accel, CS%u_accel_bt, CS%diag) if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (CS%id_hf_PFu > 0) then - ! allocate(hf_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_PFu, hf_PFu, CS%diag) - !endif - !if (CS%id_hf_PFv > 0) then - ! allocate(hf_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_PFv, hf_PFv, CS%diag) - !endif - if (CS%id_intz_PFu_2d > 0) then - intz_PFu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_PFu_2d(I,j) = intz_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_PFu_2d, intz_PFu_2d, CS%diag) - endif - if (CS%id_intz_PFv_2d > 0) then - intz_PFv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_PFv_2d(i,J) = intz_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_PFv_2d, intz_PFv_2d, CS%diag) - endif - - if (CS%id_hf_PFu_2d > 0) then - allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_PFu_2d(I,j) = hf_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_PFu_2d, hf_PFu_2d, CS%diag) - deallocate(hf_PFu_2d) - endif - if (CS%id_hf_PFv_2d > 0) then - allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_PFv_2d(i,J) = hf_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_PFv_2d, hf_PFv_2d, CS%diag) - deallocate(hf_PFv_2d) - endif - - if (CS%id_h_PFu > 0) then - allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_PFu, h_PFu, CS%diag) - deallocate(h_PFu) - endif - if (CS%id_h_PFv > 0) then - allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_PFv, h_PFv, CS%diag) - deallocate(h_PFv) - endif - - !if (CS%id_hf_CAu > 0) then - ! allocate(hf_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_CAu, hf_CAu, CS%diag) - !endif - !if (CS%id_hf_CAv > 0) then - ! allocate(hf_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_CAv, hf_CAv, CS%diag) - !endif - if (CS%id_intz_CAu_2d > 0) then - intz_CAu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_CAu_2d(I,j) = intz_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_CAu_2d, intz_CAu_2d, CS%diag) - endif - if (CS%id_intz_CAv_2d > 0) then - intz_CAv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_CAv_2d(i,J) = intz_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_CAv_2d, intz_CAv_2d, CS%diag) - endif - - if (CS%id_hf_CAu_2d > 0) then - allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_CAu_2d(I,j) = hf_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_CAu_2d, hf_CAu_2d, CS%diag) - deallocate(hf_CAu_2d) - endif - if (CS%id_hf_CAv_2d > 0) then - allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_CAv_2d(i,J) = hf_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_CAv_2d, hf_CAv_2d, CS%diag) - deallocate(hf_CAv_2d) - endif - - if (CS%id_h_CAu > 0) then - allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_CAu, h_CAu, CS%diag) - deallocate(h_CAu) - endif - if (CS%id_h_CAv > 0) then - allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_CAv, h_CAv, CS%diag) - deallocate(h_CAv) - endif - - !if (CS%id_hf_u_BT_accel > 0) then - ! allocate(hf_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_u_BT_accel, hf_u_BT_accel, CS%diag) - !endif - !if (CS%id_hf_v_BT_accel > 0) then - ! allocate(hf_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_v_BT_accel, hf_v_BT_accel, CS%diag) - !endif - if (CS%id_intz_u_BT_accel_2d > 0) then - intz_u_BT_accel_2d(:,:) = 0.0 + ! Calculate effective areas and post data + if (CS%id_ueffA > 0) then + ueffA(:,:,:) = 0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_u_BT_accel_2d(I,j) = intz_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_u_BT_accel_2d, intz_u_BT_accel_2d, CS%diag) - endif - if (CS%id_intz_v_BT_accel_2d > 0) then - intz_v_BT_accel_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_v_BT_accel_2d(i,J) = intz_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k) / up(I,j,k) enddo ; enddo ; enddo - call post_data(CS%id_intz_v_BT_accel_2d, intz_v_BT_accel_2d, CS%diag) + call post_data(CS%id_ueffA, ueffA, CS%diag) endif - if (CS%id_hf_u_BT_accel_2d > 0) then - allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_u_BT_accel_2d(I,j) = hf_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_u_BT_accel_2d, hf_u_BT_accel_2d, CS%diag) - deallocate(hf_u_BT_accel_2d) - endif - if (CS%id_hf_v_BT_accel_2d > 0) then - allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) + if (CS%id_veffA > 0) then + veffA(:,:,:) = 0 do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_v_BT_accel_2d(i,J) = hf_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k) / vp(i,J,k) enddo ; enddo ; enddo - call post_data(CS%id_hf_v_BT_accel_2d, hf_v_BT_accel_2d, CS%diag) - deallocate(hf_v_BT_accel_2d) + call post_data(CS%id_veffA, veffA, CS%diag) endif - if (CS%id_h_u_BT_accel > 0) then - allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_u_BT_accel, h_u_BT_accel, CS%diag) - deallocate(h_u_BT_accel) - endif - if (CS%id_h_v_BT_accel > 0) then - allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_v_BT_accel, h_v_BT_accel, CS%diag) - deallocate(h_v_BT_accel) - endif + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_PFu > 0) call post_product_u(CS%id_hf_PFu, CS%PFu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_PFv > 0) call post_product_v(CS%id_hf_PFv, CS%PFv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + !if (CS%id_hf_CAu > 0) call post_product_u(CS%id_hf_CAu, CS%CAu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_CAv > 0) call post_product_v(CS%id_hf_CAv, CS%CAv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + !if (CS%id_hf_u_BT_accel > 0) & + ! call post_product_u(CS%id_hf_u_BT_accel, CS%u_accel_bt, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_v_BT_accel > 0) & + ! call post_product_v(CS%id_hf_v_BT_accel, CS%v_accel_bt, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for the vertical sum of layer thickness x prssure force accelerations + if (CS%id_intz_PFu_2d > 0) call post_product_sum_u(CS%id_intz_PFu_2d, CS%PFu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_PFv_2d > 0) call post_product_sum_v(CS%id_intz_PFv_2d, CS%PFv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged prssure force accelerations + if (CS%id_hf_PFu_2d > 0) call post_product_sum_u(CS%id_hf_PFu_2d, CS%PFu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_PFv_2d > 0) call post_product_sum_v(CS%id_hf_PFv_2d, CS%PFv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x prssure force accelerations + if (CS%id_h_PFu > 0) call post_product_u(CS%id_h_PFu, CS%PFu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_PFv > 0) call post_product_v(CS%id_h_PFv, CS%PFv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics of Coriolis acceleratations + if (CS%id_intz_CAu_2d > 0) call post_product_sum_u(CS%id_intz_CAu_2d, CS%CAu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_CAv_2d > 0) call post_product_sum_v(CS%id_intz_CAv_2d, CS%CAv, CS%ADp%diag_hv, G, nz, CS%diag) + if (CS%id_hf_CAu_2d > 0) call post_product_sum_u(CS%id_hf_CAu_2d, CS%CAu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_CAv_2d > 0) call post_product_sum_v(CS%id_hf_CAv_2d, CS%CAv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_h_CAu > 0) call post_product_u(CS%id_h_CAu, CS%CAu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_CAv > 0) call post_product_v(CS%id_h_CAv, CS%CAv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics of barotropic solver acceleratations + if (CS%id_intz_u_BT_accel_2d > 0) & + call post_product_sum_u(CS%id_intz_u_BT_accel_2d, CS%u_accel_bt, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_v_BT_accel_2d > 0) & + call post_product_sum_v(CS%id_intz_v_BT_accel_2d, CS%v_accel_bt, CS%ADp%diag_hv, G, nz, CS%diag) + if (CS%id_hf_u_BT_accel_2d > 0) & + call post_product_sum_u(CS%id_hf_u_BT_accel_2d, CS%u_accel_bt, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_v_BT_accel_2d > 0) & + call post_product_sum_v(CS%id_hf_v_BT_accel_2d, CS%v_accel_bt, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_h_u_BT_accel > 0) & + call post_product_u(CS%id_h_u_BT_accel, CS%u_accel_bt, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_v_BT_accel > 0) & + call post_product_v(CS%id_h_v_BT_accel, CS%v_accel_bt, CS%ADp%diag_hv, G, nz, CS%diag) - if (CS%id_PFu_visc_rem > 0) then - allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - PFu_visc_rem(I,j,k) = CS%PFu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_PFu_visc_rem, PFu_visc_rem, CS%diag) - deallocate(PFu_visc_rem) - endif - if (CS%id_PFv_visc_rem > 0) then - allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - PFv_visc_rem(i,J,k) = CS%PFv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_PFv_visc_rem, PFv_visc_rem, CS%diag) - deallocate(PFv_visc_rem) - endif - if (CS%id_CAu_visc_rem > 0) then - allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - CAu_visc_rem(I,j,k) = CS%CAu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_CAu_visc_rem, CAu_visc_rem, CS%diag) - deallocate(CAu_visc_rem) - endif - if (CS%id_CAv_visc_rem > 0) then - allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - CAv_visc_rem(i,J,k) = CS%CAv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_CAv_visc_rem, CAv_visc_rem, CS%diag) - deallocate(CAv_visc_rem) - endif - if (CS%id_u_BT_accel_visc_rem > 0) then - allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u_BT_accel_visc_rem(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_u_BT_accel_visc_rem, u_BT_accel_visc_rem, CS%diag) - deallocate(u_BT_accel_visc_rem) - endif - if (CS%id_v_BT_accel_visc_rem > 0) then - allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v_BT_accel_visc_rem(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_v_BT_accel_visc_rem, v_BT_accel_visc_rem, CS%diag) - deallocate(v_BT_accel_visc_rem) - endif + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + if (CS%id_PFu_visc_rem > 0) call post_product_u(CS%id_PFu_visc_rem, CS%PFu, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_PFv_visc_rem > 0) call post_product_v(CS%id_PFv_visc_rem, CS%PFv, CS%ADp%visc_rem_v, G, nz, CS%diag) + if (CS%id_CAu_visc_rem > 0) call post_product_u(CS%id_CAu_visc_rem, CS%CAu, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_CAv_visc_rem > 0) call post_product_v(CS%id_CAv_visc_rem, CS%CAv, CS%ADp%visc_rem_v, G, nz, CS%diag) + if (CS%id_u_BT_accel_visc_rem > 0) & + call post_product_u(CS%id_u_BT_accel_visc_rem, CS%u_accel_bt, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_v_BT_accel_visc_rem > 0) & + call post_product_v(CS%id_v_BT_accel_visc_rem, CS%v_accel_bt, CS%ADp%visc_rem_v, G, nz, CS%diag) if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) @@ -1166,18 +970,18 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s end subroutine step_MOM_dyn_split_RK2 !> This subroutine sets up any auxiliary restart variables that are specific -!! to the unsplit time stepping scheme. All variables registered here should +!! to the split-explicit time stepping scheme. All variables registered here should !! have the ability to be recreated if they are not present in a restart file. subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, uh, vh) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd(2) character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -1243,8 +1047,8 @@ end subroutine register_restarts_dyn_split_RK2 subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, thickness_diffuse_CSp, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & - visc, dirs, ntrunc, calc_dtbt, cont_stencil) + OBC, update_OBC_CSp, ALE_CSp, set_visc, & + visc, dirs, ntrunc, pbv, calc_dtbt, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1263,46 +1067,45 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(param_file_type), intent(in) :: param_file !< parameter file for parsing 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 + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure 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 type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass !! diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields -! type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for -! !! the barotropic module - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure - !! used for the isopycnal height diffusive transport. + type(VarMix_CS), intent(inout) :: VarMix !< points to spatially variable viscosities + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure + !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control structure type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related type(directories), intent(in) :: dirs !< contains directory paths integer, target, intent(inout) :: ntrunc !< A target for the variable that records !! the number of times the velocity is !! truncated (this should be 0). logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step - integer, optional, intent(out) :: cont_stencil !< The stencil for thickness + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + integer, intent(out) :: cont_stencil !< The stencil for thickness !! from the continuity solver. ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tmp + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tmp ! A temporary copy of the layer thicknesses [H ~> m or kg m-2] character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=48) :: thickness_units, flux_units, eta_rest_name - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run. - real :: uH_rescale ! A rescaling factor for thickness transports from the representation in - ! a restart file to the internal representation in this run. - real :: accel_rescale ! A rescaling factor for accelerations from the representation in - ! a restart file to the internal representation in this run. + real :: H_rescale ! A rescaling factor for thicknesses from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] + real :: vel_rescale ! A rescaling factor for velocities from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] + real :: accel_rescale ! A rescaling factor for accelerations from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1402,24 +1205,22 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param grain=CLOCK_ROUTINE) call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - if (present(cont_stencil)) cont_stencil = continuity_stencil(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) + cont_stencil = continuity_stencil(CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE, ADp=CS%ADp) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp - call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & + CS%set_visc_CSp => set_visc + call updateCFLtruncationValue(Time, CS%vertvisc_CSp, US, & activate=is_new_run(restart_CS) ) if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - if (OBC%ramp) call update_OBC_ramp(Time, CS%OBC, & + if (OBC%ramp) call update_OBC_ramp(Time, CS%OBC, US, & activate=is_new_run(restart_CS) ) endif if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp @@ -1451,7 +1252,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) then call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp, & + G, GV, US, CS%hor_visc, & OBC=CS%OBC, BT=CS%barotropic_CSp, & TD=thickness_diffuse_CSp) else @@ -1482,7 +1283,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, 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, CS%OBC, pbv) 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)) @@ -1527,6 +1328,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & + 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + y_cell_method='sum', v_extensive = .true.) + CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & + 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + x_cell_method='sum', v_extensive = .true.) !CS%id_hf_PFu = register_diag_field('ocean_model', 'hf_PFu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Pressure Force Acceleration', & @@ -1559,14 +1366,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_PFv_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_PFu = register_diag_field('ocean_model', 'h_PFu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Pressure Force Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + 'Thickness Multiplied Zonal Pressure Force Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_PFv = register_diag_field('ocean_model', 'h_PFv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Pressure Force Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + 'Thickness Multiplied Meridional Pressure Force Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_PFu_2d = register_diag_field('ocean_model', 'intz_PFu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Pressure Force Acceleration', & @@ -1589,14 +1396,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_CAv_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_CAu = register_diag_field('ocean_model', 'h_CAu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_CAv = register_diag_field('ocean_model', 'h_CAv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_CAu_2d = register_diag_field('ocean_model', 'intz_CAu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Coriolis and Advective Acceleration', & @@ -1639,14 +1446,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_u_BT_accel = register_diag_field('ocean_model', 'h_u_BT_accel', diag%axesCuL, Time, & - 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_v_BT_accel = register_diag_field('ocean_model', 'h_v_BT_accel', diag%axesCvL, Time, & - 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_u_BT_accel_2d = register_diag_field('ocean_model', 'intz_u_BT_accel_2d', diag%axesCu1, Time, & 'Depth-integral of Barotropic Anomaly Zonal Acceleration', & @@ -1659,31 +1466,31 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_intz_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_PFu_visc_rem = register_diag_field('ocean_model', 'PFu_visc_rem', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_PFu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) - if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_CAu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) - if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_u_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) - if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) @@ -1704,26 +1511,13 @@ subroutine end_dyn_split_RK2(CS) type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure call barotropic_end(CS%barotropic_CSp) - deallocate(CS%barotropic_CSp) call vertvisc_end(CS%vertvisc_CSp) deallocate(CS%vertvisc_CSp) - call hor_visc_end(CS%hor_visc_CSp) - - call PressureForce_end(CS%PressureForce_CSp) - deallocate(CS%PressureForce_CSp) - - if (associated(CS%tides_CSp)) then - call tidal_forcing_end(CS%tides_CSp) - deallocate(CS%tides_CSp) - endif - - call CoriolisAdv_end(CS%CoriolisAdv_Csp) - deallocate(CS%CoriolisAdv_CSp) - - call continuity_end(CS%continuity_CSp) - deallocate(CS%continuity_CSp) + call hor_visc_end(CS%hor_visc) + call tidal_forcing_end(CS%tides_CSp) + call CoriolisAdv_end(CS%CoriolisAdv) DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6f33a00768..9a58dddd0f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -12,7 +12,7 @@ module MOM_dynamics_unsplit !* Runge-Kutta time stepping scheme for the momentum and a forward- * !* backward coupling between the momentum and continuity equations. * !* This was the orignal unsplit time stepping scheme used in early * -!* versions of HIM and its precuror. While it is very simple and * +!* versions of HIM and its precursor. While it is very simple and * !* accurate, it is much less efficient that the split time stepping * !* scheme for realistic oceanographic applications. It has been * !* retained for all of these years primarily to verify that the split * @@ -50,7 +50,7 @@ module MOM_dynamics_unsplit !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -67,8 +67,6 @@ module MOM_dynamics_unsplit use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, MOM_restart_CS use MOM_time_manager, only : time_type, real_to_time, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -89,7 +87,6 @@ module MOM_dynamics_unsplit use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS -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, vertvisc_init, vertvisc_CS @@ -124,10 +121,11 @@ module MOM_dynamics_unsplit !! for viscosity. The default should be true, but it is false. logical :: debug !< If true, write verbose checksums for debugging purposes. - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 + integer :: id_ueffA = -1, id_veffA = -1 integer :: id_PFu = -1, id_PFv = -1, id_CAu = -1, id_CAv = -1 !>@} @@ -144,13 +142,13 @@ module MOM_dynamics_unsplit ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to the vertvisc control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure @@ -186,7 +184,7 @@ module MOM_dynamics_unsplit !! 3rd order (for the inviscid momentum equations) order scheme subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & - VarMix, MEKE, Waves) + VarMix, MEKE, pbv, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -217,18 +215,19 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields - !! that specify the spatially variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing - !! fields related to the Mesoscale Eddy Kinetic Energy. + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp ! Predicted or averaged layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] - real, dimension(:,:), pointer :: p_surf => NULL() + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] + real, dimension(:,:), pointer :: p_surf => NULL() ! A pointer to the surface pressure [R L2 T-2 ~> Pa] real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. real :: dt_visc ! The time step for a part of the update due to viscosity [T ~> s]. logical :: dyn_p_surf @@ -258,14 +257,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! diffu = horizontal viscosity terms (u,h) 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) + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, G, GV, US, CS%hor_visc) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) 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) @@ -302,7 +301,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -355,7 +354,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), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -368,7 +367,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -415,7 +414,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*0.5), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -430,6 +429,23 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call enable_averages(dt, Time_local, CS%diag) + ! Calculate effective areas and post data + if (CS%id_ueffA > 0) then + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) + endif + + if (CS%id_veffA > 0) then + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) + endif + ! h_av = (h + hp)/2 do k=1,nz do j=js-2,je+2 ; do i=is-2,ie+2 @@ -446,7 +462,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -512,16 +528,14 @@ end subroutine step_MOM_dyn_unsplit !! !! All variables registered here should have the ability to be recreated if they are not present !! in a restart file. -subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) +subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - ! Local arguments character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -552,8 +566,8 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + Accel_diag, Cont_diag, MIS, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -571,8 +585,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! regulate diagnostic output. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !!structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the various !! accelerations in the momentum equations, which can be used !! for later derived diagnostics, like energy budgets. @@ -582,7 +594,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. - type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions are !! used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. @@ -591,8 +602,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE control !! structure. - type(set_visc_CS), pointer :: setVisc_CSp !< This points to the set_visc - !! control structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control structure type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities, bottom drag !! viscosities, and related fields. @@ -601,7 +611,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS integer, target, intent(inout) :: ntrunc !< A target for the variable that !! records the number of times the velocity !! is truncated (this should be 0). - integer, optional, intent(out) :: cont_stencil !< The stencil for thickness + integer, intent(out) :: cont_stencil !< The stencil for thickness !! from the continuity solver. ! This subroutine initializes all of the variables that are used by this @@ -653,17 +663,15 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - if (present(cont_stencil)) cont_stencil = continuity_stencil(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) + cont_stencil = continuity_stencil(CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_unsplit called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) CS%OBC => OBC @@ -684,6 +692,12 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & + 'Effective U Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + y_cell_method='sum', v_extensive = .true.) + CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & + 'Effective V Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + x_cell_method='sum', v_extensive = .true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 18a192cb39..ec4a1aa843 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -48,7 +48,7 @@ module MOM_dynamics_unsplit_RK2 !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs use MOM_variables, only : ocean_internal_state, accel_diag_ptrs, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -66,8 +66,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_error_handler, only : MOM_set_verbosity use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, MOM_restart_CS use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -87,7 +85,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS -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, vertvisc_init, vertvisc_CS @@ -116,20 +113,21 @@ module MOM_dynamics_unsplit_RK2 !! 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. + !! the backward weighting of the time stepping scheme [nondim]. real :: begw !< A nondimensional number from 0 to 1 that controls !! the extent to which the treatment of gravity waves !! is forward-backward (0) or simulated backward - !! Euler (1). 0 is almost always used. + !! Euler (1) [nondim]. 0 is often used. logical :: use_correct_dt_visc !< If true, use the correct timestep in the calculation of the !! turbulent mixed layer properties for viscosity. !! The default should be true, but it is false. logical :: debug !< If true, write verbose checksums for debugging purposes. - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 + integer :: id_ueffA = -1, id_veffA = -1 integer :: id_PFu = -1, id_PFv = -1, id_CAu = -1, id_CAv = -1 !>@} @@ -146,13 +144,13 @@ module MOM_dynamics_unsplit_RK2 ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + type(continuity_CS) :: continuity_CSp + !> The CoriolisAdv control structure + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to the vertvisc control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure @@ -188,7 +186,7 @@ module MOM_dynamics_unsplit_RK2 !> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & - VarMix, MEKE) + VarMix, MEKE, pbv) 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 @@ -228,17 +226,19 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with - !! fields that specify the spatially - !! variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av ! Averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] - real, dimension(:,:), pointer :: p_surf => NULL() + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] + real, dimension(:,:), pointer :: p_surf => NULL() ! A pointer to the surface pressure [R L2 T-2 ~> Pa] real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s] real :: dt_visc ! The time step for a part of the update due to viscosity [T ~> s] logical :: dyn_p_surf @@ -269,7 +269,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, 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) + G, GV, US, CS%hor_visc) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) @@ -281,7 +281,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_continuity) ! This is a duplicate calculation of the last continuity from the previous step ! and could/should be optimized out. -AJA - call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) 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) @@ -296,7 +296,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) (function of h[n-1/2]) @@ -350,7 +350,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) 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) @@ -366,7 +366,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv, pbv) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) 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) @@ -448,6 +448,24 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, 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) +! Calculate effective areas and post data + if (CS%id_ueffA > 0) then + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) + endif + + if (CS%id_veffA > 0) then + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) + endif + + end subroutine step_MOM_dyn_unsplit_RK2 ! ============================================================================= @@ -457,15 +475,13 @@ end subroutine step_MOM_dyn_unsplit_RK2 !! !! All variables registered here should have the ability to be recreated if they are not present !! in a restart file. -subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) +subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. ! This subroutine sets up any auxiliary restart variables that are specific ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. @@ -500,8 +516,8 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + Accel_diag, Cont_diag, MIS, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -516,8 +532,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! regulate diagnostic output. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit_RK2. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart - !! control structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the !! various accelerations in the momentum equations, which can !! be used for later derived diagnostics, like energy budgets. @@ -527,7 +541,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. - type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions !! are used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. @@ -536,9 +549,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! to the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE !! control structure. - type(set_visc_CS), pointer :: setVisc_CSp !< This points to the - !! set_visc control - !! structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set visc control structure type(vertvisc_type), intent(inout) :: visc !< A structure containing !! vertical viscosities, bottom drag !! viscosities, and related fields. @@ -547,7 +558,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag integer, target, intent(inout) :: ntrunc !< A target for the variable !! that records the number of times the !! velocity is truncated (this should be 0). - integer, optional, intent(out) :: cont_stencil !< The stencil for + integer, intent(out) :: cont_stencil !< The stencil for !! thickness from the continuity solver. ! This subroutine initializes all of the variables that are used by this @@ -615,17 +626,15 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - if (present(cont_stencil)) cont_stencil = continuity_stencil(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) + cont_stencil = continuity_stencil(CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_unsplit_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) CS%OBC => OBC @@ -645,6 +654,12 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) + CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & + 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + y_cell_method='sum', v_extensive = .true.) + CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & + 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + x_cell_method='sum', v_extensive = .true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 2429ce9d2d..3248c09fa4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -17,6 +17,7 @@ module MOM_forcing_type use MOM_grid, only : ocean_grid_type use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands use MOM_spatial_means, only : global_area_integral, global_area_mean +use MOM_spatial_means, only : global_area_mean_u, global_area_mean_v use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -35,6 +36,7 @@ module MOM_forcing_type public set_derived_forcing_fields, copy_back_forcing_fields public set_net_mass_forcing, get_net_mass_forcing public rotate_forcing, rotate_mech_forcing +public homogenize_forcing, homogenize_mech_forcing !> Allocate the fields of a (flux) forcing type, based on either a set of input !! flags for each group of fields, or a pre-allocated reference forcing. @@ -103,10 +105,14 @@ module MOM_forcing_type 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] + seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] + + ! Integrated water mass fluxes into the ocean, used for passive tracer sources [H ~> m or kg m-2] + real, pointer, dimension(:,:) :: & + netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a + !! forcing timestep [H ~> m or kg m-2] + netMassOut => NULL() !< Net water mass flux out of the ocean integrated over a forcing timestep, + !! with negative values for water leaving the ocean [H ~> m or kg m-2] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & @@ -152,14 +158,14 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z T-1 ~> m s-1]. - area_berg => NULL(), & !< area of ocean surface covered by icebergs [m2 m-2] + area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [nondim] mass_berg => NULL() !< mass of icebergs [R Z ~> kg m-2] ! land ice-shelf related inputs real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z T-1 ~> m s-1]. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of - !! h-cells, nondimensional from 0 to 1. This is only + !! h-cells, from 0 to 1 [nondim]. This is only !! associated if ice shelves are enabled, and are !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) @@ -177,7 +183,7 @@ module MOM_forcing_type !! fluxes have been applied to the ocean. real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes !! should be applied [T ~> s]. If negative, this forcing - !! type variable has not yet been inialized. + !! type variable has not yet been initialized. logical :: gustless_accum_bug = .true. !< If true, use an incorrect expression in the time !! average of the gustless wind stress. real :: C_p !< heat capacity of seawater [Q degC-1 ~> J kg-1 degC-1]. @@ -185,8 +191,8 @@ module MOM_forcing_type ! CFC-related arrays needed in the MOM_CFC_cap module real, pointer, dimension(:,:) :: & - cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU Z T-1 kg m-3 = mol Z T-1 m-3 ~> mol m-2 s-1]. - cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU Z T-1 kg m-3 = mol Z T-1 m-3 ~> mol m-2 s-1]. + cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] + cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] ice_fraction => NULL(), & !< fraction of sea ice coverage at h-cells, from 0 to 1 [nondim]. u10_sqr => NULL() !< wind magnitude at 10 m squared [L2 T-2 ~> m2 s-2] @@ -215,7 +221,7 @@ module MOM_forcing_type 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]. + net_mass_src => NULL() !< The net mass source to the ocean [R Z T-1 ~> kg 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() @@ -231,7 +237,7 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & - area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [m2 m-2] + area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [nondim] mass_berg => NULL() !< mass of icebergs per unit ocean area [R Z ~> kg m-2] ! land ice-shelf related inputs @@ -257,15 +263,15 @@ module MOM_forcing_type !! ice needs to be accumulated, and the rigidity explicitly !! reset to zero at the driver level when appropriate. real, pointer, dimension(:,:) :: & - ustk0 => NULL(), & !< Surface Stokes drift, zonal [m/s] - vstk0 => NULL() !< Surface Stokes drift, meridional [m/s] + ustk0 => NULL(), & !< Surface Stokes drift, zonal [m s-1] + vstk0 => NULL() !< Surface Stokes drift, meridional [m s-1] real, pointer, dimension(:) :: & - stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m] + stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad m-1] real, pointer, dimension(:,:,:) :: & - ustkb => NULL(), & !< Stokes Drift spectrum, zonal [m/s] + ustkb => NULL(), & !< Stokes Drift spectrum, zonal [m s-1] !! Horizontal - u points !! 3rd dimension - wavenumber - vstkb => NULL() !< Stokes Drift spectrum, meridional [m/s] + vstkb => NULL() !< Stokes Drift spectrum, meridional [m s-1] !! Horizontal - v points !! 3rd dimension - wavenumber @@ -390,7 +396,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & 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) + net_salt_rate, pen_sw_bnd_Rate) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -452,7 +458,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating !! [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] @@ -461,7 +466,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! [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 ! or 0 for no limiting [H-1 ~> m-1 or m2 kg-1] - real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth + real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth [nondim] real :: I_Cp ! 1.0 / C_p [degC Q-1 ~> kg degC J-1] real :: I_Cp_Hconvert ! Unit conversion factors divided by the heat capacity ! [degC H R-1 Z-1 Q-1 ~> degC m3 J-1 or kg degC J-1] @@ -492,7 +497,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & is = G%isc ; ie = G%iec ; nz = GV%ke calculate_diags = .true. - if (present(skip_diags)) calculate_diags = .not. skip_diags ! error checking @@ -583,7 +587,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! for non-Bouss, we add/remove salt mass to total ocean mass. to conserve ! total salt mass ocean+ice, the sea ice model must lose mass when salt mass ! 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. + ! of netMassInOut are still [Z R ~> kg m-2], 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) + & @@ -732,12 +736,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! Diagnostics follow... if (calculate_diags) then - ! Store Net_salt for unknown reason? - if (associated(fluxes%salt_flux)) then - ! This seems like a bad idea to me. -RWH - if (calculate_diags) fluxes%netSalt(i,j) = US%kg_m2s_to_RZ_T*Net_salt(i) - endif - ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. if (associated(fluxes%heat_content_massin)) then @@ -914,7 +912,7 @@ end subroutine extractFluxes2d !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, & - buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) + buoyancyFlux, netHeatMinusSW, netSalt) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -927,62 +925,57 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on - real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] - real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux - !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating - !! diagnostics inside extractFluxes1d() + real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G)), intent(out) :: netHeatMinusSW !< Surface heat flux excluding shortwave + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(SZI_(G)), intent(out) :: netSalt !< surface salt flux + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + ! local variables - integer :: k - real, parameter :: dt = 1. ! to return a rate from extractFluxes1d - real, dimension(SZI_(G)) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] + real, dimension(SZI_(G)) :: netH ! net FW flux [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation - ! [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] + ! [H T-1 ~> m s-1 or kg m-2 s-1] + real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band - ! [degC H ~> degC m or degC kg m-2] + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R 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_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level - ! [degC H ~> degC m or degC kg m-2] + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] logical :: useRiverHeatContent 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 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] - integer :: i + real :: GoRho ! The gravitational acceleration divided by mean density times a + ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + real :: H_limit_fluxes ! A depth scale that specifies when the ocean is shallow that + ! it is necessary to eliminate fluxes [H ~> m or kg m-2] + integer :: i, k ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. useCalvingHeatContent = .False. - depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) + H_limit_fluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif - GoRho = (GV%g_Earth * GV%H_to_Z*US%T_to_s) / GV%Rho0 - - H_limit_fluxes = depthBeforeScalingFluxes + GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0 ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netH = water added/removed via surface fluxes [H s-1 ~> m s-1 or kg m-2 s-1] - ! netHeat = heat via surface fluxes [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - ! netSalt = salt via surface fluxes [ppt H s-1 ~> ppt m s-1 or gSalt m-2 s-1] + ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] + ! netHeat = heat via surface fluxes [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! netSalt = salt via surface fluxes [ppt H T-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux - ! this call returns the rate because dt=1 - call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt*US%s_to_T, & - depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & + ! this call returns the rate because dt=1 (in arbitrary time units) + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, 1.0, & + H_limit_fluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & - netSalt, penSWbnd, tv, .false., skip_diags=skip_diags) + netSalt, penSWbnd, tv, .false.) ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), optics, j, dt*US%s_to_T, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), optics, j, 1.0, & H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives @@ -990,12 +983,14 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt tv%eqn_of_state, EOS_domain(G%HI)) ! Adjust netSalt to reflect dilution effect of FW flux - 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 + ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 ) - netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) ! K H/s + netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) ! Convert to a buoyancy flux, excluding penetrating SW heating buoyancyFlux(G%isc:G%iec,1) = - GoRho * ( dRhodS(G%isc:G%iec) * netSalt(G%isc:G%iec) + & @@ -1011,7 +1006,7 @@ end subroutine calculateBuoyancyFlux1d !> Calculates surface buoyancy flux by adding up the heat, FW and salt fluxes, !! for 2d arrays. This is a wrapper for calculateBuoyancyFlux1d. subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, & - buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) + buoyancyFlux, netHeatMinusSW, netSalt) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1021,26 +1016,18 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] - real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux - !! [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux - !! [ppt H ~> ppt m or ppt kg m-2] - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating - !! diagnostics inside extractFluxes1d() + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netHeatMinusSW !< surface heat flux excluding shortwave + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netSalt !< Net surface salt flux + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! local variables - real, dimension( SZI_(G) ) :: netT ! net temperature flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] - real, dimension( SZI_(G) ) :: netS ! net saln flux !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] integer :: j - netT(G%isc:G%iec) = 0. ; netS(G%isc:G%iec) = 0. - - !$OMP parallel do default(shared) firstprivate(netT,netS) + !$OMP parallel do default(shared) do j=G%jsc,G%jec call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, optics_nbands(optics), h, Temp, Salt, & - tv, j, buoyancyFlux(:,j,:), netT, netS, skip_diags=skip_diags) - if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) - if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) + tv, j, buoyancyFlux(:,j,:), netHeatMinusSW(:,j), netSalt(:,j)) enddo end subroutine calculateBuoyancyFlux2d @@ -1104,20 +1091,19 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat", G%HI, & haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%p_surf)) & - call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf", G%HI, haloshift=hshift , scale=US%RL2_T2_to_Pa) + call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf", G%HI, haloshift=hshift, scale=US%RL2_T2_to_Pa) if (associated(fluxes%u10_sqr)) & - call hchksum(fluxes%u10_sqr, mesg//" fluxes%u10_sqr", G%HI, haloshift=hshift , scale=US%L_to_m**2*US%s_to_T**2) + call hchksum(fluxes%u10_sqr, mesg//" fluxes%u10_sqr", G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**2) if (associated(fluxes%ice_fraction)) & call hchksum(fluxes%ice_fraction, mesg//" fluxes%ice_fraction", G%HI, haloshift=hshift) if (associated(fluxes%cfc11_flux)) & - call hchksum(fluxes%cfc11_flux, mesg//" fluxes%cfc11_flux", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + call hchksum(fluxes%cfc11_flux, mesg//" fluxes%cfc11_flux", G%HI, haloshift=hshift, scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%cfc12_flux)) & - call hchksum(fluxes%cfc12_flux, mesg//" fluxes%cfc12_flux", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + call hchksum(fluxes%cfc12_flux, mesg//" fluxes%cfc12_flux", G%HI, haloshift=hshift, scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%salt_flux)) & call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux", G%HI, haloshift=hshift, scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%TKE_tidal)) & - call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal", G%HI, haloshift=hshift, & - scale=US%RZ3_T3_to_W_m2) + call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal", G%HI, haloshift=hshift, scale=US%RZ3_T3_to_W_m2) 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)) & @@ -1288,7 +1274,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & 'Meridional surface stress ocean interactions with atmos and ice', & - 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & + 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & 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') @@ -1316,22 +1302,22 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, endif endif - ! units for cfc11_flux and cfc12_flux are mol m-2 s-1 + ! units for cfc11_flux and cfc12_flux are [Conc R Z T-1 ~> mol m-2 s-1] ! See: ! http://clipc-services.ceda.ac.uk/dreq/u/0940cbee6105037e4b7aa5579004f124.html ! http://clipc-services.ceda.ac.uk/dreq/u/e9e21426e4810d0bb2d3dddb24dbf4dc.html if (present(use_cfcs)) then if (use_cfcs) then handles%id_cfc11 = register_diag_field('ocean_model', 'cfc11_flux', diag%axesT1, Time, & - 'Gas exchange flux of CFC11 into the ocean ', 'mol m-2 s-1', & - conversion= US%Z_to_m*US%s_to_T,& + 'Gas exchange flux of CFC11 into the ocean ', & + 'mol m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & cmor_field_name='fgcfc11', & cmor_long_name='Surface Downward CFC11 Flux', & cmor_standard_name='surface_downward_cfc11_flux') handles%id_cfc12 = register_diag_field('ocean_model', 'cfc12_flux', diag%axesT1, Time, & - 'Gas exchange flux of CFC12 into the ocean ', 'mol m-2 s-1', & - conversion= US%Z_to_m*US%s_to_T,& + 'Gas exchange flux of CFC12 into the ocean ', & + 'mol m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & cmor_field_name='fgcfc12', & cmor_long_name='Surface Downward CFC12 Flux', & cmor_standard_name='surface_downward_cfc12_flux') @@ -1363,11 +1349,11 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, !=============================================================== ! surface mass flux maps - handles%id_prcme = register_diag_field('ocean_model', 'PRCmE', diag%axesT1, Time, & - 'Net surface water flux (precip+melt+lrunoff+ice calving-evap)', 'kg m-2 s-1', & - standard_name='water_flux_into_sea_water', cmor_field_name='wfo', & + handles%id_prcme = register_diag_field('ocean_model', 'PRCmE', diag%axesT1, Time, & + 'Net surface water flux (precip+melt+lrunoff+ice calving-evap)', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & + standard_name='water_flux_into_sea_water', cmor_field_name='wfo', & cmor_standard_name='water_flux_into_sea_water',cmor_long_name='Water Flux Into Sea Water') - ! This diagnostic is rescaled to MKS units when combined. handles%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & 'Evaporation/condensation at ocean surface (evaporation is negative)', & @@ -1386,8 +1372,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') handles%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & - 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1') - ! This diagnostic is rescaled to MKS units when combined. + 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) handles%id_fprec = register_diag_field('ocean_model', 'fprec', diag%axesT1, Time, & 'Frozen precipitation into ocean', & @@ -1422,21 +1407,20 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, cmor_long_name='Water Flux into Sea Water From Rivers') handles%id_net_massout = register_diag_field('ocean_model', 'net_massout', diag%axesT1, Time, & - 'Net mass leaving the ocean due to evaporation, seaice formation', 'kg m-2 s-1') - ! This diagnostic is rescaled to MKS units when combined. + 'Net mass leaving the ocean due to evaporation, seaice formation', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) handles%id_net_massin = register_diag_field('ocean_model', 'net_massin', diag%axesT1, Time, & - 'Net mass entering ocean due to precip, runoff, ice melt', 'kg m-2 s-1') - ! This diagnostic is rescaled to MKS units when combined. + 'Net mass entering ocean due to precip, runoff, ice melt', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) handles%id_massout_flux = register_diag_field('ocean_model', 'massout_flux', diag%axesT1, Time, & 'Net mass flux of freshwater out of the ocean (used in the boundary flux calculation)', & 'kg m-2', conversion=diag%GV%H_to_kg_m2) - ! This diagnostic is calculated in MKS units. handles%id_massin_flux = register_diag_field('ocean_model', 'massin_flux', diag%axesT1, Time, & - 'Net mass flux of freshwater into the ocean (used in boundary flux calculation)', 'kg m-2') - ! This diagnostic is calculated in MKS units. + 'Net mass flux of freshwater into the ocean (used in boundary flux calculation)', & + 'kg m-2', conversion=diag%GV%H_to_kg_m2) !========================================================================= ! area integrated surface mass transport, all are rescaled to MKS units before area integration. @@ -1992,12 +1976,12 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) real, intent(out) :: wt2 !< The relative weight of the new fluxes type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces - ! This subroutine copies mechancal forcing from flux_tmp to fluxes and + ! This subroutine copies mechanical forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, ! and increments the amount of time over which the buoyancy forcing in fluxes should be ! applied based on the time interval stored in flux_tmp. - real :: wt1 + real :: wt1 ! The relative weight of the previous fluxes [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2233,35 +2217,32 @@ subroutine get_net_mass_forcing(fluxes, G, US, net_mass_src) 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]. + !! [R Z T-1 ~> 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%RZ_T_to_kg_m2s - 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) + RZ_T_conversion*fluxes%lprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + 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) + RZ_T_conversion*fluxes%fprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + 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) + RZ_T_conversion*fluxes%vprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + 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) + RZ_T_conversion*fluxes%lrunoff(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + 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) + RZ_T_conversion*fluxes%frunoff(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + 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) + RZ_T_conversion*fluxes%evap(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + 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) + RZ_T_conversion*fluxes%seaice_melt(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%seaice_melt(i,j) enddo ; enddo ; endif end subroutine get_net_mass_forcing @@ -2353,17 +2334,17 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h type(diag_ctrl), intent(inout) :: diag !< diagnostic regulator type(forcing_diags), intent(inout) :: handles !< diagnostic ids - ! local + ! local variables type(ocean_grid_type), pointer :: G ! Grid metric on model index map type(forcing), pointer :: fluxes ! Fluxes on the model index map - real, dimension(SZI_(diag%G),SZJ_(diag%G)) :: res - real :: total_transport ! for diagnosing integrated boundary transport - real :: ave_flux ! for diagnosing averaged boundary flux - real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] + real, dimension(SZI_(diag%G),SZJ_(diag%G)) :: res ! A temporary array for combinations + ! of fluxes [R Z T-1 ~> kg m-2 s-1] or [Q R Z T-1 ~> W m-2] + real :: total_transport ! for diagnosing integrated boundary transport, in MKS units of [kg s-1] or [W] + real :: ave_flux ! for diagnosing averaged boundary flux, in MKS units of [kg m-2 s-1] or [W m-2] real :: I_dt ! inverse time step [T-1 ~> s-1] - real :: ppt2mks ! conversion between ppt and mks + real :: ppt2mks ! conversion between ppt and mks units [nondim] integer :: turns ! Number of index quarter turns - integer :: i,j,is,ie,js,je + integer :: i, j, is, ie, js, je call cpu_clock_begin(handles%id_clock_forcing) @@ -2380,7 +2361,6 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h fluxes => fluxes_in endif - RZ_T_conversion = US%RZ_T_to_kg_m2s I_dt = 1.0 / fluxes%dt_buoy_accum ppt2mks = 1e-3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2393,22 +2373,22 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h 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) + RZ_T_conversion*fluxes%lprec(i,j) - if (associated(fluxes%fprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%fprec(i,j) + 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) ! fluxes%cond is not needed because it is derived from %evap > 0 - 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) + 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) 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, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_prcme, total_transport, diag) endif if (handles%id_prcme_ga > 0) then - ave_flux = global_area_mean(res, G) + ave_flux = global_area_mean(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_prcme_ga, ave_flux, diag) endif endif @@ -2417,64 +2397,59 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h 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) + RZ_T_conversion*fluxes%lprec(i,j) + if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) endif if (associated(fluxes%vprec)) then - if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) + if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) endif if (associated(fluxes%evap)) then - if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) + if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + 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) + RZ_T_conversion*fluxes%seaice_melt(i,j) + if (fluxes%seaice_melt(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) endif enddo ; enddo if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_net_massout, total_transport, diag) endif endif if (handles%id_massout_flux > 0 .and. associated(fluxes%netMassOut)) & - call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) + call post_data(handles%id_massout_flux, fluxes%netMassOut, diag) if (handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%fprec)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%fprec(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%fprec)) res(i,j) = res(i,j) + fluxes%fprec(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%lprec)) then - if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) + if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) endif if (associated(fluxes%vprec)) then - if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) + if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + 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) + RZ_T_conversion*fluxes%evap(i,j) + if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + 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) + RZ_T_conversion*fluxes%seaice_melt(i,j) + if (fluxes%seaice_melt(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) endif enddo ; enddo if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_net_massin, total_transport, diag) endif endif if (handles%id_massin_flux > 0 .and. associated(fluxes%netMassIn)) & - call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) + call post_data(handles%id_massin_flux, fluxes%netMassIn, diag) if ((handles%id_evap > 0) .and. associated(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) @@ -2489,15 +2464,15 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - res(i,j) = RZ_T_conversion* (fluxes%lprec(i,j) + fluxes%fprec(i,j)) + res(i,j) = 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 - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_precip, total_transport, diag) endif if (handles%id_precip_ga > 0) then - ave_flux = global_area_mean(res, G) + ave_flux = global_area_mean(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_precip_ga, ave_flux, diag) endif endif @@ -2987,7 +2962,6 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & call myAlloc(fluxes%seaice_melt,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassOut,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassIn,isd,ied,jsd,jed, water) - call myAlloc(fluxes%netSalt,isd,ied,jsd,jed, water) call myAlloc(fluxes%seaice_melt_heat,isd,ied,jsd,jed, heat) call myAlloc(fluxes%sw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%lw,isd,ied,jsd,jed, heat) @@ -3274,6 +3248,8 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%lrunoff)) deallocate(fluxes%lrunoff) if (associated(fluxes%frunoff)) deallocate(fluxes%frunoff) if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt) + if (associated(fluxes%netMassOut)) deallocate(fluxes%netMassOut) + if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) @@ -3317,8 +3293,8 @@ end subroutine deallocate_mech_forcing !< Rotate the fluxes by a set number of quarter turns subroutine rotate_forcing(fluxes_in, fluxes, turns) - type(forcing), intent(in) :: fluxes_in !< Input forcing struct - type(forcing), intent(inout) :: fluxes !< Rotated forcing struct + type(forcing), intent(in) :: fluxes_in !< Input forcing structure + type(forcing), intent(inout) :: fluxes !< Rotated forcing structure integer, intent(in) :: turns !< Number of quarter turns logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & @@ -3342,7 +3318,6 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) call rotate_array(fluxes_in%seaice_melt, turns, fluxes%seaice_melt) call rotate_array(fluxes_in%netMassOut, turns, fluxes%netMassOut) call rotate_array(fluxes_in%netMassIn, turns, fluxes%netMassIn) - call rotate_array(fluxes_in%netSalt, turns, fluxes%netSalt) endif if (do_heat) then @@ -3385,6 +3360,7 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) if (do_iceberg) then call rotate_array(fluxes_in%ustar_berg, turns, fluxes%ustar_berg) call rotate_array(fluxes_in%area_berg, turns, fluxes%area_berg) + !BGR: pretty sure the following line isn't supposed to be here. call rotate_array(fluxes_in%iceshelf_melt, turns, fluxes%iceshelf_melt) endif @@ -3490,6 +3466,234 @@ subroutine rotate_mech_forcing(forces_in, turns, forces) forces%initialized = forces_in%initialized end subroutine rotate_mech_forcing +!< Homogenize the forcing fields from the input domain +subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) + type(mech_forcing), intent(inout) :: forces !< Forcing on the input domain + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: Rho0 !< A reference density of seawater [R ~> kg m-3], + !! as used to calculate ustar. + logical, optional, intent(in) :: UpdateUstar !< A logical to determine if Ustar should be directly averaged + !! or updated from mean tau. + + real :: tx_mean, ty_mean, avg + real :: iRho0 + logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg, tau2ustar + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + iRho0 = US%L_to_Z / Rho0 + + tau2ustar = .false. + if (present(UpdateUstar)) tau2ustar = UpdateUstar + + call get_mech_forcing_groups(forces, do_stress, do_ustar, do_shelf, & + do_press, do_iceberg) + + if (do_stress) then + tx_mean = global_area_mean_u(forces%taux, G) + do j=js,je ; do i=isB,ieB + if (G%mask2dCu(I,j) > 0.) forces%taux(I,j) = tx_mean + enddo ; enddo + ty_mean = global_area_mean_v(forces%tauy, G) + do j=jsB,jeB ; do i=is,ie + if (G%mask2dCv(i,J) > 0.) forces%tauy(i,J) = ty_mean + enddo ; enddo + if (tau2ustar) then + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.) forces%ustar(i,j) = sqrt(sqrt(tx_mean**2 + ty_mean**2)*iRho0) + enddo ; enddo + else + call homogenize_field_t(forces%ustar, G) + endif + else + if (do_ustar) then + call homogenize_field_t(forces%ustar, G) + endif + endif + + if (do_shelf) then + call homogenize_field_u(forces%rigidity_ice_u, G) + call homogenize_field_v(forces%rigidity_ice_v, G) + call homogenize_field_u(forces%frac_shelf_u, G) + call homogenize_field_v(forces%frac_shelf_v, G) + endif + + if (do_press) then + ! NOTE: p_surf_SSH either points to p_surf or p_surf_full + call homogenize_field_t(forces%p_surf, G) + call homogenize_field_t(forces%p_surf_full, G) + call homogenize_field_t(forces%net_mass_src, G) + endif + + if (do_iceberg) then + call homogenize_field_t(forces%area_berg, G) + call homogenize_field_t(forces%mass_berg, G) + endif + +end subroutine homogenize_mech_forcing + +!< Homogenize the fluxes +subroutine homogenize_forcing(fluxes, G) + type(forcing), intent(inout) :: fluxes !< Input forcing struct + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + + real :: avg + logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & + do_iceberg, do_heat_added, do_buoy + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_press, & + do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) + + if (do_ustar) then + call homogenize_field_t(fluxes%ustar, G) + call homogenize_field_t(fluxes%ustar_gustless, G) + endif + + if (do_water) then + call homogenize_field_t(fluxes%evap, G) + call homogenize_field_t(fluxes%lprec, G) + call homogenize_field_t(fluxes%lprec, G) + call homogenize_field_t(fluxes%fprec, G) + call homogenize_field_t(fluxes%vprec, G) + call homogenize_field_t(fluxes%lrunoff, G) + call homogenize_field_t(fluxes%frunoff, G) + call homogenize_field_t(fluxes%seaice_melt, G) + call homogenize_field_t(fluxes%netMassOut, G) + call homogenize_field_t(fluxes%netMassIn, G) + !This was removed and I don't think replaced. Not needed? + !call homogenize_field_t(fluxes%netSalt, G) + endif + + if (do_heat) then + call homogenize_field_t(fluxes%seaice_melt_heat, G) + call homogenize_field_t(fluxes%sw, G) + call homogenize_field_t(fluxes%lw, G) + call homogenize_field_t(fluxes%latent, G) + call homogenize_field_t(fluxes%sens, G) + call homogenize_field_t(fluxes%latent_evap_diag, G) + call homogenize_field_t(fluxes%latent_fprec_diag, G) + call homogenize_field_t(fluxes%latent_frunoff_diag, G) + endif + + if (do_salt) call homogenize_field_t(fluxes%salt_flux, G) + + if (do_heat .and. do_water) then + call homogenize_field_t(fluxes%heat_content_cond, G) + call homogenize_field_t(fluxes%heat_content_icemelt, G) + call homogenize_field_t(fluxes%heat_content_lprec, G) + call homogenize_field_t(fluxes%heat_content_fprec, G) + call homogenize_field_t(fluxes%heat_content_vprec, G) + call homogenize_field_t(fluxes%heat_content_lrunoff, G) + call homogenize_field_t(fluxes%heat_content_frunoff, G) + call homogenize_field_t(fluxes%heat_content_massout, G) + call homogenize_field_t(fluxes%heat_content_massin, G) + endif + + if (do_press) call homogenize_field_t(fluxes%p_surf, G) + + if (do_shelf) then + call homogenize_field_t(fluxes%frac_shelf_h, G) + call homogenize_field_t(fluxes%ustar_shelf, G) + call homogenize_field_t(fluxes%iceshelf_melt, G) + endif + + if (do_iceberg) then + call homogenize_field_t(fluxes%ustar_berg, G) + call homogenize_field_t(fluxes%area_berg, G) + endif + + if (do_heat_added) then + call homogenize_field_t(fluxes%heat_added, G) + endif + + ! The following fields are handled by drivers rather than control flags. + if (associated(fluxes%sw_vis_dir)) & + call homogenize_field_t(fluxes%sw_vis_dir, G) + + if (associated(fluxes%sw_vis_dif)) & + call homogenize_field_t(fluxes%sw_vis_dif, G) + + if (associated(fluxes%sw_nir_dir)) & + call homogenize_field_t(fluxes%sw_nir_dir, G) + + if (associated(fluxes%sw_nir_dif)) & + call homogenize_field_t(fluxes%sw_nir_dif, G) + + if (associated(fluxes%salt_flux_in)) & + call homogenize_field_t(fluxes%salt_flux_in, G) + + if (associated(fluxes%salt_flux_added)) & + call homogenize_field_t(fluxes%salt_flux_added, G) + + if (associated(fluxes%p_surf_full)) & + call homogenize_field_t(fluxes%p_surf_full, G) + + if (associated(fluxes%buoy)) & + call homogenize_field_t(fluxes%buoy, G) + + if (associated(fluxes%TKE_tidal)) & + call homogenize_field_t(fluxes%TKE_tidal, G) + + if (associated(fluxes%ustar_tidal)) & + call homogenize_field_t(fluxes%ustar_tidal, G) + + ! TODO: tracer flux homogenization + ! Having a warning causes a lot of errors (each time step). + !if (coupler_type_initialized(fluxes%tr_fluxes)) & + ! call MOM_error(WARNING, "Homogenization of tracer BC fluxes not yet implemented.") + +end subroutine homogenize_forcing + +subroutine homogenize_field_t(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJ_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + avg = global_area_mean(var, G) + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.) var(i,j) = avg + enddo ; enddo + +end subroutine homogenize_field_t + +subroutine homogenize_field_v(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, is, ie, jsB, jeB + is = G%isc ; ie = G%iec ; jsB = G%jscB ; jeB = G%jecB + + avg = global_area_mean_v(var, G) + do J=jsB,jeB ; do i=is,ie + if (G%mask2dCv(i,J) > 0.) var(i,J) = avg + enddo ; enddo + +end subroutine homogenize_field_v + +subroutine homogenize_field_u(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, isB, ieB, js, je + isB = G%iscB ; ieB = G%iecB ; js = G%jsc ; je = G%jec + + avg = global_area_mean_u(var, G) + do j=js,je ; do I=isB,ieB + if (G%mask2dCu(I,j) > 0.) var(I,j) = avg + enddo ; enddo + +end subroutine homogenize_field_u + !> \namespace mom_forcing_type !! !! \section section_fluxes Boundary fluxes @@ -3515,7 +3719,7 @@ end subroutine rotate_mech_forcing !! \subsection subsection_mass_fluxes Surface boundary mass fluxes !! !! The ocean gains or loses mass through evaporation, precipitation, -!! sea ice melt/form, and and river runoff. Positive mass fluxes +!! sea ice melt/form, and river runoff. Positive mass fluxes !! add mass to the liquid ocean. The boundary mass flux units are !! (kilogram per square meter per sec: kg/(m2/sec)). !! diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 7592dc8477..d9ed8ffee4 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -59,8 +59,8 @@ module MOM_grid integer :: JsgB !< The start j-index of cell vertices within the global domain integer :: JegB !< The end j-index of cell vertices within the global domain - integer :: isd_global !< The value of isd in the global index space (decompoistion invariant). - integer :: jsd_global !< The value of isd in the global index space (decompoistion invariant). + integer :: isd_global !< The value of isd in the global index space (decomposition invariant). + integer :: jsd_global !< The value of isd in the global index space (decomposition invariant). integer :: idg_offset !< The offset between the corresponding global and local i-indices. integer :: jdg_offset !< The offset between the corresponding global and local j-indices. integer :: ke !< The number of layers in the vertical. @@ -112,6 +112,16 @@ module MOM_grid IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & + porous_DminU, & !< minimum topographic height of U-face [Z ~> m] + porous_DmaxU, & !< maximum topographic height of U-face [Z ~> m] + porous_DavgU !< average topographic height of U-face [Z ~> m] + + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & + porous_DminV, & !< minimum topographic height of V-face [Z ~> m] + porous_DmaxV, & !< maximum topographic height of V-face [Z ~> m] + porous_DavgV !< average topographic height of V-face [Z ~> m] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. @@ -171,10 +181,11 @@ module MOM_grid ! initialization routines (but not all) real :: south_lat !< The latitude (or y-coordinate) of the first v-line real :: west_lon !< The longitude (or x-coordinate) of the first u-line - real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain - real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. - real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m]. + real :: len_lat !< The latitudinal (or y-coord) extent of physical domain + real :: len_lon !< The longitudinal (or x-coord) extent of physical domain + real :: Rad_Earth !< The radius of the planet [m] + real :: Rad_Earth_L !< The radius of the planet in rescaled units [L ~> m] + real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m] end type ocean_grid_type contains @@ -195,7 +206,7 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v !! are entirely determined from thickness points. ! Local variables - real :: mean_SeaLev_scale + real :: mean_SeaLev_scale ! A scaling factor for the reference height variable [1] or [Z m-1 ~> 1] integer :: isd, ied, jsd, jed, nk integer :: IsdB, IedB, JsdB, JedB integer :: ied_max, jed_max @@ -387,10 +398,10 @@ end subroutine MOM_grid_init subroutine rescale_grid_bathymetry(G, m_in_new_units) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. - ! It appears that this routine is never called. + !### It appears that this routine is never called. ! Local variables - real :: rescale + real :: rescale ! A unit rescaling factor [various combinations of units ~> 1] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -478,14 +489,16 @@ logical function isPointInCell(G, i, j, x, y) real, intent(in) :: x !< x coordinate of point real, intent(in) :: y !< y coordinate of point ! Local variables - real :: xNE, xNW, xSE, xSW, yNE, yNW, ySE, ySW - real :: p0, p1, p2, p3, l0, l1, l2, l3 + real :: xNE, xNW, xSE, xSW ! Longitudes of cell corners [degLon] + real :: yNE, yNW, ySE, ySW ! Latitudes of cell corners [degLat] + real :: l0, l1, l2, l3 ! Crossed products of differences in position [degLon degLat] + real :: p0, p1, p2, p3 ! Trinary unitary values reflecting the signs of the crossed products [nondim] isPointInCell = .false. xNE = G%geoLonBu(i ,j ) ; yNE = G%geoLatBu(i ,j ) xNW = G%geoLonBu(i-1,j ) ; yNW = G%geoLatBu(i-1,j ) xSE = G%geoLonBu(i ,j-1) ; ySE = G%geoLatBu(i ,j-1) xSW = G%geoLonBu(i-1,j-1) ; ySW = G%geoLatBu(i-1,j-1) - ! This is a crude calculation that assume a geographic coordinate system + ! This is a crude calculation that assumes a geographic coordinate system if (xmax(xNE,xNW,xSE,xSW) .or. & ymax(yNE,yNW,ySE,ySW) ) then return ! Avoid the more complicated calculation @@ -574,6 +587,14 @@ subroutine allocate_metrics(G) ALLOC_(G%dx_Cv(isd:ied,JsdB:JedB)) ; G%dx_Cv(:,:) = 0.0 ALLOC_(G%dy_Cu(IsdB:IedB,jsd:jed)) ; G%dy_Cu(:,:) = 0.0 + ALLOC_(G%porous_DminU(IsdB:IedB,jsd:jed)); G%porous_DminU(:,:) = 0.0 + ALLOC_(G%porous_DmaxU(IsdB:IedB,jsd:jed)); G%porous_DmaxU(:,:) = 0.0 + ALLOC_(G%porous_DavgU(IsdB:IedB,jsd:jed)); G%porous_DavgU(:,:) = 0.0 + + ALLOC_(G%porous_DminV(isd:ied,JsdB:JedB)); G%porous_DminV(:,:) = 0.0 + ALLOC_(G%porous_DmaxV(isd:ied,JsdB:JedB)); G%porous_DmaxV(:,:) = 0.0 + ALLOC_(G%porous_DavgV(isd:ied,JsdB:JedB)); G%porous_DavgV(:,:) = 0.0 + ALLOC_(G%areaCu(IsdB:IedB,jsd:jed)) ; G%areaCu(:,:) = 0.0 ALLOC_(G%areaCv(isd:ied,JsdB:JedB)) ; G%areaCv(:,:) = 0.0 ALLOC_(G%IareaCu(IsdB:IedB,jsd:jed)) ; G%IareaCu(:,:) = 0.0 @@ -630,6 +651,9 @@ subroutine MOM_grid_end(G) DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy) DEALLOC_(G%sin_rot) ; DEALLOC_(G%cos_rot) + DEALLOC_(G%porous_DminU) ; DEALLOC_(G%porous_DmaxU) ; DEALLOC_(G%porous_DavgU) + DEALLOC_(G%porous_DminV) ; DEALLOC_(G%porous_DmaxV) ; DEALLOC_(G%porous_DavgV) + deallocate(G%gridLonT) ; deallocate(G%gridLatT) deallocate(G%gridLonB) ; deallocate(G%gridLatB) diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 17729e586c..7047dd6421 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -17,7 +17,7 @@ module MOM_interface_heights public find_eta -!> Calculates the heights of sruface or all interfaces from layer thicknesses. +!> Calculates the heights of the free surface or all interfaces from layer thicknesses. interface find_eta module procedure find_eta_2d, find_eta_3d end interface find_eta diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 40777c8227..80d94ec7fe 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -102,15 +102,15 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. - real :: dz_neglect ! A change in interface heighs that is so small it is usually lost + real :: dz_neglect ! A change in interface heights 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 ! The gravitational acceleration divided by density [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances. + ! units for lateral distances [L Z-1 ~> 1] real :: L_to_Z ! A conversion factor between from units for lateral distances - ! to the units for e. - real :: H_to_Z ! A conversion factor from thickness units to the units of e. + ! to the units for e [Z L-1 ~> 1] + real :: H_to_Z ! A conversion factor from thickness units to the units of e [Z H-1 ~> 1 or m3 kg-1] logical :: present_N2_u, present_N2_v integer, dimension(2) :: EOSdom_u, EOSdom_v ! Domains for the equation of state calculations at u and v points @@ -457,7 +457,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. real :: h0 ! A negligible thickness to allow for zero thickness layers without - ! completely decouping groups of layers [H ~> m or kg m-2]. + ! completely decoupling groups of layers [H ~> m or kg m-2]. ! Often 0 < h_neglect << h0. real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness [H ~> m or kg m-2]. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f0b1158b22..41ba70f152 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -75,26 +75,26 @@ module MOM_open_boundary !> Open boundary segment data from files (mostly). type, public :: OBC_segment_data_type - integer :: fid !< handle from FMS associated with segment data on disk - integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk - character(len=8) :: name !< a name identifier for the segment data - real, dimension(:,:,:), allocatable :: buffer_src !< buffer for segment data located at cell faces - !! and on the original vertical grid - integer :: nk_src !< Number of vertical levels in the source data - real, dimension(:,:,:), allocatable :: dz_src !< vertical grid cell spacing of the incoming segment - !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] - real, dimension(:,:,:), pointer :: buffer_dst=>NULL() !< buffer src data remapped to the target vertical grid + integer :: fid !< handle from FMS associated with segment data on disk + integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk + character(len=8) :: name !< a name identifier for the segment data + real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces + !! and on the original vertical grid + integer :: nk_src !< Number of vertical levels in the source data + real, allocatable :: dz_src(:,:,:) !< vertical grid cell spacing of the incoming segment + !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] + real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. type, public :: OBC_segment_tracer_type - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array - real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows - character(len=32) :: name !< tracer name used for error messages - type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer - real, dimension(:,:,:), pointer :: tres => NULL() !< tracer reservoir array - logical :: is_initialized !< reservoir values have been set when True + real, allocatable :: t(:,:,:) !< tracer concentration array + real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows + character(len=32) :: name !< tracer name used for error messages + type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer + real, allocatable :: tres(:,:,:) !< tracer reservoir array + logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type !> Registry type for tracers on segments @@ -145,9 +145,8 @@ module MOM_open_boundary logical :: is_N_or_S !< True if the OB is facing North or South and exists on this PE. logical :: is_E_or_W !< True if the OB is facing East or West and exists on this PE. logical :: is_E_or_W_2 !< True if the OB is facing East or West anywhere. - type(OBC_segment_data_type), pointer, dimension(:) :: field=>NULL() !< OBC data + type(OBC_segment_data_type), pointer :: field(:) => NULL() !< OBC data integer :: num_fields !< number of OBC data fields (e.g. u_normal,u_parallel and eta for Flather) - character(len=32), pointer, dimension(:) :: field_names=>NULL() !< field names for this segment integer :: Is_obc !< i-indices of boundary segment. integer :: Ie_obc !< i-indices of boundary segment. integer :: Js_obc !< j-indices of boundary segment. @@ -160,52 +159,52 @@ module MOM_open_boundary integer :: zphase_index !< Save where zphase is in segment%field. real :: Velocity_nudging_timescale_in !< Nudging timescale on inflow [T ~> s]. real :: Velocity_nudging_timescale_out !< Nudging timescale on outflow [T ~> s]. - logical :: on_pe !< true if segment is located in the computational domain + logical :: on_pe !< true if any portion of the segment is located in this PE's data domain logical :: temp_segment_data_exists !< true if temperature data arrays are present logical :: salt_segment_data_exists !< true if salinity data arrays are present - real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [L T-1 ~> m s-1] - !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [T-1 ~> s-1]. - real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [H L2 T-1 ~> m3 s-1]. - real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the - !! segment [H ~> m or kg m-2]. - real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along - !! the segment times the grid spacing [T-1 ~> s-1] - real, pointer, dimension(:,:,:) :: rx_norm_rad=>NULL() !< The previous normal phase speed use for EW radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: ry_norm_rad=>NULL() !< The previous normal phase speed use for NS radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: rx_norm_obl=>NULL() !< The previous normal radiation coefficient for EW - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: ry_norm_obl=>NULL() !< The previous normal radiation coefficient for NS - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation - !! for normal velocity [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [T-1 ~> s-1]. + real, allocatable :: Cg(:,:) !< The external gravity wave speed [L T-1 ~> m s-1] + !! at OBC-points. + real, allocatable :: Htot(:,:) !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: h(:,:,:) !< The cell thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: normal_vel(:,:,:) !< The layer velocity normal to the OB + !! segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_vel(:,:,:) !< The layer velocity tangential to the + !! OB segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_grad(:,:,:) !< The gradient of the velocity tangential + !! to the OB segment [T-1 ~> s-1]. + real, allocatable :: normal_trans(:,:,:) !< The layer transport normal to the OB + !! segment [H L2 T-1 ~> m3 s-1]. + real, allocatable :: normal_vel_bt(:,:) !< The barotropic velocity normal to + !! the OB segment [L T-1 ~> m s-1]. + real, allocatable :: eta(:,:) !< The sea-surface elevation along the + !! segment [H ~> m or kg m-2]. + real, allocatable :: grad_normal(:,:,:) !< The gradient of the normal flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_tan(:,:,:) !< The gradient of the tangential flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_gradient(:,:,:) !< The gradient of the gradient of tangential flow along + !! the segment times the grid spacing [T-1 ~> s-1] + real, allocatable :: rx_norm_rad(:,:,:) !< The previous normal phase speed use for EW radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: ry_norm_rad(:,:,:) !< The previous normal phase speed use for NS radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: rx_norm_obl(:,:,:) !< The previous normal radiation coefficient for EW + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_norm_obl(:,:,:) !< The previous normal radiation coefficient for NS + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< The denominator for oblique radiation + !! for normal velocity [L2 T-2 ~> m2 s-2] + real, allocatable :: nudged_normal_vel(:,:,:) !< The layer velocity normal to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_vel(:,:,:) !< The layer velocity tangential to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_grad(:,:,:) !< The layer dvdx or dudy towards which nudging + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale_out !< An effective inverse length scale for restoring - !! the tracer concentration in a ficticious - !! reservior towards interior values when flow + !! the tracer concentration in a fictitious + !! reservoir towards interior values when flow !! is exiting the domain [L-1 ~> m-1] real :: Tr_InvLscale_in !< An effective inverse length scale for restoring !! the tracer concentration towards an externally @@ -256,18 +255,16 @@ module MOM_open_boundary logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. - logical, pointer, dimension(:) :: & - tracer_x_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_x_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with x reservoirs (needed for restarts). - logical, pointer, dimension(:) :: & - tracer_y_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_y_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with y reservoirs (needed for restarts). integer :: ntr = 0 !< number of tracers integer :: n_tide_constituents = 0 !< Number of tidal constituents to add to the boundary. logical :: add_tide_constituents = .false. !< If true, add tidal constituents to the boundary elevation !! and velocity. Will be set to true if n_tide_constituents > 0. character(len=2), allocatable, dimension(:) :: tide_names !< Names of tidal constituents to add to the boundary data. - real, allocatable, dimension(:) :: tide_frequencies !< Angular frequencies of chosen tidal constituents [s-1]. + real, allocatable, dimension(:) :: tide_frequencies !< Angular frequencies of chosen tidal constituents [T-1 ~> s-1]. real, allocatable, dimension(:) :: tide_eq_phases !< Equilibrium phases of chosen tidal constituents [rad]. real, allocatable, dimension(:) :: tide_fn !< Amplitude modulation of boundary tides by nodal cycle [nondim]. real, allocatable, dimension(:) :: tide_un !< Phase modulation of boundary tides by nodal cycle [rad]. @@ -278,45 +275,40 @@ module MOM_open_boundary type(time_type) :: time_ref !< Reference date (t = 0) for tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Lunar and solar longitudes used to calculate tidal forcing. ! Properties of the segments used. - type(OBC_segment_type), pointer, dimension(:) :: & - segment => NULL() !< List of segment objects. + type(OBC_segment_type), allocatable :: segment(:) !< List of segment objects. ! Which segment object describes the current point. - integer, pointer, dimension(:,:) :: & - segnum_u => NULL(), & !< Segment number of u-points. - segnum_v => NULL() !< Segment number of v-points. + integer, allocatable :: segnum_u(:,:) !< Segment number of u-points. + integer, allocatable :: segnum_v(:,:) !< Segment number of v-points. ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation !! velocities (or speed of characteristics) at the - !! new time level (1) or the running mean (0) for velocities. + !! new time level (1) or the running mean (0) for velocities [nondim]. !! Valid values range from 0 to 1, with a default of 0.3. real :: rx_max !< The maximum magnitude of the baroclinic radiation velocity (or speed of !! characteristics) in units of grid points per timestep [nondim]. logical :: OBC_pe !< Is there an open boundary on this tile? type(remapping_CS), pointer :: remap_CS=> NULL() !< ALE remapping control structure for segments only type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries - real, pointer, dimension(:,:,:) :: & - rx_normal => NULL(), & !< Array storage for normal phase speed for EW radiation OBCs in units of - !! grid points per timestep [nondim] - ry_normal => NULL(), & !< Array storage for normal phase speed for NS radiation OBCs in units of - !! grid points per timestep [nondim] - rx_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - ry_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - cff_normal => NULL() !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:,:) :: & - tres_x => NULL(), & !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] - tres_y => NULL() !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: rx_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] real :: silly_h !< A silly value of thickness outside of the domain that can be used to test !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test !! the independence of the OBCs to this external data [L T-1 ~> m s-1]. - logical :: ramp = .false. !< If True, ramp from zero to the external values - !! for SSH. + logical :: ramp = .false. !< If True, ramp from zero to the external values for SSH. logical :: ramping_is_activated = .false. !< True if the ramping has been initialized - real :: ramp_timescale !< If ramp is True, use this timescale for ramping. - real :: trunc_ramp_time !< If ramp is True, time after which ramp is done. + real :: ramp_timescale !< If ramp is True, use this timescale for ramping [T ~> s]. + real :: trunc_ramp_time !< If ramp is True, time after which ramp is done [T ~> s]. real :: ramp_value !< If ramp is True, where we are on the ramp from - !! zero to one. + !! zero to one [nondim]. type(time_type) :: ramp_start_time !< Time when model was started. end type ocean_OBC_type @@ -635,7 +627,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) "Symmetric memory must be used when using Flather OBCs.") ! Need to do this last, because it depends on time_interp_external_init having already been called if (OBC%add_tide_constituents) then - call initialize_obc_tides(OBC, param_file) + call initialize_obc_tides(OBC, US, param_file) ! Tide update is done within update_OBC_segment_data, so this should be true if tides are included. OBC%update_OBC = .true. endif @@ -651,16 +643,16 @@ end subroutine open_boundary_config !> Allocate space for reading OBC data from files. It sets up the required vertical !! remapping. In the process, it does funky stuff with the MPI processes. subroutine initialize_segment_data(G, OBC, PF) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle integer :: n, m, num_fields character(len=1024) :: segstr character(len=256) :: filename character(len=20) :: segnam, suffix character(len=32) :: varnam, fieldname - real :: value + real :: value ! A value that is parsed from the segment data string [various units] character(len=32), dimension(MAX_OBC_FIELDS) :: fields ! segment field names character(len=128) :: inputdir type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -688,7 +680,6 @@ subroutine initialize_segment_data(G, OBC, PF) ! Try this here just for the documentation. It is repeated below. do n=1, OBC%number_of_segments - segment => OBC%segment(n) write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n call get_param(PF, mdl, segnam, segstr, 'OBC segment docs') enddo @@ -868,7 +859,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! siz(3) is constituent for tidal variables call field_size(filename, 'constituent', siz, no_domain=.true.) ! expect third dimension to be number of constituents in MOM_input - if (siz(3) .ne. OBC%n_tide_constituents .and. OBC%add_tide_constituents) then + if (siz(3) /= OBC%n_tide_constituents .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Number of constituents in input data is not '//& 'the same as the number specified') endif @@ -904,9 +895,9 @@ subroutine initialize_segment_data(G, OBC, PF) segment%field(m)%value = value segment%field(m)%name = trim(fields(m)) ! Check if this is a tidal field. If so, the number - ! of expected constiuents must be 1. + ! of expected constituents must be 1. if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then - if (OBC%n_tide_constituents .gt. 1 .and. OBC%add_tide_constituents) then + if (OBC%n_tide_constituents > 1 .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Only one constituent is supported when specifying '//& 'tidal boundary conditions by value rather than file.') endif @@ -957,15 +948,16 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data -subroutine initialize_obc_tides(OBC, param_file) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle +subroutine initialize_obc_tides(OBC, US, param_file) + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file handle integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing (year, month, day). integer, dimension(3) :: nodal_ref_date !< Date to calculate nodal modulation for (year, month, day). character(len=50) :: tide_constituent_str !< List of tidal constituents to include on boundary. - type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing - type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. - integer :: c !< Index to tidal constituent. + type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing + type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. + integer :: c !< Index to tidal constituent. call get_param(param_file, mdl, "OBC_TIDE_CONSTITUENTS", tide_constituent_str, & "Names of tidal constituents being added to the open boundaries.", & @@ -1005,7 +997,7 @@ subroutine initialize_obc_tides(OBC, param_file) ! If the nodal correction is based on a different time, initialize that. ! Otherwise, it can use N from the time reference. if (OBC%add_nodal_terms) then - if (sum(nodal_ref_date) .ne. 0) then + if (sum(nodal_ref_date) /= 0) then ! A reference date was provided for the nodal correction nodal_time = set_date(nodal_ref_date(1), nodal_ref_date(2), nodal_ref_date(3)) call astro_longitudes_init(nodal_time, nodal_longitudes) @@ -1031,9 +1023,10 @@ subroutine initialize_obc_tides(OBC, param_file) "Frequency of the "//trim(OBC%tide_names(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(OBC%tide_names(c))// & " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(OBC%tide_names(c))//& - " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=tidal_frequency(trim(OBC%tide_names(c)))) + " is in OBC_TIDE_CONSTITUENTS.", & + units="s-1", default=tidal_frequency(trim(OBC%tide_names(c))), scale=US%T_to_s) - ! Find equilibrum phase if needed + ! Find equilibrium phase if needed if (OBC%add_eq_phase) then OBC%tide_eq_phases(c) = eq_phase(trim(OBC%tide_names(c)), OBC%tidal_longitudes) else @@ -1175,7 +1168,7 @@ end subroutine setup_segment_indices !> Parse an OBC_SEGMENT_%%% string starting with "I=" and configure placement and type of OBC accordingly subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" @@ -1187,7 +1180,7 @@ subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) integer :: j, a_loop character(len=32) :: action_str(8) character(len=128) :: segment_param_str - real, allocatable, dimension(:) :: tnudge + real, allocatable, dimension(:) :: tnudge ! Nudging timescales [T ~> s] ! This returns the global indices for the segment call parse_segment_str(G%ieg, G%jeg, segment_str, I_obc, Js_obc, Je_obc, action_str, reentrant_y) @@ -1315,7 +1308,7 @@ end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" @@ -1327,7 +1320,7 @@ subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) integer :: i, a_loop character(len=32) :: action_str(8) character(len=128) :: segment_param_str - real, allocatable, dimension(:) :: tnudge + real, allocatable, dimension(:) :: tnudge ! Nudging timescales [T ~> s] ! This returns the global indices for the segment call parse_segment_str(G%ieg, G%jeg, segment_str, J_obc, Is_obc, Ie_obc, action_str, reentrant_x) @@ -1478,7 +1471,7 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ mn_max = nj_global if (.not. (word2(1:2)=='J=')) call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& "Second word of string '"//trim(segment_str)//"' must start with 'J='.") - elseif (word1(1:2)=='J=') then ! Note that the file_parser uniformaly expands "=" to " = " + elseif (word1(1:2)=='J=') then ! Note that the file_parser uniformly expands "=" to " = " l_max = nj_global mn_max = ni_global if (.not. (word2(1:2)=='I=')) call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& @@ -1638,8 +1631,8 @@ end subroutine parse_segment_data_str !> Parse all the OBC_SEGMENT_%%%_DATA strings again !! to see which need tracer reservoirs (all pes need to know). subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables @@ -1648,7 +1641,7 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) character(len=256) :: filename character(len=20) :: segnam, suffix character(len=32) :: varnam, fieldname - real :: value + real :: value ! A value that is parsed from the segment data string [various units] character(len=32), dimension(MAX_OBC_FIELDS) :: fields ! segment field names type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list character(len=256) :: mesg ! Message for error messages. @@ -1786,13 +1779,13 @@ end subroutine parse_segment_param_real !> Initialize open boundary control structure and do any necessary rescaling of OBC !! fields that have been read from a restart file. -subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) +subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Container for vertical grid information type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + type(MOM_restart_CS), intent(in) :: restart_CS !< Restart structure, data intent(inout) ! Local variables real :: vel2_rescale ! A rescaling factor for squared velocities from the representation in @@ -1809,16 +1802,16 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) To_All+Scalar_Pair) if (OBC%oblique_BCs_exist_globally) call pass_vector(OBC%rx_oblique, OBC%ry_oblique, G%Domain, & To_All+Scalar_Pair) - if (associated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) - if (associated(OBC%tres_x) .and. associated(OBC%tres_y)) then + if (allocated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) + if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_vector(OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%Domain, To_All+Scalar_Pair) enddo - elseif (associated(OBC%tres_x)) then + elseif (allocated(OBC%tres_x)) then do m=1,OBC%ntr call pass_var(OBC%tres_x(:,:,:,m), G%Domain, position=EAST_FACE) enddo - elseif (associated(OBC%tres_y)) then + elseif (allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_var(OBC%tres_y(:,:,:,m), G%Domain, position=NORTH_FACE) enddo @@ -1830,12 +1823,12 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) ! if ( OBC%radiation_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & ! ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then ! vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) -! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CSp)) then +! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CS)) then ! do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ! OBC%rx_normal(I,j,k) = vel_rescale * OBC%rx_normal(I,j,k) ! enddo ; enddo ; enddo ! endif -! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CSp)) then +! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CS)) then ! do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ! OBC%ry_normal(i,J,k) = vel_rescale * OBC%ry_normal(i,J,k) ! enddo ; enddo ; enddo @@ -1846,17 +1839,17 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) if ( OBC%oblique_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then vel2_rescale = (US%m_to_L * US%s_to_T_restart)**2 / (US%m_to_L_restart * US%s_to_T)**2 - if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CSp)) then + if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CS)) then do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB OBC%rx_oblique(I,j,k) = vel2_rescale * OBC%rx_oblique(I,j,k) enddo ; enddo ; enddo endif - if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CSp)) then + if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CS)) then do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied OBC%ry_oblique(i,J,k) = vel2_rescale * OBC%ry_oblique(i,J,k) enddo ; enddo ; enddo endif - if (query_initialized(OBC%cff_normal, "cff_normal", restart_CSp)) then + if (query_initialized(OBC%cff_normal, "cff_normal", restart_CS)) then do k=1,nz ; do J=JsdB,JedB ; do I=IsdB,IedB OBC%cff_normal(I,J,k) = vel2_rescale * OBC%cff_normal(I,J,k) enddo ; enddo ; enddo @@ -1897,18 +1890,18 @@ subroutine open_boundary_dealloc(OBC) do n=1, OBC%number_of_segments segment => OBC%segment(n) - call deallocate_OBC_segment_data(OBC, segment) + call deallocate_OBC_segment_data(segment) enddo - if (associated(OBC%segment)) deallocate(OBC%segment) - if (associated(OBC%segnum_u)) deallocate(OBC%segnum_u) - if (associated(OBC%segnum_v)) deallocate(OBC%segnum_v) - if (associated(OBC%rx_normal)) deallocate(OBC%rx_normal) - if (associated(OBC%ry_normal)) deallocate(OBC%ry_normal) - if (associated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) - if (associated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) - if (associated(OBC%cff_normal)) deallocate(OBC%cff_normal) - if (associated(OBC%tres_x)) deallocate(OBC%tres_x) - if (associated(OBC%tres_y)) deallocate(OBC%tres_y) + if (allocated(OBC%segment)) deallocate(OBC%segment) + if (allocated(OBC%segnum_u)) deallocate(OBC%segnum_u) + if (allocated(OBC%segnum_v)) deallocate(OBC%segnum_v) + if (allocated(OBC%rx_normal)) deallocate(OBC%rx_normal) + if (allocated(OBC%ry_normal)) deallocate(OBC%ry_normal) + if (allocated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) + if (allocated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) + if (allocated(OBC%cff_normal)) deallocate(OBC%cff_normal) + if (allocated(OBC%tres_x)) deallocate(OBC%tres_x) + if (allocated(OBC%tres_y)) deallocate(OBC%tres_y) deallocate(OBC) end subroutine open_boundary_dealloc @@ -1918,7 +1911,7 @@ subroutine open_boundary_end(OBC) call open_boundary_dealloc(OBC) end subroutine open_boundary_end -!> Sets the slope of bathymetry normal to an open bounndary to zero. +!> Sets the slope of bathymetry normal to an open boundary to zero. subroutine open_boundary_impose_normal_slope(OBC, G, depth) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure @@ -2077,8 +2070,8 @@ end subroutine open_boundary_impose_land_mask subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - ! Local variables + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, m, n @@ -2088,7 +2081,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%t(i,j,k) @@ -2099,7 +2092,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%t(i,J,k) @@ -2209,7 +2202,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed segment%tr_Reg%Tr(m)%tres(I,j,k) = OBC%tres_x(I,j,k,m) @@ -2220,7 +2213,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied segment%tr_Reg%Tr(m)%tres(i,J,k) = OBC%tres_y(i,J,k,m) @@ -2244,7 +2237,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new - dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sashay for I-1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed if (gamma_u < 1.0) then @@ -2264,7 +2257,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, endif elseif (segment%oblique) then dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new - dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sashay for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -2327,7 +2320,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do J=segment%HI%JsdB,segment%HI%JedB dhdt = v_old(i,J,k)-v_new(i,J,k) !old-new - dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sasha for I-1 + dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sashay for I-1 rx_tang_rad(I,J,k) = 0.0 if (dhdt*dhdx > 0.0) rx_tang_rad(I,J,k) = min( (dhdt/dhdx), rx_max) ! outward phase speed enddo @@ -2406,7 +2399,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do J=segment%HI%JsdB,segment%HI%JedB dhdt = v_old(i,J,k)-v_new(i,J,k) !old-new - dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sasha for I-1 + dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sashay for I-1 if (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) > 0.0) then dhdy = segment%grad_tan(j,1,k) elseif (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) == 0.0) then @@ -2488,7 +2481,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sashay for I+1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) if (gamma_u < 1.0) then @@ -2508,7 +2501,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, endif elseif (segment%oblique) then dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sashay for I+1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -2572,7 +2565,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do J=segment%HI%JsdB,segment%HI%JedB dhdt = v_old(i+1,J,k)-v_new(i+1,J,k) !old-new - dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sasha for I-1 + dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sashay for I-1 rx_tang_rad(I,J,k) = 0.0 if (dhdt*dhdx > 0.0) rx_tang_rad(I,J,k) = min( (dhdt/dhdx), rx_max) ! outward phase speed enddo @@ -2651,7 +2644,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do J=segment%HI%JsdB,segment%HI%JedB dhdt = v_old(i+1,J,k)-v_new(i+1,J,k) !old-new - dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sasha for I-1 + dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sashay for I-1 if (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) > 0.0) then dhdy = segment%grad_tan(j,1,k) elseif (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) == 0.0) then @@ -2733,7 +2726,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) then dhdt = (v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new - dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sashay for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) if (gamma_u < 1.0) then @@ -2753,7 +2746,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, endif elseif (segment%oblique) then dhdt = (v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new - dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sashay for J-1 if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -2816,7 +2809,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do I=segment%HI%IsdB,segment%HI%IedB dhdt = u_old(I,j-1,k)-u_new(I,j-1,k) !old-new - dhdy = u_new(I,j-1,k)-u_new(I,j-2,k) !in new time backward sasha for I-1 + dhdy = u_new(I,j-1,k)-u_new(I,j-2,k) !in new time backward sashay for I-1 ry_tang_rad(I,J,k) = 0.0 if (dhdt*dhdy > 0.0) ry_tang_rad(I,J,k) = min( (dhdt/dhdy), rx_max) ! outward phase speed enddo @@ -2895,7 +2888,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do I=segment%HI%IsdB,segment%HI%IedB dhdt = u_old(I,j,k)-u_new(I,j,k) !old-new - dhdy = u_new(I,j,k)-u_new(I,j-1,k) !in new time backward sasha for I-1 + dhdy = u_new(I,j,k)-u_new(I,j-1,k) !in new time backward sashay for I-1 if (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) > 0.0) then dhdx = segment%grad_tan(i,1,k) elseif (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) == 0.0) then @@ -2977,7 +2970,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) then dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sashay for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) if (gamma_u < 1.0) then @@ -2997,7 +2990,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, endif elseif (segment%oblique) then dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sashay for J-1 if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -3061,7 +3054,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do I=segment%HI%IsdB,segment%HI%IedB dhdt = u_old(I,j+1,k)-u_new(I,j+1,k) !old-new - dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sasha for I-1 + dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sashay for I-1 ry_tang_rad(I,J,k) = 0.0 if (dhdt*dhdy > 0.0) ry_tang_rad(I,J,k) = min( (dhdt/dhdy), rx_max) ! outward phase speed enddo @@ -3140,7 +3133,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else do I=segment%HI%IsdB,segment%HI%IedB dhdt = u_old(I,j+1,k)-u_new(I,j+1,k) !old-new - dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sasha for I-1 + dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sashay for I-1 if (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) > 0.0) then dhdx = segment%grad_tan(i,1,k) elseif (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) == 0.0) then @@ -3298,7 +3291,7 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, GV, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(OBC_segment_type), pointer :: segment !< OBC segment structure + type(OBC_segment_type), intent(inout) :: segment !< OBC segment structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k @@ -3420,28 +3413,16 @@ end subroutine gradient_at_q_points !> Sets the initial values of the tracer open boundary conditions. !! Redoing this elsewhere. -subroutine set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure +subroutine set_tracer_data(OBC, tv, h, G, GV, PF) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness - type(param_file_type), intent(in) :: PF !< Parameter file handle - type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry - ! Local variables - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n - integer :: isd_off, jsd_off - integer :: IsdB, IedB, JsdB, JedB - type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list - character(len=40) :: mdl = "set_tracer_data" ! This subroutine's name. - character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path - - real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) - real :: temp_v(G%domain%niglobal,G%domain%njglobal+1) + type(ocean_OBC_type), target, intent(in) :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness + type(param_file_type), intent(in) :: PF !< Parameter file handle - 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 ; JsdB = G%JsdB ; JedB = G%JedB + type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + integer :: i, j, k, n ! For now, there are no radiation conditions applied to the thicknesses, since ! the thicknesses might not be physically motivated. Instead, sponges should be @@ -3484,7 +3465,7 @@ end subroutine set_tracer_data !> Needs documentation function lookup_seg_field(OBC_seg,field) - type(OBC_segment_type), pointer :: OBC_seg !< OBC segment + type(OBC_segment_type), intent(in) :: OBC_seg !< OBC segment character(len=32), intent(in) :: field !< The field name integer :: lookup_seg_field ! Local variables @@ -3503,7 +3484,7 @@ end function lookup_seg_field !> Allocate segment data fields subroutine allocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(in) :: OBC !< Open boundary structure type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables integer :: isd, ied, jsd, jed @@ -3593,35 +3574,35 @@ subroutine allocate_OBC_segment_data(OBC, segment) end subroutine allocate_OBC_segment_data !> Deallocate segment data fields -subroutine deallocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure +subroutine deallocate_OBC_segment_data(segment) type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables character(len=40) :: mdl = "deallocate_OBC_segment_data" ! This subroutine's name. if (.not. segment%on_pe) return - if (associated (segment%Cg)) deallocate(segment%Cg) - if (associated (segment%Htot)) deallocate(segment%Htot) - if (associated (segment%h)) deallocate(segment%h) - if (associated (segment%eta)) deallocate(segment%eta) - if (associated (segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) - if (associated (segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) - if (associated (segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) - if (associated (segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) - if (associated (segment%cff_normal)) deallocate(segment%cff_normal) - if (associated (segment%grad_normal)) deallocate(segment%grad_normal) - if (associated (segment%grad_tan)) deallocate(segment%grad_tan) - if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) - if (associated (segment%normal_vel)) deallocate(segment%normal_vel) - if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) - if (associated (segment%normal_trans)) deallocate(segment%normal_trans) - if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) - if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) - if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) - if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) - if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) - if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) + if (allocated(segment%Cg)) deallocate(segment%Cg) + if (allocated(segment%Htot)) deallocate(segment%Htot) + if (allocated(segment%h)) deallocate(segment%h) + if (allocated(segment%eta)) deallocate(segment%eta) + if (allocated(segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) + if (allocated(segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) + if (allocated(segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) + if (allocated(segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) + if (allocated(segment%cff_normal)) deallocate(segment%cff_normal) + if (allocated(segment%grad_normal)) deallocate(segment%grad_normal) + if (allocated(segment%grad_tan)) deallocate(segment%grad_tan) + if (allocated(segment%grad_gradient)) deallocate(segment%grad_gradient) + if (allocated(segment%normal_vel)) deallocate(segment%normal_vel) + if (allocated(segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) + if (allocated(segment%normal_trans)) deallocate(segment%normal_trans) + if (allocated(segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) + if (allocated(segment%tangential_vel)) deallocate(segment%tangential_vel) + if (allocated(segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (allocated(segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) + if (allocated(segment%tangential_grad)) deallocate(segment%tangential_grad) + + if (associated(segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) end subroutine deallocate_OBC_segment_data @@ -3732,22 +3713,23 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path type(OBC_segment_type), pointer :: segment => NULL() integer, dimension(4) :: siz - real, dimension(:,:,:), pointer :: tmp_buffer_in => NULL() ! Unrotated input + real, dimension(:,:,:), pointer :: tmp_buffer_in => NULL() ! Unrotated input [various units] integer :: ni_seg, nj_seg ! number of src gridpoints along the segments integer :: ni_buf, nj_buf ! Number of filled values in tmp_buffer integer :: i2, j2 ! indices for referencing local domain array integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain integer :: ishift, jshift ! offsets for staggered locations - real, dimension(:,:), pointer :: seg_vel => NULL() ! pointer to segment velocity array - real, dimension(:,:), pointer :: seg_trans => NULL() ! pointer to segment transport array - real, dimension(:,:,:), allocatable, target :: tmp_buffer - real, dimension(:), allocatable :: h_stack + real, dimension(:,:,:), allocatable, target :: tmp_buffer ! A buffer for input data [various units] + real, dimension(:), allocatable :: h_stack ! Thicknesses at corner points [H ~> m or kg m-2] integer :: is_obc2, js_obc2 - real :: net_H_src, net_H_int, scl_fac - real :: tidal_vel, tidal_elev - real, pointer, dimension(:,:) :: normal_trans_bt=>NULL() ! barotropic transport - integer :: turns ! Number of index quarter turns - real :: time_delta ! Time since tidal reference date + real :: net_H_src ! Total thickness of the incoming flow in the source field [H ~> m or kg m-2] + real :: net_H_int ! Total thickness of the incoming flow in the model [H ~> m or kg m-2] + real :: scl_fac ! A scaling factor to compensate for differences in total thicknesses [nondim] + real :: tidal_vel ! Interpolated tidal velocity at the OBC points [m s-1] + real :: tidal_elev ! Interpolated tidal elevation at the OBC points [m] + real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] + integer :: turns ! Number of index quarter turns + real :: time_delta ! Time since tidal reference date [T ~> s] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3758,7 +3740,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (.not. associated(OBC)) return - if (OBC%add_tide_constituents) time_delta = time_type_to_real(Time - OBC%time_ref) + if (OBC%add_tide_constituents) time_delta = US%s_to_T * time_type_to_real(Time - OBC%time_ref) do n = 1, OBC%number_of_segments segment => OBC%segment(n) @@ -3816,7 +3798,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) siz(1)=size(segment%field(m)%buffer_src,1) siz(2)=size(segment%field(m)%buffer_src,2) siz(3)=size(segment%field(m)%buffer_src,3) - if (.not.associated(segment%field(m)%buffer_dst)) then + if (.not.allocated(segment%field(m)%buffer_dst)) then if (siz(3) /= segment%field(m)%nk_src) call MOM_error(FATAL,'nk_src inconsistency') if (segment%field(m)%nk_src > 1) then if (segment%is_E_or_W) then @@ -3865,15 +3847,15 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! NOTE: buffer is sized for vertex points, but may be used for faces if (siz(1)==1) then if (OBC%brushcutter_mode) then - allocate(tmp_buffer(1,nj_seg*2-1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(1,nj_seg*2-1,segment%field(m)%nk_src)) ! segment data is currently on supergrid else - allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currently on supergrid endif else if (OBC%brushcutter_mode) then - allocate(tmp_buffer(ni_seg*2-1,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(ni_seg*2-1,1,segment%field(m)%nk_src)) ! segment data is currently on supergrid else - allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currently on supergrid endif endif @@ -3957,7 +3939,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif ! no dz for tidal variables if (segment%field(m)%nk_src > 1 .and.& - (index(segment%field(m)%name, 'phase') .le. 0 .and. index(segment%field(m)%name, 'amp') .le. 0)) then + (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer_in) if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. @@ -4113,7 +4095,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (turns /= 0) & deallocate(tmp_buffer_in) else ! fid <= 0 (Uniform value) - if (.not. associated(segment%field(m)%buffer_dst)) then + if (.not. allocated(segment%field(m)%buffer_dst)) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) @@ -4178,7 +4160,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) & / (max(segment%Htot(I,j), 1.e-12 * GV%m_to_H) * G%dyCu(I,j)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then J=js_obc @@ -4200,10 +4182,10 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) & / (max(segment%Htot(i,J), 1.e-12 * GV%m_to_H) * G%dxCv(i,J)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then I=is_obc do J=js_obc,je_obc tidal_vel = 0.0 @@ -4217,11 +4199,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then J=js_obc do I=is_obc,ie_obc tidal_vel = 0.0 @@ -4235,27 +4217,27 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo endif elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then I=is_obc do J=js_obc,je_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then J=js_obc do I=is_obc,ie_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo @@ -4314,7 +4296,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif if (trim(segment%field(m)%name) == 'TEMP') then - if (associated(segment%field(m)%buffer_dst)) then + if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4329,7 +4311,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%tr_Reg%Tr(1)%OBC_inflow_conc = segment%field(m)%value endif elseif (trim(segment%field(m)%name) == 'SALT') then - if (associated(segment%field(m)%buffer_dst)) then + if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4356,14 +4338,16 @@ end subroutine update_OBC_segment_data !> Update the OBC ramp value as a function of time. !! If called with the optional argument activate=.true., record the !! value of Time as the beginning of the ramp period. -subroutine update_OBC_ramp(Time, OBC, activate) +subroutine update_OBC_ramp(Time, OBC, US, activate) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - logical, optional, intent(in) :: activate !< Specifiy whether to record the value of + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime, wghtA + real :: deltaTime ! The time since start of ramping [T ~> s] + real :: wghtA ! A temporary variable used to set OBC%ramp_value [nondim] character(len=12) :: msg if (.not. OBC%ramp) return ! This indicates the ramping is turned off @@ -4378,7 +4362,7 @@ subroutine update_OBC_ramp(Time, OBC, activate) endif endif if (.not.OBC%ramping_is_activated) return - deltaTime = max( 0., time_type_to_real( Time - OBC%ramp_start_time ) ) + deltaTime = max( 0., US%s_to_T*time_type_to_real( Time - OBC%ramp_start_time ) ) if (deltaTime >= OBC%trunc_ramp_time) then OBC%ramp_value = 1.0 OBC%ramp = .false. ! This turns off ramping after this call @@ -4510,7 +4494,7 @@ subroutine segment_tracer_registry_init(param_file, segment) end subroutine segment_tracer_registry_init -!> Register a tracer array that is active on an OBC segment, potentially also specifing how the +!> Register a tracer array that is active on an OBC segment, potentially also specifying how the !! tracer inflow values are specified. subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_scalar, OBC_array) @@ -4582,7 +4566,7 @@ subroutine segment_tracer_registry_end(Reg) if (associated(Reg)) then do n = 1, Reg%ntseg - if (associated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) + if (allocated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) enddo deallocate(Reg) endif @@ -4623,12 +4607,11 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments subroutine fill_temp_salt_segments(G, GV, OBC, tv) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure -! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz integer :: i, j, k type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -4927,14 +4910,14 @@ subroutine flood_fill2(G, color, cin, cout, cland) end subroutine flood_fill2 !> Register OBC segment data for restarts -subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart_CSp, & +subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart_CS, & use_temperature) type(hor_index_type), intent(in) :: HI !< Horizontal indices type(verticalGrid_type), pointer :: GV !< Container for vertical grid information type(ocean_OBC_type), pointer :: OBC !< OBC data structure, data intent(inout) type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables type(vardesc) :: vd(2) @@ -4946,15 +4929,6 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart call MOM_error(FATAL, "open_boundary_register_restarts: Called with "//& "uninitialized OBC control structure") - if (associated(OBC%rx_normal) .or. associated(OBC%ry_normal) .or. & - associated(OBC%rx_oblique) .or. associated(OBC%ry_oblique) .or. associated(OBC%cff_normal)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - - if (associated(OBC%tres_x) .or. associated(OBC%tres_y)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - ! *** This is a temporary work around for restarts with OBC segments. ! This implementation uses 3D arrays solely for restarts. We need ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using @@ -4966,7 +4940,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart vd(1) = var_desc("rx_normal", "m s-1", "Normal Phase Speed for EW radiation OBCs", 'u', 'L') vd(2) = var_desc("ry_normal", "m s-1", "Normal Phase Speed for NS radiation OBCs", 'v', 'L') call register_restart_pair(OBC%rx_normal, OBC%ry_normal, vd(1), vd(2), & - .false., restart_CSp) + .false., restart_CS) endif if (OBC%oblique_BCs_exist_globally) then @@ -4976,15 +4950,15 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart vd(1) = var_desc("rx_oblique", "m2 s-2", "Radiation Speed Squared for EW oblique OBCs", 'u', 'L') vd(2) = var_desc("ry_oblique", "m2 s-2", "Radiation Speed Squared for NS oblique OBCs", 'v', 'L') call register_restart_pair(OBC%rx_oblique, OBC%ry_oblique, vd(1), vd(2), & - .false., restart_CSp) + .false., restart_CS) allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("cff_normal", "m2 s-2", "denominator for oblique OBCs", 'q', 'L') - call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CSp) + call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CS) endif if (Reg%ntr == 0) return - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then OBC%ntr = Reg%ntr allocate(OBC%tracer_x_reservoirs_used(Reg%ntr), source=.false.) allocate(OBC%tracer_y_reservoirs_used(Reg%ntr), source=.false.) @@ -4992,7 +4966,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart else ! This would be coming from user code such as DOME. if (OBC%ntr /= Reg%ntr) then -! call MOM_error(FATAL, "open_boundary_regiser_restarts: Inconsistent value for ntr") +! call MOM_error(FATAL, "open_boundary_register_restarts: Inconsistent value for ntr") write(mesg,'("Inconsistent values for ntr ", I8," and ",I8,".")') OBC%ntr, Reg%ntr call MOM_error(WARNING, 'open_boundary_register_restarts: '//mesg) endif @@ -5006,11 +4980,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (modulo(HI%turns, 2) /= 0) then write(mesg,'("tres_y_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for NS OBCs",'v','L') - call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CS) else write(mesg,'("tres_x_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for EW OBCs",'u','L') - call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CS) endif endif enddo @@ -5022,11 +4996,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (modulo(HI%turns, 2) /= 0) then write(mesg,'("tres_x_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for EW OBCs",'u','L') - call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CS) else write(mesg,'("tres_y_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for NS OBCs",'v','L') - call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CS) endif endif enddo @@ -5046,7 +5020,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, intent(in) :: dt !< time increment [T ~> s] type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - ! Local variables + type(OBC_segment_type), pointer :: segment=>NULL() real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell [L ~> m] @@ -5072,7 +5046,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & @@ -5081,7 +5055,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) - if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) + if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif ; enddo enddo elseif (segment%is_N_or_S) then @@ -5097,7 +5071,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & @@ -5106,7 +5080,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) - if (associated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) + if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) enddo ; endif ; enddo enddo endif @@ -5123,17 +5097,17 @@ end subroutine update_segment_tracer_reservoirs !! @remark{There is a (hard-wired) "tolerance" parameter such that the !! criteria for adjustment must equal or exceed 10cm.} subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(OBC_segment_type), intent(inout) :: segment !< pointer to segment type - integer, intent(in) :: fld !< field index to adjust thickness - ! Local variables + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(OBC_segment_type), intent(inout) :: segment !< OBC segment + integer, intent(in) :: fld !< field index to adjust thickness + integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n - real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] + real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights [Z ~> m] real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] - real :: hTmp, eTmp, dilate + ! real :: dilate ! A factor by which to dilate the water column [nondim] character(len=100) :: mesg hTolerance = 0.1*US%m_to_Z @@ -5433,14 +5407,14 @@ end subroutine rotate_OBC_segment_config !> Initialize the segments and field-related data of a rotated OBC. -subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) - type(ocean_OBC_type), pointer, intent(in) :: OBC_in !< OBC on input map +subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) + type(ocean_OBC_type), intent(in) :: OBC_in !< OBC on input map type(ocean_grid_type), intent(in) :: G !< Rotated grid metric type(verticalGrid_type), intent(in) :: GV !< Vertical grid type(unit_scale_type), intent(in) :: US !< Unit scaling type(param_file_type), intent(in) :: param_file !< Input parameters type(thermo_var_ptrs), intent(inout) :: tv !< Tracer fields - type(MOM_restart_CS), pointer, intent(in) :: restart_CSp !< Restart CS + type(MOM_restart_CS), intent(in) :: restart_CS !< Restart CS type(ocean_OBC_type), pointer, intent(inout) :: OBC !< Rotated OBC logical :: use_temperature @@ -5457,7 +5431,7 @@ subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) if (use_temperature) & call fill_temp_salt_segments(G, GV, OBC, tv) - call open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) + call open_boundary_init(G, GV, US, param_file, OBC, restart_CS) end subroutine rotate_OBC_init @@ -5523,7 +5497,6 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns) segment%field(n)%dz_src) endif - segment%field(n)%buffer_dst => NULL() segment%field(n)%value = segment_in%field(n)%value enddo diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 new file mode 100644 index 0000000000..d23509d5f6 --- /dev/null +++ b/src/core/MOM_porous_barriers.F90 @@ -0,0 +1,168 @@ +!> Module for calculating curve fit for porous topography. +!written by sjd +module MOM_porous_barriers + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, porous_barrier_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_interface_heights, only : find_eta + +implicit none ; private + +#include + +public porous_widths + +!> Calculates curve fit from D_min, D_max, D_avg +interface porous_widths + module procedure por_widths, calc_por_layer +end interface porous_widths + +contains + +!> subroutine to assign cell face areas and layer widths for porous topography +subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) + !eta_bt, halo_size, eta_to_m not currently used + !variables needed to call find_eta + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights + !! [Z ~> m] or 1/eta_to_m m). + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic + !! variable that gives the "correct" free surface height (Boussinesq) or total water + !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. + !! thicknesses when calculating interfaceheights [H ~> m or kg m-2]. + integer, optional, intent(in) :: halo_size !< width of halo points on + !! which to calculate eta. + + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is US%Z_to_m. + type(porous_barrier_ptrs), intent(inout) :: pbv !< porous barrier fractional cell metrics + + !local variables + integer ii, i, j, k, nk, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + real w_layer, & ! fractional open width of layer interface [nondim] + A_layer, & ! integral of fractional open width from bottom to current layer[Z ~> m] + A_layer_prev, & ! integral of fractional open width from bottom to previous layer [Z ~> m] + eta_s, & ! layer height used for fit [Z ~> m] + eta_prev ! interface height of previous layer [Z ~> m] + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed + IsdB = G%IsdB; IedB = G%IedB; JsdB = G%JsdB; JedB = G%JedB + + !eta is zero at surface and decreases downward + + nk = SZK_(G) + + !currently no treatment for using optional find_eta arguments if present + call find_eta(h, tv, G, GV, US, eta) + + do j=jsd,jed; do I=IsdB,IedB + if (G%porous_DavgU(I,j) < 0.) then + do K = nk+1,1,-1 + eta_s = max(eta(I,j,K), eta(I+1,j,K)) !take shallower layer height + if (eta_s <= G%porous_DminU(I,j)) then + pbv%por_layer_widthU(I,j,K) = 0.0 + A_layer_prev = 0.0 + if (K < nk+1) then + pbv%por_face_areaU(I,j,k) = 0.0; endif + else + call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), & + G%porous_DavgU(I,j), eta_s, w_layer, A_layer) + pbv%por_layer_widthU(I,j,K) = w_layer + if (k <= nk) then + if ((eta_s - eta_prev) > 0.0) then + pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& + (eta_s-eta_prev) + else + pbv%por_face_areaU(I,j,k) = 0.0; endif + endif + eta_prev = eta_s + A_layer_prev = A_layer + endif + enddo + endif + enddo; enddo + + do J=JsdB,JedB; do i=isd,ied + if (G%porous_DavgV(i,J) < 0.) then + do K = nk+1,1,-1 + eta_s = max(eta(i,J,K), eta(i,J+1,K)) !take shallower layer height + if (eta_s <= G%porous_DminV(i,J)) then + pbv%por_layer_widthV(i,J,K) = 0.0 + A_layer_prev = 0.0 + if (K < nk+1) then + pbv%por_face_areaV(i,J,k) = 0.0; endif + else + call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), & + G%porous_DavgV(i,J), eta_s, w_layer, A_layer) + pbv%por_layer_widthV(i,J,K) = w_layer + if (k <= nk) then + if ((eta_s - eta_prev) > 0.0) then + pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& + (eta_s-eta_prev) + else + pbv%por_face_areaU(I,j,k) = 0.0; endif + endif + eta_prev = eta_s + A_layer_prev = A_layer + endif + enddo + endif + enddo; enddo + +end subroutine por_widths + +!> subroutine to calculate the profile fit for a single layer in a column +subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) + + real, intent(in) :: D_min !< minimum topographic height [Z ~> m] + real, intent(in) :: D_max !< maximum topographic height [Z ~> m] + real, intent(in) :: D_avg !< mean topographic height [Z ~> m] + real, intent(in) :: eta_layer !< height of interface [Z ~> m] + real, intent(out) :: w_layer !< frac. open interface width of current layer [nondim] + real, intent(out) :: A_layer !< frac. open face area of current layer [Z ~> m] + !local variables + real m, a, & !convenience constant for fit [nondim] + zeta, & !normalized vertical coordinate [nondim] + psi, & !fractional width of layer between D_min and D_max [nondim] + psi_int !integral of psi from 0 to zeta + + !three parameter fit from Adcroft 2013 + m = (D_avg - D_min)/(D_max - D_min) + a = (1. - m)/m + + zeta = (eta_layer - D_min)/(D_max - D_min) + + if (eta_layer <= D_min) then + w_layer = 0.0 + A_layer = 0.0 + elseif (eta_layer >= D_max) then + w_layer = 1.0 + A_layer = eta_layer - D_avg + else + if (m < 0.5) then + psi = zeta**(1./a) + psi_int = (1.-m)*zeta**(1./(1.-m)) + elseif (m == 0.5) then + psi = zeta + psi_int = 0.5*zeta*zeta + else + psi = 1. - (1. - zeta)**a + psi_int = zeta - m + m*((1-zeta)**(1/m)) + endif + w_layer = psi + A_layer = (D_max - D_min)*psi_int + endif + + +end subroutine calc_por_layer + +end module MOM_porous_barriers diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index a9626a805c..7ab15d542e 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -4,14 +4,14 @@ module MOM_transcribe_grid ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_array_transform, only: rotate_array, rotate_array_pair -use MOM_domains, only : pass_var, pass_vector -use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE, AGRID, BGRID_NE, CORNER -use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_grid, only : ocean_grid_type, set_derived_metrics -use MOM_unit_scaling, only : unit_scale_type - +use MOM_array_transform, only : rotate_array, rotate_array_pair +use MOM_domains, only : pass_var, pass_vector +use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE, AGRID, BGRID_NE, CORNER +use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid +use MOM_dyn_horgrid, only : rotate_dyngrid=>rotate_dyn_horgrid +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_grid, only : ocean_grid_type, set_derived_metrics +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -71,6 +71,10 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyCu(I,j) = dG%dyCu(I+ido,j+jdo) oG%dy_Cu(I,j) = dG%dy_Cu(I+ido,j+jdo) + oG%porous_DminU(I,j) = dG%porous_DminU(I+ido,j+jdo) - oG%Z_ref + oG%porous_DmaxU(I,j) = dG%porous_DmaxU(I+ido,j+jdo) - oG%Z_ref + oG%porous_DavgU(I,j) = dG%porous_DavgU(I+ido,j+jdo) - oG%Z_ref + oG%mask2dCu(I,j) = dG%mask2dCu(I+ido,j+jdo) oG%areaCu(I,j) = dG%areaCu(I+ido,j+jdo) oG%IareaCu(I,j) = dG%IareaCu(I+ido,j+jdo) @@ -83,6 +87,10 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyCv(i,J) = dG%dyCv(i+ido,J+jdo) oG%dx_Cv(i,J) = dG%dx_Cv(i+ido,J+jdo) + oG%porous_DminV(i,J) = dG%porous_DminV(i+ido,J+jdo) - oG%Z_ref + oG%porous_DmaxV(i,J) = dG%porous_DmaxV(i+ido,J+jdo) - oG%Z_ref + oG%porous_DavgV(i,J) = dG%porous_DavgV(i+ido,J+jdo) - oG%Z_ref + oG%mask2dCv(i,J) = dG%mask2dCv(i+ido,J+jdo) oG%areaCv(i,J) = dG%areaCv(i+ido,J+jdo) oG%IareaCv(i,J) = dG%IareaCv(i+ido,J+jdo) @@ -126,7 +134,8 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%areaT_global = dG%areaT_global ; oG%IareaT_global = dG%IareaT_global oG%south_lat = dG%south_lat ; oG%west_lon = dG%west_lon oG%len_lat = dG%len_lat ; oG%len_lon = dG%len_lon - oG%Rad_Earth = dG%Rad_Earth ; oG%max_depth = dG%max_depth + oG%Rad_Earth = dG%Rad_Earth ; oG%Rad_Earth_L = dG%Rad_Earth_L + oG%max_depth = dG%max_depth ! Update the halos in case the dynamic grid has smaller halos than the ocean grid. call pass_var(oG%areaT, oG%Domain) @@ -170,7 +179,7 @@ end subroutine copy_dyngrid_to_MOM_grid subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) type(ocean_grid_type), intent(in) :: oG !< Ocean grid type type(dyn_horgrid_type), intent(inout) :: dG !< Common horizontal grid type - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -216,6 +225,10 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyCu(I,j) = oG%dyCu(I+ido,j+jdo) dG%dy_Cu(I,j) = oG%dy_Cu(I+ido,j+jdo) + dG%porous_DminU(I,j) = oG%porous_DminU(I+ido,j+jdo) + oG%Z_ref + dG%porous_DmaxU(I,j) = oG%porous_DmaxU(I+ido,j+jdo) + oG%Z_ref + dG%porous_DavgU(I,j) = oG%porous_DavgU(I+ido,j+jdo) + oG%Z_ref + dG%mask2dCu(I,j) = oG%mask2dCu(I+ido,j+jdo) dG%areaCu(I,j) = oG%areaCu(I+ido,j+jdo) dG%IareaCu(I,j) = oG%IareaCu(I+ido,j+jdo) @@ -228,6 +241,10 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyCv(i,J) = oG%dyCv(i+ido,J+jdo) dG%dx_Cv(i,J) = oG%dx_Cv(i+ido,J+jdo) + dG%porous_DminV(i,J) = oG%porous_DminU(i+ido,J+jdo) + oG%Z_ref + dG%porous_DmaxV(i,J) = oG%porous_DmaxU(i+ido,J+jdo) + oG%Z_ref + dG%porous_DavgV(i,J) = oG%porous_DavgU(i+ido,J+jdo) + oG%Z_ref + dG%mask2dCv(i,J) = oG%mask2dCv(i+ido,J+jdo) dG%areaCv(i,J) = oG%areaCv(i+ido,J+jdo) dG%IareaCv(i,J) = oG%IareaCv(i+ido,J+jdo) @@ -272,7 +289,8 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%areaT_global = oG%areaT_global ; dG%IareaT_global = oG%IareaT_global dG%south_lat = oG%south_lat ; dG%west_lon = oG%west_lon dG%len_lat = oG%len_lat ; dG%len_lon = oG%len_lon - dG%Rad_Earth = oG%Rad_Earth ; dG%max_depth = oG%max_depth + dG%Rad_Earth = oG%Rad_Earth ; dG%Rad_Earth_L = oG%Rad_Earth_L + dG%max_depth = oG%max_depth ! Update the halos in case the dynamic grid has smaller halos than the ocean grid. call pass_var(dG%areaT, dG%Domain) @@ -305,96 +323,8 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) call pass_vector(dG%Dopen_u, dG%Dopen_v, dG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_dyn_horgrid(dG, US) + call set_derived_dyn_horgrid(dG, US) end subroutine copy_MOM_grid_to_dyngrid -subroutine rotate_dyngrid(G_in, G, US, turns) - type(dyn_horgrid_type), intent(in) :: G_in !< Common horizontal grid type - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid type - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, intent(in) :: turns !< Number of quarter turns - - integer :: jsc, jec, jscB, jecB - integer :: qturn - - ! Center point - call rotate_array(G_in%geoLonT, turns, G%geoLonT) - call rotate_array(G_in%geoLatT, turns, G%geoLatT) - call rotate_array_pair(G_in%dxT, G_in%dyT, turns, G%dxT, G%dyT) - call rotate_array(G_in%areaT, turns, G%areaT) - call rotate_array(G_in%bathyT, turns, G%bathyT) - - call rotate_array_pair(G_in%df_dx, G_in%df_dy, turns, G%df_dx, G%df_dy) - call rotate_array(G_in%sin_rot, turns, G%sin_rot) - call rotate_array(G_in%cos_rot, turns, G%cos_rot) - call rotate_array(G_in%mask2dT, turns, G%mask2dT) - - ! Face point - call rotate_array_pair(G_in%geoLonCu, G_in%geoLonCv, turns, & - G%geoLonCu, G%geoLonCv) - call rotate_array_pair(G_in%geoLatCu, G_in%geoLatCv, turns, & - G%geoLatCu, G%geoLatCv) - call rotate_array_pair(G_in%dxCu, G_in%dyCv, turns, G%dxCu, G%dyCv) - call rotate_array_pair(G_in%dxCv, G_in%dyCu, turns, G%dxCv, G%dyCu) - call rotate_array_pair(G_in%dx_Cv, G_in%dy_Cu, turns, G%dx_Cv, G%dy_Cu) - - call rotate_array_pair(G_in%mask2dCu, G_in%mask2dCv, turns, & - G%mask2dCu, G%mask2dCv) - call rotate_array_pair(G_in%areaCu, G_in%areaCv, turns, & - G%areaCu, G%areaCv) - call rotate_array_pair(G_in%IareaCu, G_in%IareaCv, turns, & - G%IareaCu, G%IareaCv) - - ! Vertex point - call rotate_array(G_in%geoLonBu, turns, G%geoLonBu) - call rotate_array(G_in%geoLatBu, turns, G%geoLatBu) - call rotate_array_pair(G_in%dxBu, G_in%dyBu, turns, G%dxBu, G%dyBu) - call rotate_array(G_in%areaBu, turns, G%areaBu) - call rotate_array(G_in%CoriolisBu, turns, G%CoriolisBu) - call rotate_array(G_in%mask2dBu, turns, G%mask2dBu) - - ! Topographic - G%bathymetry_at_vel = G_in%bathymetry_at_vel - if (G%bathymetry_at_vel) then - call rotate_array_pair(G_in%Dblock_u, G_in%Dblock_v, turns, & - G%Dblock_u, G%Dblock_v) - call rotate_array_pair(G_in%Dopen_u, G_in%Dopen_v, turns, & - G%Dopen_u, G%Dopen_v) - endif - - ! Nominal grid axes - ! TODO: We should not assign lat values to the lon axis, and vice versa. - ! We temporarily copy lat <-> lon since several components still expect - ! lat and lon sizes to match the first and second dimension sizes. - ! But we ought to instead leave them unchanged and adjust the references to - ! these axes. - if (modulo(turns, 2) /= 0) then - G%gridLonT(:) = G_in%gridLatT(G_in%jeg:G_in%jsg:-1) - G%gridLatT(:) = G_in%gridLonT(:) - G%gridLonB(:) = G_in%gridLatB(G_in%jeg:(G_in%jsg-1):-1) - G%gridLatB(:) = G_in%gridLonB(:) - else - G%gridLonT(:) = G_in%gridLonT(:) - G%gridLatT(:) = G_in%gridLatT(:) - G%gridLonB(:) = G_in%gridLonB(:) - G%gridLatB(:) = G_in%gridLatB(:) - endif - - G%x_axis_units = G_in%y_axis_units - G%y_axis_units = G_in%x_axis_units - G%south_lat = G_in%south_lat - G%west_lon = G_in%west_lon - G%len_lat = G_in%len_lat - G%len_lon = G_in%len_lon - - ! Rotation-invariant fields - G%areaT_global = G_in%areaT_global - G%IareaT_global = G_in%IareaT_global - G%Rad_Earth = G_in%Rad_Earth - G%max_depth = G_in%max_depth - - call set_derived_dyn_horgrid(G, US) -end subroutine rotate_dyngrid - end module MOM_transcribe_grid diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 363f3eebfb..a9bf6c3dcf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -11,6 +11,7 @@ module MOM_variables use MOM_EOS, only : EOS_type use MOM_error_handler, only : MOM_error, FATAL use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -67,7 +68,7 @@ module MOM_variables 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]. + !! absolute salinity in [gSalt kg-1]. 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 @@ -95,7 +96,7 @@ module MOM_variables logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is !! actually the conservative temperature [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is - !! actually the absolute salinity in units of [gSalt/kg]. + !! actually the absolute salinity in units of [gSalt kg-1]. real :: min_salinity = 0.01 !< The minimum value of salinity when BOUND_SALINITY=True [ppt]. !! The default is 0.01 for backward compatibility but should be 0. ! These arrays are accumulated fluxes for communication with other components. @@ -192,13 +193,15 @@ module MOM_variables real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [L T-2 ~> m s-2] real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [L T-2 ~> m s-2] - real, pointer :: diag_hfrac_u(:,:,:) => NULL() !< Fractional layer thickness at u points - real, pointer :: diag_hfrac_v(:,:,:) => NULL() !< Fractional layer thickness at v points - real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points - real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points + real, pointer :: diag_hfrac_u(:,:,:) => NULL() !< Fractional layer thickness at u points [nondim] + real, pointer :: diag_hfrac_v(:,:,:) => NULL() !< Fractional layer thickness at v points [nondim] + real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points, modulated by the viscous + !! remnant and fractional open areas [H ~> m or kg m-2] + real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points, modulated by the viscous + !! remnant and fractional open areas [H ~> m or kg m-2] - real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points - real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points + real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points [nondim] + real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points [nondim] end type accel_diag_ptrs @@ -282,10 +285,10 @@ module MOM_variables !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the west [H L ~> m2 or kg m-1]. - real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_u_WW. uBT_WW must be non-negative. - real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_u_EE. uBT_EE must be non-positive. + real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_u_WW. uBT_WW must be non-negative. + real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport @@ -294,16 +297,32 @@ module MOM_variables !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the south [H L ~> m2 or kg m-1]. - real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_v_SS. vBT_SS must be non-negative. - real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_v_NN. vBT_NN must be non-positive. - real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. - real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. + real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_v_SS. vBT_SS must be non-negative. + real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_v_NN. vBT_NN must be non-positive. + real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, taking into account the effects + !! of vertical viscosity and fractional open areas [H ~> m or kg m-2]. + !! This is primarily used as a non-normalized weight in determining + !! the depth averaged accelerations for the barotropic solver. + real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, taking into account the effects + !! of vertical viscosity and fractional open areas [H ~> m or kg m-2]. + !! This is primarily used as a non-normalized weight in determining + !! the depth averaged accelerations for the barotropic solver. type(group_pass_type) :: pass_polarity_BT !< Structure for polarity group halo updates type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type + +!> pointers to grids modifying cell metric at porous barriers +type, public :: porous_barrier_ptrs + real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] +end type porous_barrier_ptrs + + contains !> Allocates the fields for the surface (return) properties of @@ -552,10 +571,11 @@ subroutine dealloc_BT_cont_type(BT_cont) end subroutine dealloc_BT_cont_type !> Diagnostic checksums on various elements of a thermo_var_ptrs type for debugging. -subroutine MOM_thermovar_chksum(mesg, tv, G) +subroutine MOM_thermovar_chksum(mesg, tv, G, US) character(len=*), intent(in) :: mesg !< A message that appears in the checksum 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 ! 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 @@ -565,11 +585,11 @@ subroutine MOM_thermovar_chksum(mesg, tv, G) if (associated(tv%S)) & call hchksum(tv%S, mesg//" tv%S", G%HI) if (associated(tv%frazil)) & - call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=G%US%RZ_to_kg_m2) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=US%RZ_to_kg_m2) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=G%US%RZ_to_kg_m2) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=US%RZ_to_kg_m2) end subroutine MOM_thermovar_chksum end module MOM_variables diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 46fbd55862..b856cff3dc 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -54,17 +54,26 @@ module MOM_verticalGrid !! as parts of a homogeneous region. integer :: nk_rho_varies = 0 !< The number of layers at the top where the !! density does not track any target density. - real :: H_to_kg_m2 !< A constant that translates thicknesses from the units of thickness to kg m-2. - real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to the units of thickness. - real :: m_to_H !< A constant that translates distances in m to the units of thickness. - real :: H_to_m !< A constant that translates distances in the units of thickness to m. - 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 + real :: H_to_kg_m2 !< A constant that translates thicknesses from the units of thickness + !! to kg m-2 [kg m-2 H-1 ~> kg m-3 or 1]. + real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to the units + !! of thickness [H m2 kg-1 ~> m3 kg-1 or 1]. + real :: m_to_H !< A constant that translates distances in m to the units of + !! thickness [H m-1 ~> 1 or kg m-3]. + real :: H_to_m !< A constant that translates distances in the units of thickness + !! to m [m H-1 ~> 1 or m3 kg-1]. + real :: H_to_Pa !< A constant that translates the units of thickness to pressure + !! [Pa H-1 = kg m-1 s-2 H-1 ~> kg m-2 s-2 or m s-2]. + real :: H_to_Z !< A constant that translates thickness units to the units of + !! depth [Z H-1 ~> 1 or m3 kg-1]. + real :: Z_to_H !< A constant that translates depth units to thickness units + !! depth [H Z-1 ~> 1 or kg m-3]. + real :: H_to_RZ !< A constant that translates thickness units to the units of + !! mass per unit area [R Z H-1 ~> kg m-3 or 1]. + real :: RZ_to_H !< A constant that translates mass per unit area units to + !! thickness units [H R-1 Z-1 ~> m3 kg-2 or 1]. + real :: H_to_MKS !< A constant that translates thickness units to its MKS unit + !! (m or kg m-2) based on GV%Boussinesq [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type @@ -81,7 +90,7 @@ subroutine verticalGridInit( param_file, GV, US ) ! Local variables integer :: nk, H_power - real :: H_rescale_factor + real :: H_rescale_factor ! The integer power of 2 by which thicknesses are rescaled [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index b5a1a6bf0c..a4badaf8e7 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -46,17 +46,14 @@ module MOM_PointAccel ! that are used to step the physical model forward. They all use the same ! names as the variables they point to in MOM.F90 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1]. - v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1]. - u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1]. - v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1]. - T => NULL(), & !< Temperature [degC]. - S => NULL(), & !< Salinity [ppt]. - u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] - v_accel_bt => NULL() !< Barotropic v-acclerations [L T-2 ~> m s-2] - real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic - !! pressure anomaly in each layer due to free surface height anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. + u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1] + v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1] + u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1] + v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1] + T => NULL(), & !< Temperature [degC] + S => NULL(), & !< Salinity [ppt] + u_accel_bt => NULL(), & !< Barotropic u-accelerations [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Barotropic v-accelerations [L T-2 ~> m s-2] end type PointAccel_CS contains @@ -64,7 +61,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_in_T, G, GV, US, CS, vel_rpt, str, a, hv) +subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, 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. @@ -78,25 +75,25 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp !! 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_in_T !< The ocean dynamics time step [T ~> s]. + real, intent(in) :: dt !< 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]. - real, optional, intent(in) :: str !< The surface wind stress integrated over a time - !! step divided by the Boussinesq density [m2 s-1]. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1] + real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. ! Local variables - real :: f_eff, CFL - real :: Angstrom - real :: truncvel, du - real :: dt ! The time step [s] - real :: Inorm(SZK_(GV)) - real :: e(SZK_(GV)+1) - real :: h_scale, uh_scale + real :: CFL ! The local velocity-based CFL number [nondim] + real :: Angstrom ! A negligibly small thickness [H ~> m or kg m-2] + real :: du ! A velocity change [L T-1 ~> m s-1] + real :: Inorm(SZK_(GV)) ! The inverse of the normalized velocity change [L T-1 ~> m s-1] + real :: e(SZK_(GV)+1) ! Simple estimates of interface heights based on the sum of thicknesses [m] + real :: h_scale ! A scaling factor for thicknesses [m H-1 ~> 1 or m3 kg-1] + real :: vel_scale ! A scaling factor for velocities [m T s-1 L-1 ~> 1] + real :: uh_scale ! A scaling factor for transport per unit length [m2 T s-1 L-1 H-1 ~> 1 or m3 kg-1] integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -105,8 +102,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp 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*US%L_T_to_m_s + h_scale = GV%H_to_m ; vel_scale = US%L_T_to_m_s ; uh_scale = GV%H_to_m*US%L_T_to_m_s ! if (.not.associated(CS)) return nz = GV%ke @@ -153,7 +149,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp write (file,'(/,"Time ",i5,i4,F6.2," U-velocity violation at ",I4,": ",2(I3), & & " (",F7.2," E "F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), I, j, & - G%geoLonCu(I,j), G%geoLatCu(I,j), ks, ke, dt + G%geoLonCu(I,j), G%geoLatCu(I,j), ks, ke, US%T_to_s*dt if (ks <= GV%nk_rho_varies) ks = 1 do k=ks,ke @@ -161,98 +157,98 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp enddo write(file,'(/,"Layers:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k) ; enddo write(file,'(/,"u(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*um(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*um(I,j,k)) ; enddo if (prev_avail) then write(file,'(/,"u(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_prev(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%u_prev(I,j,k)) ; enddo endif write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_av(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%u_av(I,j,k)) ; enddo write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(um(I,j,k)) * US%s_to_T*dt * G%dy_Cu(I,j) + CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * US%s_to_T*dt * G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))); enddo + (vel_scale*(um(I,j,k)-CS%u_prev(I,j,k))) ; enddo endif write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%CAu(I,j,k)) ; enddo write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%PFu(I,j,k)) ; enddo write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%diffu(I,j,k)) ; enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)); enddo + (vel_scale*dt*ADp%gradKEu(I,j,k)) ; enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo + vel_scale*dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)) ; enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - US%L_T_to_m_s*(um(I,j,k) - US%s_to_T*dt*ADp%du_dt_visc(I,j,k)); enddo + vel_scale*(um(I,j,k) - dt*ADp%du_dt_visc(I,j,k)) ; enddo write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k)); enddo + (vel_scale*dt*ADp%du_dt_visc(I,j,k)) ; enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*ADp%du_other(I,j,k)); enddo + (vel_scale*ADp%du_other(I,j,k)) ; enddo endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*US%Z_to_m*dt; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%Z_to_m*a(I,j,k)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(I,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hv(I,j,k) ; enddo endif - write(file,'(/,"Stress: ",ES10.3)') str + write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)) ; enddo + (vel_scale*dt*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif write(file,'(/,"h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j-1,k)) ; enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j-1,k)) ; enddo write(file,'(/,"h-0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j,k)) ; enddo write(file,'(/,"h+0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j,k)) ; enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j+1,k)) ; enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo @@ -261,74 +257,74 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k) ; enddo write(file,'(/,"T+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i+1,j,k) ; enddo endif if (associated(CS%S)) then write(file,'(/,"S-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k) ; enddo write(file,'(/,"S+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i+1,j,k) ; enddo endif if (prev_avail) then write(file,'(/,"v--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J-1,k)) ; enddo write(file,'(/,"v-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J,k)) ; enddo write(file,'(/,"v+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i+1,J-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i+1,J-1,k)) ; enddo write(file,'(/,"v++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i+1,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i+1,J,k)) ; enddo endif write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)) ; enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_av(i,j-1,k)*uh_scale*(hin(i,j-1,k) + hin(i,j,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_prev(i,j-1,k)*uh_scale*(hin(i,j-1,k) + hin(i,j,k))) ; enddo endif write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)) ; enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_av(i,J,k)*uh_scale*(hin(i,j,k) + hin(i,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_prev(i,J,k)*uh_scale*(hin(i,j,k) + hin(i,j+1,k))) ; enddo endif write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)) ; enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_av(i+1,J-1,k)*uh_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_prev(i+1,J-1,k)*uh_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))) ; enddo endif write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)) ; enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*uh_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*uh_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))) ; enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) @@ -336,54 +332,54 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = US%L_T_to_m_s*(um(I,j,k) - CS%u_prev(I,j,k)) - if (abs(du) < 1.0e-6) du = 1.0e-6 + du = um(I,j,k) - CS%u_prev(I,j,k) + if (abs(du) < 1.0e-6*US%m_s_to_L_T) du = 1.0e-6*US%m_s_to_L_T Inorm(k) = 1.0 / du enddo write(file,'(2/,"Norm: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (vel_scale / Inorm(k)) ; enddo write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + ((um(I,j,k)-CS%u_prev(I,j,k)) * Inorm(k)) ; enddo write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)*Inorm(k)); enddo + (dt*ADp%CAu(I,j,k) * Inorm(k)) ; enddo write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)*Inorm(k)); enddo + (dt*ADp%PFu(I,j,k) * Inorm(k)) ; enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*ADp%diffu(I,j,k) * Inorm(k)) ; enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)*Inorm(k)); enddo + (dt*ADp%gradKEu(I,j,k) * Inorm(k)) ; enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo + (dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)) * Inorm(k)) ; enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo + (dt*ADp%du_dt_visc(I,j,k) * Inorm(k)) ; enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*ADp%du_other(I,j,k))*Inorm(k); enddo + (ADp%du_other(I,j,k) * Inorm(k)) ; enddo endif if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo + (dt*CS%u_accel_bt(I,j,k) * Inorm(k)) ; enddo endif endif @@ -397,7 +393,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_in_T, G, GV, US, CS, vel_rpt, str, a, hv) +subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, 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,25 +407,25 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp !! 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_in_T !< The ocean dynamics time step [T ~> s]. + real, intent(in) :: dt !< 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]. - real, optional, intent(in) :: str !< The surface wind stress integrated over a time - !! step divided by the Boussinesq density [m2 s-1]. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1] + real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. ! Local variables - real :: f_eff, CFL - real :: Angstrom - real :: truncvel, dv - real :: dt ! The time step [s] - real :: Inorm(SZK_(GV)) - real :: e(SZK_(GV)+1) - real :: h_scale, uh_scale + real :: CFL ! The local velocity-based CFL number [nondim] + real :: Angstrom ! A negligibly small thickness [H ~> m or kg m-2] + real :: dv ! A velocity change [L T-1 ~> m s-1] + real :: Inorm(SZK_(GV)) ! The inverse of the normalized velocity change [L T-1 ~> m s-1] + real :: e(SZK_(GV)+1) ! Simple estimates of interface heights based on the sum of thicknesses [m] + real :: h_scale ! A scaling factor for thicknesses [m H-1 ~> 1 or m3 kg-1] + real :: vel_scale ! A scaling factor for velocities [m T s-1 L-1 ~> 1] + real :: uh_scale ! A scaling factor for transport per unit length [m2 T s-1 L-1 H-1 ~> 1 or m3 kg-1] integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -438,8 +434,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp 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*US%L_T_to_m_s + h_scale = GV%H_to_m ; vel_scale = US%L_T_to_m_s ; uh_scale = GV%H_to_m*US%L_T_to_m_s ! if (.not.associated(CS)) return nz = GV%ke @@ -485,7 +480,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp write (file,'(/,"Time ",i5,i4,F6.2," V-velocity violation at ",I4,": ",2(I3), & & " (",F7.2," E ",F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), i, J, & - G%geoLonCv(i,J), G%geoLatCv(i,J), ks, ke, dt + G%geoLonCv(i,J), G%geoLatCv(i,J), ks, ke, US%T_to_s*dt if (ks <= GV%nk_rho_varies) ks = 1 do k=ks,ke @@ -493,178 +488,178 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp enddo write(file,'(/,"Layers:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k) ; enddo write(file,'(/,"v(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*vm(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*vm(i,J,k)) ; enddo if (prev_avail) then write(file,'(/,"v(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J,k)) ; enddo endif write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_av(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_av(i,J,k)) ; enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(vm(i,J,k)) * US%s_to_T*dt * G%dx_Cv(i,J) + CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * US%s_to_T*dt * G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))); enddo + (vel_scale*(vm(i,J,k)-CS%v_prev(i,J,k))) ; enddo endif write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%CAv(i,J,k)) ; enddo write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%PFv(i,J,k)) ; enddo write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%diffv(i,J,k)) ; enddo if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)); enddo + (vel_scale*dt*ADp%gradKEv(i,J,k)) ; enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo + vel_scale*dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)) ; enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - US%L_T_to_m_s*(vm(i,J,k) - US%s_to_T*dt*ADp%dv_dt_visc(i,J,k)); enddo + vel_scale*(vm(i,J,k) - dt*ADp%dv_dt_visc(i,J,k)) ; enddo write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)); enddo + (vel_scale*dt*ADp%dv_dt_visc(i,J,k)) ; enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*ADp%dv_other(i,J,k)); enddo + (vel_scale*ADp%dv_other(i,J,k)) ; enddo endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*US%Z_to_m*dt; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%Z_to_m*a(i,j,k)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(i,J,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hv(i,J,k) ; enddo endif - write(file,'(/,"Stress: ",ES10.3)') str + write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)) ; enddo + (vel_scale*dt*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif write(file,'("h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j,k) ; enddo write(file,'(/,"h0-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j,k) ; enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j,k) ; enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j+1,k) ; enddo write(file,'(/,"h0+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) - do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k); enddo + do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k) ; enddo write(file,'(/,"T+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j+1,k) ; enddo endif if (associated(CS%S)) then write(file,'(/,"S-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k) ; enddo write(file,'(/,"S+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j+1,k) ; enddo endif if (prev_avail) then write(file,'(/,"u--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I-1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I-1,j,k) ; enddo write(file,'(/,"u-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I-1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I-1,j+1,k) ; enddo write(file,'(/,"u+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I,j,k) ; enddo write(file,'(/,"u++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I,j+1,k) ; enddo endif write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)) ; enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av(I-1,j,k) * uh_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_prev(I-1,j,k) * uh_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))) ; enddo endif write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo + (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)) ; enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av(I-1,j+1,k) * uh_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_prev(I-1,j+1,k) * uh_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))) ; enddo endif write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)) ; enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av(I,j,k) * uh_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_prev(I,j,k) * uh_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))) ; enddo endif write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)) ; enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av(I,j+1,k) * uh_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I,j+1,k) * h_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_prev(I,j+1,k) * uh_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))) ; enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) @@ -672,50 +667,50 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k)) - if (abs(dv) < 1.0e-6) dv = 1.0e-6 + dv = vm(i,J,k) - CS%v_prev(i,J,k) + if (abs(dv) < 1.0e-6*US%m_s_to_L_T) dv = 1.0e-6*US%m_s_to_L_T Inorm(k) = 1.0 / dv enddo write(file,'(2/,"Norm: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (vel_scale / Inorm(k)) ; enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + ((vm(i,J,k)-CS%v_prev(i,J,k)) * Inorm(k)) ; enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo + (dt*ADp%CAv(i,J,k) * Inorm(k)) ; enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)*Inorm(k)); enddo + (dt*ADp%PFv(i,J,k) * Inorm(k)) ; enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*ADp%diffv(i,J,k) * Inorm(k)) ; enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)*Inorm(k)); enddo + (dt*ADp%gradKEv(i,J,k) * Inorm(k)) ; enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo + (dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)) * Inorm(k)) ; enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo + (dt*ADp%dv_dt_visc(i,J,k) * Inorm(k)) ; enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*ADp%dv_other(i,J,k)*Inorm(k)); enddo + (ADp%dv_other(i,J,k) * Inorm(k)) ; enddo endif if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo + (dt*CS%v_accel_bt(i,J,k) * Inorm(k)) ; enddo endif endif @@ -742,8 +737,8 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) !! directory paths. type(PointAccel_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_PointAccel" ! This module's name. if (associated(CS)) return @@ -751,7 +746,7 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%diag => diag ; CS%Time => Time - CS%T => MIS%T ; CS%S => MIS%S ; CS%pbce => MIS%pbce + CS%T => MIS%T ; CS%S => MIS%S CS%u_accel_bt => MIS%u_accel_bt ; CS%v_accel_bt => MIS%v_accel_bt CS%u_prev => MIS%u_prev ; CS%v_prev => MIS%v_prev CS%u_av => MIS%u_av; if (.not.associated(MIS%u_av)) CS%u_av => MIS%u(:,:,:) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b3041f5afb..8d667503d7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -9,6 +9,8 @@ module MOM_diagnostics use MOM_coupler_types, only : coupler_type_send_data use MOM_density_integrals, only : int_density_dz use MOM_diag_mediator, only : post_data, get_diag_time_end +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, register_scalar_field use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr @@ -49,6 +51,7 @@ module MOM_diagnostics !> The control structure for the MOM_diagnostics module type, public :: diagnostics_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as !! monotonic for the purposes of calculating the equivalent !! barotropic wave speed. @@ -60,56 +63,12 @@ module MOM_diagnostics ! following arrays store diagnostics calculated here and unavailable outside. - ! following fields have nz+1 levels. - real, pointer, dimension(:,:,:) :: & - e => NULL(), & !< interface height [Z ~> m] - e_D => NULL() !< interface height above bottom [Z ~> m] - ! following fields have nz layers. - real, pointer, dimension(:,:,:) :: & - 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] - ! hf_du_dt => NULL(), hf_dv_dt => NULL() !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - - real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density - !! coordinates [H ~> m or kg m-2] - real, pointer, dimension(:,:,:) :: uh_Rlay => NULL() !< Zonal transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: vh_Rlay => NULL() !< Meridional transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: uhGM_Rlay => NULL() !< Zonal Gent-McWilliams transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: vhGM_Rlay => NULL() !< Meridional Gent-McWilliams transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] - - ! following fields are 2-D. - real, pointer, dimension(:,:) :: & - cg1 => NULL(), & !< First baroclinic gravity wave speed [L T-1 ~> m s-1] - Rd1 => NULL(), & !< First baroclinic deformation radius [L ~> m] - cfl_cg1 => NULL(), & !< CFL for first baroclinic gravity wave speed [nondim] - cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed [nondim] - cfl_cg1_y => NULL() !< j-component of CFL for first baroclinic gravity wave speed [nondim] - - ! The following arrays hold diagnostics in the layer-integrated energy budget. - real, pointer, dimension(:,:,:) :: & - KE => NULL(), & !< KE per unit mass [L2 T-2 ~> m2 s-2] - dKE_dt => NULL(), & !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] - PE_to_KE => NULL(), & !< potential energy to KE term [m3 s-3] - KE_BT => NULL(), & !< barotropic contribution to KE term [m3 s-3] - KE_CorAdv => NULL(), & !< KE source from the combined Coriolis and - !! advection terms [H L2 T-3 ~> m3 s-3]. - !! The Coriolis source should be zero, but is not due to truncation - !! errors. There should be near-cancellation of the global integral - !! of this spurious Coriolis source. - KE_adv => NULL(), & !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] - KE_visc => NULL(), & !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] - KE_stress => NULL(), & !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] - KE_horvisc => NULL(), & !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] - KE_dia => NULL() !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] + real, allocatable :: du_dt(:,:,:) !< net i-acceleration [L T-2 ~> m s-2] + real, allocatable :: dv_dt(:,:,:) !< net j-acceleration [L T-2 ~> m s-2] + real, allocatable :: dh_dt(:,:,:) !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] + + logical :: KE_term_on !< If true, at least one diagnostic term in the KE budget is in use. !>@{ Diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 @@ -148,8 +107,7 @@ module MOM_diagnostics integer :: id_drho_dT = -1, id_drho_dS = -1 integer :: id_h_pre_sync = -1 !>@} - !> The control structure for calculating wave speed. - type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() + type(wave_speed_CS) :: wave_speed !< Wave speed control struct type(p3d) :: var_ptr(MAX_FIELDS_) !< pointers to variables used in the calculation !! of time derivatives @@ -230,37 +188,44 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! previous call to diagnostics_init. ! Local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: usq ! squared eastward velocity [L2 T-2 ~> m2 s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vsq ! squared northward velocity [L2 T-2 ~> m2 s-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: uv ! u x v at h-points [L2 T-2 ~> m2 s-2] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, either relative to a reference + ! geopotential or the seafloor [Z ~> m]. real :: Rcv(SZI_(G),SZJ_(G),SZK_(GV)) ! Coordinate variable potential density [R ~> kg m-3]. - real :: work_3d(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary work array. + real :: work_3d(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary work array in various units + ! including [nondim] and [H ~> m or kg m-2]. + real :: uh_tmp(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary zonal transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vh_tmp(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary meridional transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] + real :: cg1(SZI_(G),SZJ_(G)) ! First baroclinic gravity wave speed [L T-1 ~> m s-1] + real :: Rd1(SZI_(G),SZJ_(G)) ! First baroclinic deformation radius [L ~> m] + real :: CFL_cg1(SZI_(G),SZJ_(G)) ! CFL for first baroclinic gravity wave speed, either based on the + ! overall grid spacing or just one direction [nondim] - real, allocatable, dimension(:,:) :: & - hf_du_dt_2d, hf_dv_dt_2d ! z integeral of hf_du_dt, hf_dv_dt [L T-2 ~> m s-2]. - - real, allocatable, dimension(:,:,:) :: h_du_dt ! h x dudt [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt ! h x dvdt [H L T-2 ~> m2 s-2] ! tmp array for surface properties - real :: surface_field(SZI_(G),SZJ_(G)) + real :: surface_field(SZI_(G),SZJ_(G)) ! The surface temperature or salinity [degC] or [ppt] real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] - real :: wt, wt_p - + real :: wt, wt_p ! The fractional weights of two successive values when interpolating from + ! a list [nondim], scaled so that wt + wt_p = 1. real :: f2_h ! Squared Coriolis parameter at to h-points [T-2 ~> s-2] real :: mag_beta ! Magnitude of the gradient of f [T-1 L-1 ~> s-1 m-1] real :: absurdly_small_freq2 ! Frequency squared used to avoid division by 0 [T-2 ~> s-2] integer :: k_list - real, dimension(SZK_(GV)) :: temp_layer_ave, salt_layer_ave - real :: thetaoga, soga, masso, tosga, sosga + real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [degC] + real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [degC] + real :: thetaoga ! The volume mean potential temperature [degC] + real :: soga ! The volume mean ocean salinity [ppt] + real :: masso ! The total mass of the ocean [kg] + real :: tosga ! The area mean sea surface temperature [degC] + real :: sosga ! The area mean sea surface salinity [ppt] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -272,6 +237,9 @@ 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.") + if (.not. CS%initialized) call MOM_error(FATAL, & + "calculate_diagnostic_fields: Module must be initialized before used.") + call calculate_derivs(dt, G, CS) if (dt > 0.0) then @@ -279,70 +247,32 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) if (CS%id_h_pre_sync > 0) & - call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h = diag_pre_sync%h_state) + call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_du_dt>0) call post_data(CS%id_du_dt, CS%du_dt, CS%diag, alt_h = diag_pre_sync%h_state) + if (CS%id_du_dt>0) call post_data(CS%id_du_dt, CS%du_dt, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_dv_dt>0) call post_data(CS%id_dv_dt, CS%dv_dt, CS%diag, alt_h = diag_pre_sync%h_state) + if (CS%id_dv_dt>0) call post_data(CS%id_dv_dt, CS%dv_dt, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_dh_dt>0) call post_data(CS%id_dh_dt, CS%dh_dt, CS%diag, alt_h = diag_pre_sync%h_state) + if (CS%id_dh_dt>0) call post_data(CS%id_dh_dt, CS%dh_dt, CS%diag, alt_h=diag_pre_sync%h_state) !! Diagnostics for terms multiplied by fractional thicknesses ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. + ! The code is retained for debugging purposes in the future. !if (CS%id_hf_du_dt > 0) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_du_dt(I,j,k) = CS%du_dt(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_du_dt, CS%hf_du_dt, CS%diag, alt_h = diag_pre_sync%h_state) - !endif - - !if (CS%id_hf_dv_dt > 0) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_dv_dt(i,J,k) = CS%dv_dt(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_dv_dt, CS%hf_dv_dt, CS%diag, alt_h = diag_pre_sync%h_state) - !endif - - if (CS%id_hf_du_dt_2d > 0) then - allocate(hf_du_dt_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_du_dt_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_du_dt_2d(I,j) = hf_du_dt_2d(I,j) + CS%du_dt(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_du_dt_2d, hf_du_dt_2d, CS%diag) - deallocate(hf_du_dt_2d) - endif + ! call post_product_u(CS%id_hf_du_dt, CS%du_dt, ADp%diag_hfrac_u, G, nz, CS%diag, alt_h=diag_pre_sync%h_state) + !if (CS%id_hf_dv_dt > 0) & + ! call post_product_v(CS%id_hf_dv_dt, CS%dv_dt, ADp%diag_hfrac_v, G, nz, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_hf_dv_dt_2d > 0) then - allocate(hf_dv_dt_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dv_dt_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dv_dt_2d(i,J) = hf_dv_dt_2d(i,J) + CS%dv_dt(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dv_dt_2d, hf_dv_dt_2d, CS%diag) - deallocate(hf_dv_dt_2d) - endif + if (CS%id_hf_du_dt_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_2d, CS%du_dt, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_2d, CS%dv_dt, ADp%diag_hfrac_v, G, nz, CS%diag) - if (CS%id_h_du_dt > 0) then - allocate(h_du_dt(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt(I,j,k) = CS%du_dt(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt, h_du_dt, CS%diag) - deallocate(h_du_dt) - endif - if (CS%id_h_dv_dt > 0) then - allocate(h_dv_dt(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt(i,J,k) = CS%dv_dt(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt, h_dv_dt, CS%diag) - deallocate(h_dv_dt) - endif + if (CS%id_h_du_dt > 0) & + call post_product_u(CS%id_h_du_dt, CS%du_dt, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt > 0) & + call post_product_v(CS%id_h_dv_dt, CS%dv_dt, ADp%diag_hv, G, nz, CS%diag) call diag_restore_grids(CS%diag) @@ -363,54 +293,44 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) - if (CS%id_usq > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - usq(I,j,k) = u(I,j,k) * u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_usq, usq, CS%diag) - endif + if (CS%id_usq > 0) call post_product_u(CS%id_usq, u, u, G, nz, CS%diag) - if (CS%id_vsq > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vsq(i,J,k) = v(i,J,k) * v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_vsq, vsq, CS%diag) - endif + if (CS%id_vsq > 0) call post_product_v(CS%id_vsq, v, v, G, nz, CS%diag) if (CS%id_uv > 0) then do k=1,nz ; do j=js,je ; do i=is,ie uv(i,j,k) = (0.5*(u(I-1,j,k) + u(I,j,k))) * & - (0.5*(v(i,J-1,k) + v(i,J,k))) + (0.5*(v(i,J-1,k) + v(i,J,k))) enddo ; enddo ; enddo call post_data(CS%id_uv, uv, CS%diag) endif - if (associated(CS%e)) then - call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) - if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) - endif - - if (associated(CS%e_D)) then - if (associated(CS%e)) then + ! Find the interface heights, relative either to a reference height or to the bottom [Z ~> m]. + if (CS%id_e > 0) then + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) + if (CS%id_e > 0) call post_data(CS%id_e, eta, CS%diag) + if (CS%id_e_D > 0) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) - enddo ; enddo ; enddo - else - call find_eta(h, tv, G, GV, US, CS%e_D) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) + eta(i,j,k) = eta(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo + call post_data(CS%id_e_D, eta, CS%diag) endif - - if (CS%id_e_D > 0) call post_data(CS%id_e_D, CS%e_D, CS%diag) + elseif (CS%id_e_D > 0) then + call find_eta(h, tv, G, GV, US, eta) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = eta(i,j,k) + G%bathyT(i,j) + enddo ; enddo ; enddo + call post_data(CS%id_e_D, eta, CS%diag) endif - ! mass per area of grid cell (for Bouss, use Rho0) + ! mass per area of grid cell (for Boussinesq, use Rho0) if (CS%id_masscello > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_kg_m2*h(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_masscello, work_3d, CS%diag) + !### If the registration call has conversion=GV%H_to_kg, the mathematically equivalent form would be: + ! call post_data(CS%id_masscello, h, CS%diag) endif ! mass of liquid ocean (for Bouss, use Rho0). The reproducing sum requires the use of MKS units. @@ -423,7 +343,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_masso, masso, CS%diag) endif - ! diagnose thickness/volumes of grid cells [m] + ! diagnose thickness/volumes of grid cells [Z ~> m] and [m3] if (CS%id_thkcello>0 .or. CS%id_volcello>0) then if (GV%Boussinesq) then ! thkcello = h for Boussinesq if (CS%id_thkcello > 0) then ; if (GV%H_to_Z == 1.0) then @@ -522,7 +442,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do j=js,je ; do i=is,ie surface_field(i,j) = tv%T(i,j,1) enddo ; enddo - tosga = global_area_mean(surface_field, G) + tosga = global_area_mean(tv%T(:,:,1), G) call post_data(CS%id_tosga, tosga, CS%diag) endif @@ -555,9 +475,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) - if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. associated(CS%h_Rlay) .or. & - associated(CS%uh_Rlay) .or. associated(CS%vh_Rlay) .or. & - associated(CS%uhGM_Rlay) .or. associated(CS%vhGM_Rlay)) then + if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. (CS%id_h_Rlay > 0) .or. & + (CS%id_uh_Rlay > 0) .or. (CS%id_vh_Rlay > 0) .or. & + (CS%id_uhGM_Rlay > 0) .or. (CS%id_vhGM_Rlay > 0)) then if (associated(tv%eqn_of_state)) then EOSdom(:) = EOS_domain(G%HI, halo=1) @@ -575,110 +495,112 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rcv, CS%diag) if (CS%id_Rcv > 0) call post_data(CS%id_Rcv, Rcv, CS%diag) - if (associated(CS%h_Rlay)) then + if (CS%id_h_Rlay > 0) then + ! Here work_3d is used for the layer thicknesses in potential density coordinates [H ~> m or kg m-2]. k_list = nz/2 -!$OMP parallel do default(none) shared(is,ie,js,je,nz,nkmb,CS,Rcv,h,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do i=is,ie - CS%h_Rlay(i,j,k) = 0.0 + work_3d(i,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%h_Rlay(i,j,k) = h(i,j,k) + work_3d(i,j,k) = h(i,j,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, Rcv(i,j,k), k_list, nz, wt, wt_p) - CS%h_Rlay(i,j,k_list) = CS%h_Rlay(i,j,k_list) + h(i,j,k)*wt - CS%h_Rlay(i,j,k_list+1) = CS%h_Rlay(i,j,k_list+1) + h(i,j,k)*wt_p + work_3d(i,j,k_list) = work_3d(i,j,k_list) + h(i,j,k)*wt + work_3d(i,j,k_list+1) = work_3d(i,j,k_list+1) + h(i,j,k)*wt_p enddo ; enddo enddo - if (CS%id_h_Rlay > 0) call post_data(CS%id_h_Rlay, CS%h_Rlay, CS%diag) + call post_data(CS%id_h_Rlay, work_3d, CS%diag) endif - if (associated(CS%uh_Rlay)) then + if (CS%id_uh_Rlay > 0) then + ! Calculate zonal transports in potential density coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CS,GV,uh) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = 0.0 + uh_tmp(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = uh(I,j,k) + uh_tmp(I,j,k) = uh(I,j,k) enddo ; enddo k_list = nz/2 do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + uh(I,j,k)*wt - CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + uh(I,j,k)*wt_p + uh_tmp(I,j,k_list) = uh_tmp(I,j,k_list) + uh(I,j,k)*wt + uh_tmp(I,j,k_list+1) = uh_tmp(I,j,k_list+1) + uh(I,j,k)*wt_p enddo ; enddo enddo - if (CS%id_uh_Rlay > 0) call post_data(CS%id_uh_Rlay, CS%uh_Rlay, CS%diag) + call post_data(CS%id_uh_Rlay, uh_tmp, CS%diag) endif - if (associated(CS%vh_Rlay)) then + if (CS%id_vh_Rlay > 0) then + ! Calculate meridional transports in potential density coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,nz,nkmb,Rcv,CS,GV,vh) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do J=Jsq,Jeq do k=1,nkmb ; do i=is,ie - CS%vh_Rlay(i,J,k) = 0.0 + vh_tmp(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vh_Rlay(i,J,k) = vh(i,J,k) + vh_tmp(i,J,k) = vh(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + vh(i,J,k)*wt - CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + vh(i,J,k)*wt_p + vh_tmp(i,J,k_list) = vh_tmp(i,J,k_list) + vh(i,J,k)*wt + vh_tmp(i,J,k_list+1) = vh_tmp(i,J,k_list+1) + vh(i,J,k)*wt_p enddo ; enddo enddo - if (CS%id_vh_Rlay > 0) call post_data(CS%id_vh_Rlay, CS%vh_Rlay, CS%diag) + call post_data(CS%id_vh_Rlay, vh_tmp, CS%diag) endif - if (associated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then + if ((CS%id_uhGM_Rlay > 0) .and. associated(CDp%uhGM)) then + ! Calculate zonal Gent-McWilliams transports in potential density + ! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CDP,CS,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do I=Isq,Ieq - CS%uhGM_Rlay(I,j,k) = 0.0 + uh_tmp(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uhGM_Rlay(I,j,k) = CDp%uhGM(I,j,k) + uh_tmp(I,j,k) = CDp%uhGM(I,j,k) enddo ; enddo do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uhGM_Rlay(I,j,k_list) = CS%uhGM_Rlay(I,j,k_list) + CDp%uhGM(I,j,k)*wt - CS%uhGM_Rlay(I,j,k_list+1) = CS%uhGM_Rlay(I,j,k_list+1) + CDp%uhGM(I,j,k)*wt_p + uh_tmp(I,j,k_list) = uh_tmp(I,j,k_list) + CDp%uhGM(I,j,k)*wt + uh_tmp(I,j,k_list+1) = uh_tmp(I,j,k_list+1) + CDp%uhGM(I,j,k)*wt_p enddo ; enddo enddo - if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) + if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, uh_tmp, CS%diag) endif - if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then + if ((CS%id_vhGM_Rlay > 0) .and. associated(CDp%vhGM)) then + ! Calculate meridional Gent-McWilliams transports in potential density + ! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(is,ie,Jsq,Jeq,nz,nkmb,CS,CDp,Rcv,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do J=Jsq,Jeq do k=1,nkmb ; do i=is,ie - CS%vhGM_Rlay(i,J,k) = 0.0 + vh_tmp(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vhGM_Rlay(i,J,k) = CDp%vhGM(i,J,k) + vh_tmp(i,J,k) = CDp%vhGM(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vhGM_Rlay(i,J,k_list) = CS%vhGM_Rlay(i,J,k_list) + CDp%vhGM(i,J,k)*wt - CS%vhGM_Rlay(i,J,k_list+1) = CS%vhGM_Rlay(i,J,k_list+1) + CDp%vhGM(i,J,k)*wt_p + vh_tmp(i,J,k_list) = vh_tmp(i,J,k_list) + CDp%vhGM(i,J,k)*wt + vh_tmp(i,J,k_list+1) = vh_tmp(i,J,k_list+1) + CDp%vhGM(i,J,k)*wt_p enddo ; enddo enddo - if (CS%id_vhGM_Rlay > 0) call post_data(CS%id_vhGM_Rlay, CS%vhGM_Rlay, CS%diag) + if (CS%id_vhGM_Rlay > 0) call post_data(CS%id_vhGM_Rlay, vh_tmp, CS%diag) endif endif @@ -735,8 +657,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0)) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) - if (CS%id_cg1>0) call post_data(CS%id_cg1, CS%cg1, CS%diag) + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed) + if (CS%id_cg1>0) call post_data(CS%id_cg1, cg1, CS%diag) if (CS%id_Rd1>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) do j=js,je ; do i=is,ie @@ -749,42 +671,44 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) )) - CS%Rd1(i,j) = CS%cg1(i,j) / sqrt(f2_h + CS%cg1(i,j) * mag_beta) + Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta) enddo ; enddo - call post_data(CS%id_Rd1, CS%Rd1, CS%diag) + call post_data(CS%id_Rd1, Rd1, CS%diag) endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CFL_cg1(i,j) = (dt*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) + call post_data(CS%id_cfl_cg1, CFL_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CFL_cg1(i,j) = (dt*cg1(i,j)) * G%IdxT(i,j) enddo ; enddo - call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) + call post_data(CS%id_cfl_cg1_x, CFL_cg1, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CFL_cg1(i,j) = (dt*cg1(i,j)) * G%IdyT(i,j) enddo ; enddo - call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) + call post_data(CS%id_cfl_cg1_y, CFL_cg1, CS%diag) endif endif if ((CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then if (CS%id_p_ebt>0) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + ! Here work_3d is used for the equivalent barotropic modal structure [nondim]. + work_3d(:,:,:) = 0.0 + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & - mono_N2_depth=CS%mono_N2_depth, modal_structure=CS%p_ebt) - call post_data(CS%id_p_ebt, CS%p_ebt, CS%diag) + mono_N2_depth=CS%mono_N2_depth, modal_structure=work_3d) + call post_data(CS%id_p_ebt, work_3d, CS%diag) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth) endif - if (CS%id_cg_ebt>0) call post_data(CS%id_cg_ebt, CS%cg1, CS%diag) + if (CS%id_cg_ebt>0) call post_data(CS%id_cg_ebt, cg1, CS%diag) if (CS%id_Rd_ebt>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) do j=js,je ; do i=is,ie @@ -797,10 +721,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) )) - CS%Rd1(i,j) = CS%cg1(i,j) / sqrt(f2_h + CS%cg1(i,j) * mag_beta) + Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta) enddo ; enddo - call post_data(CS%id_Rd_ebt, CS%Rd1, CS%diag) + call post_data(CS%id_Rd_ebt, Rd1, CS%diag) endif endif @@ -817,8 +741,8 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) integer, intent(inout) :: k !< The value of k such that Rlist(k) <= R_in < Rlist(k+1) !! The input value is a first guess integer, intent(in) :: nz !< The number of layers in Rlist - real, intent(out) :: wt !< The weight of layer k for interpolation, nondim - real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation, nondim + real, intent(out) :: wt !< The weight of layer k for interpolation [nondim] + real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation [nondim] ! This subroutine finds location of R_in in an increasing ordered ! list, Rlist, returning as k the element such that @@ -904,7 +828,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! at the ocean surface [R L2 T-2 ~> Pa]. dpress, & ! Change in hydrostatic pressure across a layer [R L2 T-2 ~> Pa]. tr_int ! vertical integral of a tracer times density, - ! (Rho_0 in a Boussinesq model) [TR kg m-2]. + ! (Rho_0 in a Boussinesq model) [Conc R Z ~> Conc kg m-2]. real :: IG_Earth ! Inverse of gravitational acceleration [T2 Z L-2 ~> s2 m-1]. integer :: i, j, k, is, ie, js, je, nz @@ -1015,41 +939,39 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to !! diagnostics_init. -! This subroutine calculates terms in the mechanical energy budget. - ! Local variables - real :: KE_u(SZIB_(G),SZJ_(G)) - real :: KE_v(SZI_(G),SZJB_(G)) - real :: KE_h(SZI_(G),SZJ_(G)) + real :: KE(SZI_(G),SZJ_(G),SZK_(GV)) ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real :: KE_term(SZI_(G),SZJ_(G),SZK_(GV)) ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real :: KE_u(SZIB_(G),SZJ_(G)) ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_v(SZI_(G),SZJB_(G)) ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_h(SZI_(G),SZJ_(G)) ! A KE term contribution at tracer points + ! [H L2 T-3 ~> m3 s-3 or W m-2] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + if (.not.(CS%KE_term_on .or. (CS%id_KE > 0))) return + do j=js-1,je ; do i=is-1,ie KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 enddo ; enddo - if (associated(CS%KE)) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & - + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 - ! DELETE THE FOLLOWING... Make this 0 to test the momentum balance, - ! or a huge number to test the continuity balance. - ! CS%KE(i,j,k) *= 1e20 - enddo ; enddo ; enddo - if (CS%id_KE > 0) call post_data(CS%id_KE, CS%KE, CS%diag) - endif + do k=1,nz ; do j=js,je ; do i=is,ie + KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & + + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 + enddo ; enddo ; enddo + if (CS%id_KE > 0) call post_data(CS%id_KE, KE, CS%diag) - if (.not.G%symmetric) then - if (associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_BT) .OR. & - associated(CS%KE_CorAdv) .OR. associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. & - associated(CS%KE_horvisc) .OR. associated(CS%KE_dia) ) then - call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) - endif + if (CS%KE_term_on .and. .not.G%symmetric) then + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif - if (associated(CS%dKE_dt)) then + if (CS%id_dKEdt > 0) then + ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k) @@ -1058,19 +980,20 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k) * CS%dh_dt(i,j,k) + KE_h(i,j) = KE(i,j,k) * CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%dKE_dt(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_dKEdt > 0) call post_data(CS%id_dKEdt, CS%dKE_dt, CS%diag) + call post_data(CS%id_dKEdt, KE_term, CS%diag) endif - if (associated(CS%PE_to_KE)) then + if (CS%id_PE_to_KE > 0) then + ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%PFu(I,j,k) @@ -1081,14 +1004,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, CS%PE_to_KE, CS%diag) + if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, KE_term, CS%diag) endif - if (associated(CS%KE_BT)) then + if (CS%id_KE_BT > 0) then + ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%u_accel_bt(I,j,k) @@ -1099,14 +1023,17 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_BT(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_BT > 0) call post_data(CS%id_KE_BT, CS%KE_BT, CS%diag) + call post_data(CS%id_KE_BT, KE_term, CS%diag) endif - if (associated(CS%KE_CorAdv)) then + if (CS%id_KE_Coradv > 0) then + ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3]. + ! The Coriolis source should be zero, but is not due to truncation errors. There should be + ! near-cancellation of the global integral of this spurious Coriolis source. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%CAu(I,j,k) @@ -1115,21 +1042,22 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) & + KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) & * (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_CorAdv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_Coradv > 0) call post_data(CS%id_KE_Coradv, CS%KE_Coradv, CS%diag) + call post_data(CS%id_KE_Coradv, KE_term, CS%diag) endif - if (associated(CS%KE_adv)) then - ! NOTE: All terms in KE_adv are multipled by -1, which can easily produce + if (CS%id_KE_adv > 0) then + ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3]. + ! NOTE: All terms in KE_adv are multiplied by -1, which can easily produce ! negative zeros and may signal a reproducibility issue over land. ! We resolve this by re-initializing and only evaluating over water points. KE_u(:,:) = 0. ; KE_v(:,:) = 0. @@ -1143,20 +1071,21 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%gradKEv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) & + KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) & * (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_adv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_adv > 0) call post_data(CS%id_KE_adv, CS%KE_adv, CS%diag) + call post_data(CS%id_KE_adv, KE_term, CS%diag) endif - if (associated(CS%KE_visc)) then + if (CS%id_KE_visc > 0) then + ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc(I,j,k) @@ -1167,14 +1096,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) + call post_data(CS%id_KE_visc, KE_term, CS%diag) endif - if (associated(CS%KE_stress)) then + if (CS%id_KE_stress > 0) then + ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_str(I,j,k) @@ -1185,14 +1115,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_stress(i,j,k) = 0.5 * G%IareaT(i,j) * & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) * & ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo - if (CS%id_KE_stress > 0) call post_data(CS%id_KE_stress, CS%KE_stress, CS%diag) + call post_data(CS%id_KE_stress, KE_term, CS%diag) endif - if (associated(CS%KE_horvisc)) then + if (CS%id_KE_horvisc > 0) then + ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%diffu(I,j,k) @@ -1203,14 +1134,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_horvisc > 0) call post_data(CS%id_KE_horvisc, CS%KE_horvisc, CS%diag) + call post_data(CS%id_KE_horvisc, KE_term, CS%diag) endif - if (associated(CS%KE_dia)) then + if (CS%id_KE_dia > 0) then + ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_dia(I,j,k) @@ -1219,16 +1151,16 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) + KE_h(i,j) = KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_dia(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_dia > 0) call post_data(CS%id_KE_dia, CS%KE_dia, CS%diag) + call post_data(CS%id_KE_dia, KE_term, CS%diag) endif end subroutine calculate_energy_diagnostics @@ -1240,7 +1172,7 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) !< Time derivative operand real, dimension(lb(1):,lb(2):,:), target :: deriv_ptr !< Time derivative of f_ptr - type(diagnostics_CS), pointer :: CS !< Control structure returned by previous call to + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine registers fields to calculate a diagnostic time derivative. @@ -1250,7 +1182,7 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) integer :: m !< New index of deriv_ptr in CS%deriv integer :: ub(3) !< Upper index bound of f_ptr, based on shape. - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "register_time_deriv: Module must be initialized before it is used.") if (CS%num_time_deriv >= MAX_FIELDS_) then @@ -1313,7 +1245,8 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: speed ! The surface speed [L T-1 ~> m s-1] @@ -1353,23 +1286,25 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv 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)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections - !! for ice displacement and the inverse barometer [m] + !! for ice displacement and the inverse barometer [Z ~> m] real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [m] real :: I_time_int ! The inverse of the time interval [T-1 ~> s-1]. - real :: zos_area_mean, volo, ssh_ga + real :: zos_area_mean ! Global area mean sea surface height [m] + real :: volo ! Total volume of the ocean [m3] + real :: ssh_ga ! Global ocean area weighted mean sea seaface height [m] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ! area mean SSH if (IDs%id_ssh_ga > 0) then - ssh_ga = global_area_mean(ssh, G) + ssh_ga = global_area_mean(ssh, G, scale=US%Z_to_m) call post_data(IDs%id_ssh_ga, ssh_ga, diag) endif @@ -1379,7 +1314,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv if (IDs%id_zos > 0 .or. IDs%id_zossq > 0) then zos(:,:) = 0.0 do j=js,je ; do i=is,ie - zos(i,j) = ssh_ibc(i,j) + zos(i,j) = US%Z_to_m*ssh_ibc(i,j) enddo ; enddo zos_area_mean = global_area_mean(zos, G) do j=js,je ; do i=is,ie @@ -1397,9 +1332,9 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + US%Z_to_m*G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j) * (ssh(i,j) + G%bathyT(i,j)) enddo ; enddo - volo = global_area_integral(work_2d, G) + volo = global_area_integral(work_2d, G, scale=US%Z_to_m) call post_data(IDs%id_volo, volo, diag) endif @@ -1509,9 +1444,9 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tend ! Change in layer thickness due to dynamics - ! [H s-1 ~> m s-1 or kg m-2 s-1]. + ! [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [T-1 ~> s-1] - real :: H_to_RZ_dt ! A conversion factor from accumulated transports to fluxes + real :: H_to_RZ_dt ! A conversion factor from accumulated transports to fluxes ! [R Z H-1 T-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 = GV%ke @@ -1571,7 +1506,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy end subroutine post_transport_diagnostics !> This subroutine registers various diagnostics and allocates space for fields -!! that other diagnostis depend upon. +!! that other diagnostics depend upon. subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag, CS, tv) type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to !! the fields and accelerations that make up the @@ -1587,43 +1522,31 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. - type(diagnostics_CS), pointer :: CS !< Pointer set to point to control structure - !! for this module. + type(diagnostics_CS), intent(inout) :: CS !< Diagnostic control struct type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. ! Local variables - real :: omega, f2_min, convert_H - ! This include declares and sets the variable "version". -# include "version_variable.h" - character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. - character(len=48) :: thickness_units, flux_units real :: wave_speed_min ! A floor in the first mode speed below which 0 is returned [L T-1 ~> m s-1] real :: wave_speed_tol ! The fractional tolerance for finding the wave speeds [nondim] + real :: convert_H ! A conversion factor from internal thickness units to the appropriate + ! MKS units (m or kg m-2) for thicknesses depending on whether the + ! Boussinesq approximation is being made [m H-1 or kg m-2 H-1 ~> 1] logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. logical :: split ! True if using the barotropic-baroclinic split algorithm + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. + character(len=48) :: thickness_units, flux_units logical :: use_temperature, adiabatic logical :: default_2018_answers, remap_answers_2018 - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nkml, nkbl - integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "MOM_diagnostics_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) + CS%initialized = .true. CS%diag => diag use_temperature = associated(tv%T) - call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & - do_not_log=.true.) + call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., do_not_log=.true.) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1644,7 +1567,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& - "starting point for iterations.", default=.false.) !### Change the default. + "starting point for iterations.", default=.true.) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) @@ -1661,7 +1584,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL,& - Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & + Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & !### , conversion=GV%H_to_kg_m2, & standard_name='sea_water_mass_per_unit_area', v_extensive=.true.) CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & @@ -1738,11 +1661,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & 'Interface Height Relative to Mean Sea Level', 'm', conversion=US%Z_to_m) - if (CS%id_e>0) call safe_alloc_ptr(CS%e,isd,ied,jsd,jed,nz+1) - CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & 'Interface Height above the Seafloor', 'm', conversion=US%Z_to_m) - 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', conversion=US%R_to_kg_m3) @@ -1763,115 +1683,54 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) - if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then - call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) - call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) - endif !CS%id_hf_du_dt = register_diag_field('ocean_model', 'hf_dudt', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2, & ! v_extensive=.true.) - !if (CS%id_hf_du_dt > 0) then - ! call safe_alloc_ptr(CS%hf_du_dt,IsdB,IedB,jsd,jed,nz) - ! if (.not.associated(CS%du_dt)) then - ! call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) - ! call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - ! endif - ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif !CS%id_hf_dv_dt = register_diag_field('ocean_model', 'hf_dvdt', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2, & ! v_extensive=.true.) - !if (CS%id_hf_dv_dt > 0) then - ! call safe_alloc_ptr(CS%hf_dv_dt,isd,ied,JsdB,JedB,nz) - ! if (.not.associated(CS%dv_dt)) then - ! call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) - ! call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - ! endif - ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif CS%id_hf_du_dt_2d = register_diag_field('ocean_model', 'hf_dudt_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_du_dt_2d > 0) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif CS%id_hf_dv_dt_2d = register_diag_field('ocean_model', 'hf_dvdt_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_dv_dt_2d > 0) then - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif CS%id_h_du_dt = register_diag_field('ocean_model', 'h_du_dt', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_du_dt > 0) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_dv_dt = register_diag_field('ocean_model', 'h_dv_dt', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_dv_dt > 0) then - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) - endif ! layer thickness variables !if (GV%nk_rho_varies > 0) then CS%id_h_Rlay = register_diag_field('ocean_model', 'h_rho', diag%axesTL, Time, & 'Layer thicknesses in pure potential density coordinates', & thickness_units, conversion=convert_H) - if (CS%id_h_Rlay>0) call safe_alloc_ptr(CS%h_Rlay,isd,ied,jsd,jed,nz) CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uh_Rlay>0) call safe_alloc_ptr(CS%uh_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vh_Rlay>0) call safe_alloc_ptr(CS%vh_Rlay,isd,ied,JsdB,JedB,nz) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & 'Zonal volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uhGM_Rlay>0) call safe_alloc_ptr(CS%uhGM_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & 'Meridional volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vhGM_Rlay>0) call safe_alloc_ptr(CS%vhGM_Rlay,isd,ied,JsdB,JedB,nz) !endif @@ -1879,55 +1738,36 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE = register_diag_field('ocean_model', 'KE', diag%axesTL, Time, & 'Layer kinetic energy per unit mass', & 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (CS%id_KE>0) call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) - CS%id_dKEdt = register_diag_field('ocean_model', 'dKE_dt', diag%axesTL, Time, & 'Kinetic Energy Tendency of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_dKEdt>0) call safe_alloc_ptr(CS%dKE_dt,isd,ied,jsd,jed,nz) - CS%id_PE_to_KE = register_diag_field('ocean_model', 'PE_to_KE', diag%axesTL, Time, & 'Potential to Kinetic Energy Conversion of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_PE_to_KE>0) call safe_alloc_ptr(CS%PE_to_KE,isd,ied,jsd,jed,nz) - if (split) then CS%id_KE_BT = register_diag_field('ocean_model', 'KE_BT', diag%axesTL, Time, & 'Barotropic contribution to Kinetic Energy', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_BT>0) call safe_alloc_ptr(CS%KE_BT,isd,ied,jsd,jed,nz) endif - CS%id_KE_Coradv = register_diag_field('ocean_model', 'KE_Coradv', diag%axesTL, Time, & 'Kinetic Energy Source from Coriolis and Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_Coradv>0) call safe_alloc_ptr(CS%KE_Coradv,isd,ied,jsd,jed,nz) - CS%id_KE_adv = register_diag_field('ocean_model', 'KE_adv', diag%axesTL, Time, & 'Kinetic Energy Source from Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_adv>0) call safe_alloc_ptr(CS%KE_adv,isd,ied,jsd,jed,nz) - CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_visc>0) call safe_alloc_ptr(CS%KE_visc,isd,ied,jsd,jed,nz) - CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_stress>0) call safe_alloc_ptr(CS%KE_stress,isd,ied,jsd,jed,nz) - CS%id_KE_horvisc = register_diag_field('ocean_model', 'KE_horvisc', diag%axesTL, Time, & 'Kinetic Energy Source from Horizontal Viscosity', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_horvisc>0) call safe_alloc_ptr(CS%KE_horvisc,isd,ied,jsd,jed,nz) - if (.not. adiabatic) then CS%id_KE_dia = register_diag_field('ocean_model', 'KE_dia', diag%axesTL, Time, & 'Kinetic Energy Source from Diapycnal Diffusion', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_dia>0) call safe_alloc_ptr(CS%KE_dia,isd,ied,jsd,jed,nz) endif ! gravity wave CFLs @@ -1951,17 +1791,9 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0) .or. & (CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then - call wave_speed_init(CS%wave_speed_CSp, remap_answers_2018=remap_answers_2018, & + call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) -!### call wave_speed_init(CS%wave_speed_CSp, remap_answers_2018=remap_answers_2018) - call safe_alloc_ptr(CS%cg1,isd,ied,jsd,jed) - if (CS%id_Rd1>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) - if (CS%id_Rd_ebt>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) - if (CS%id_cfl_cg1>0) call safe_alloc_ptr(CS%cfl_cg1,isd,ied,jsd,jed) - if (CS%id_cfl_cg1_x>0) call safe_alloc_ptr(CS%cfl_cg1_x,isd,ied,jsd,jed) - if (CS%id_cfl_cg1_y>0) call safe_alloc_ptr(CS%cfl_cg1_y,isd,ied,jsd,jed) - if (CS%id_p_ebt>0) call safe_alloc_ptr(CS%p_ebt,isd,ied,jsd,jed,nz) endif CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & @@ -1990,6 +1822,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag long_name='Sea Water Pressure at Sea Floor', standard_name='sea_water_pressure_at_sea_floor', & units='Pa', conversion=US%RL2_T2_to_Pa) + ! Register time derivatives and allocate memory for diagnostics that need + ! access from across several modules. call set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) end subroutine MOM_diagnostics_init @@ -2015,7 +1849,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) standard_name='square_of_sea_surface_height_above_geoid', & long_name='Square of sea surface height above geoid', units='m2') IDs%id_ssh = register_diag_field('ocean_model', 'SSH', diag%axesT1, Time, & - 'Sea Surface Height', 'm') + 'Sea Surface Height', 'm', conversion=US%Z_to_m) IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag,& long_name='Area averaged sea surface height', units='m', & standard_name='area_averaged_sea_surface_height') @@ -2312,57 +2146,69 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) !! equation. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(diagnostics_CS), pointer :: CS !< Pointer to the control structure for this + type(diagnostics_CS), intent(inout) :: CS !< Pointer to the control structure for this !! module. -! This subroutine sets up diagnostics upon which other diagnostics depend. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS%dKE_dt) .or. associated(CS%PE_to_KE) .or. & - associated(CS%KE_BT) .or. associated(CS%KE_CorAdv) .or. & - associated(CS%KE_adv) .or. associated(CS%KE_visc) .or. associated(CS%KE_stress) .or. & - associated(CS%KE_horvisc) .or. associated(CS%KE_dia)) & - call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) - - if (associated(CS%dKE_dt)) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - if (.not.associated(CS%dh_dt)) then - call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) - call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) - endif + ! Allocate and register time derivatives. + if ( ( (CS%id_du_dt>0) .or. (CS%id_dKEdt > 0) .or. & + ! (CS%id_hf_du_dt > 0) .or. & + (CS%id_h_du_dt > 0) .or. (CS%id_hf_du_dt_2d > 0) ) .and. & + (.not. allocated(CS%du_dt)) ) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) + call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) + endif + if ( ( (CS%id_dv_dt>0) .or. (CS%id_dKEdt > 0) .or. & + ! (CS%id_hf_dv_dt > 0) .or. & + (CS%id_h_dv_dt > 0) .or. (CS%id_hf_dv_dt_2d > 0) ) .and. & + (.not. allocated(CS%dv_dt)) ) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) + call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) + endif + if ( ( (CS%id_dh_dt>0) .or. (CS%id_dKEdt > 0) ) .and. & + (.not. allocated(CS%dh_dt)) ) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) + call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif - if (associated(CS%KE_adv)) then + ! Allocate memory for other dependent diagnostics. + if (CS%id_KE_adv > 0) then call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_visc)) then + if (CS%id_KE_visc > 0) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_stress)) then + if (CS%id_KE_stress > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_dia)) then + if (CS%id_KE_dia > 0) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) endif - if (associated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) - if (associated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) + CS%KE_term_on = ((CS%id_dKEdt > 0) .or. (CS%id_PE_to_KE > 0) .or. (CS%id_KE_BT > 0) .or. & + (CS%id_KE_Coradv > 0) .or. (CS%id_KE_adv > 0) .or. (CS%id_KE_visc > 0) .or. & + (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. (CS%id_KE_dia > 0)) + + if (CS%id_h_du_dt > 0) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) + + if (CS%id_hf_du_dt_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) + if (CS%id_hf_dv_dt_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) + ! if (CS%id_hf_du_dt > 0) call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) + ! if (CS%id_hf_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) + + if (CS%id_uhGM_Rlay > 0) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) + if (CS%id_vhGM_Rlay > 0) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) end subroutine set_dependent_diagnostics @@ -2376,26 +2222,9 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) !! equation. integer :: m - if (associated(CS%e)) deallocate(CS%e) - if (associated(CS%e_D)) deallocate(CS%e_D) - if (associated(CS%KE)) deallocate(CS%KE) - if (associated(CS%dKE_dt)) deallocate(CS%dKE_dt) - if (associated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) - if (associated(CS%KE_BT)) deallocate(CS%KE_BT) - if (associated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) - if (associated(CS%KE_adv)) deallocate(CS%KE_adv) - if (associated(CS%KE_visc)) deallocate(CS%KE_visc) - if (associated(CS%KE_stress)) deallocate(CS%KE_stress) - if (associated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) - if (associated(CS%KE_dia)) deallocate(CS%KE_dia) - if (associated(CS%dv_dt)) deallocate(CS%dv_dt) - if (associated(CS%dh_dt)) deallocate(CS%dh_dt) - if (associated(CS%du_dt)) deallocate(CS%du_dt) - if (associated(CS%h_Rlay)) deallocate(CS%h_Rlay) - if (associated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) - if (associated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) - if (associated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) - if (associated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) + if (allocated(CS%dh_dt)) deallocate(CS%dh_dt) + if (allocated(CS%dv_dt)) deallocate(CS%dv_dt) + if (allocated(CS%du_dt)) deallocate(CS%du_dt) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 80708df97b..dfadaa1da5 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -68,7 +68,6 @@ subroutine find_obsolete_params(param_file) hint="Use NUM_DIAG_COORDS, DIAG_COORDS and DIAG_COORD_DEF_Z") call obsolete_real(param_file, "VSTAR_SCALE_FACTOR", hint="Use EPBL_VEL_SCALE_FACTOR instead.") - call obsolete_logical(param_file, "ORIG_MLD_ITERATION", .false.) call obsolete_real(param_file, "VSTAR_SCALE_COEF") call obsolete_real(param_file, "ZSTAR_RIGID_SURFACE_THRESHOLD") @@ -81,6 +80,7 @@ subroutine find_obsolete_params(param_file) "find_obsolete_params: #define DYNAMIC_SURFACE_PRESSURE is not yet "//& "implemented without #define SPLIT.") + call obsolete_real(param_file, "ETA_TOLERANCE_AUX", only_warn=.true.) call obsolete_real(param_file, "BT_MASS_SOURCE_LIMIT", 0.0) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") @@ -88,6 +88,8 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) + call obsolete_logical(param_file, "ALLOW_CLOCKS_IN_OMP_LOOPS", .true.) + call obsolete_logical(param_file, "LARGE_FILE_SUPPORT", .true.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") @@ -173,21 +175,25 @@ subroutine obsolete_char(param_file, varname, warning_val, hint) end subroutine obsolete_char !> Test for presence of obsolete REAL in parameter file. -subroutine obsolete_real(param_file, varname, warning_val, hint) +subroutine obsolete_real(param_file, varname, warning_val, hint, only_warn) type(param_file_type), intent(in) :: param_file !< Structure containing parameter file data. character(len=*), intent(in) :: varname !< Name of obsolete REAL parameter. real, optional, intent(in) :: warning_val !< An allowed value that causes a warning instead of an error. character(len=*), optional, intent(in) :: hint !< A hint to the user about what to do. + logical, optional, intent(in) :: only_warn !< If present and true, issue warnings instead of fatal errors. + ! Local variables real :: test_val, warn_val + logical :: issue_warning character(len=128) :: hint_msg test_val = -9e35; call read_param(param_file, varname, test_val) warn_val = -9e35; if (present(warning_val)) warn_val = warning_val hint_msg = " " ; if (present(hint)) hint_msg = hint + issue_warning = .false. ; if (present(only_warn)) issue_warning = only_warn if (test_val /= -9e35) then - if (test_val == warn_val) then + if ((test_val == warn_val) .or. issue_warning) then call MOM_ERROR(WARNING, "MOM_obsolete_params: "//trim(varname)// & " is an obsolete run-time flag. "//trim(hint_msg)) else diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index ffbdc5f810..7969ee11f8 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -17,7 +17,7 @@ module MOM_spatial_means #include public :: global_i_mean, global_j_mean -public :: global_area_mean, global_layer_mean +public :: global_area_mean, global_area_mean_u, global_area_mean_v, global_layer_mean public :: global_area_integral public :: global_volume_mean, global_mass_integral public :: adjust_area_mean_to_zero @@ -47,6 +47,50 @@ function global_area_mean(var, G, scale) end function global_area_mean +!> Return the global area mean of a variable. This uses reproducing sums. +function global_area_mean_v(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(in) :: var !< The variable to average + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: global_area_mean_v + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + tmpForSumming(:,:) = 0. + do J=js,je ; do i=is,ie + tmpForSumming(i,j) = G%areaT(i,j) * (var(i,J) * G%mask2dCv(i,J) + & + var(i,J-1) * G%mask2dCv(i,J-1)) & + / max(1.e-20,G%mask2dCv(i,J)+G%mask2dCv(i,J-1)) + enddo ; enddo + global_area_mean_v = reproducing_sum(tmpForSumming) * G%IareaT_global + +end function global_area_mean_v + +!> Return the global area mean of a variable on U grid. This uses reproducing sums. +function global_area_mean_u(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZIB_(G), SZJ_(G)), intent(in) :: var !< The variable to average + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: global_area_mean_u + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + tmpForSumming(:,:) = 0. + do j=js,je ; do i=is,ie + tmpForSumming(i,j) = G%areaT(i,j) * (var(I,j) * G%mask2dCu(I,j) + & + var(I-1,j) * G%mask2dCu(I-1,j)) & + / max(1.e-20,G%mask2dCu(I,j)+G%mask2dCu(I-1,j)) + enddo ; enddo + global_area_mean_u = reproducing_sum(tmpForSumming) * G%IareaT_global + +end function global_area_mean_u + !> Return the global area integral of a variable, by default using the masked area from the !! grid, but an alternate could be used instead. This uses reproducing sums. function global_area_integral(var, G, scale, area) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d190cee7a3..668c297658 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -18,8 +18,6 @@ module MOM_sum_output use MOM_io, only : axis_info, set_axis_info, delete_axis_info, get_filename_appendix use MOM_io, only : attribute_info, set_attribute_info, delete_attribute_info use MOM_io, only : APPEND_FILE, SINGLE_FILE, WRITEONLY_FILE -use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type -use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_time_manager, only : time_type, get_time, get_date, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=), operator(<) @@ -56,11 +54,13 @@ module MOM_sum_output integer :: listsize !< length of the list <= niglobal*njglobal + 1 real, allocatable, dimension(:) :: depth !< A list of depths [Z ~> m] real, allocatable, dimension(:) :: area !< The cross-sectional area of the ocean at that depth [L2 ~> m2] - real, allocatable, dimension(:) :: vol_below !< The ocean volume below that depth [Z m2 ~> m3] + real, allocatable, dimension(:) :: vol_below !< The ocean volume below that depth [Z L2 ~> m3] end type Depth_List !> The control structure for the MOM_sum_output module type, public :: sum_output_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. + type(Depth_List) :: DL !< The sorted depth list. integer, allocatable, dimension(:) :: lH @@ -147,11 +147,10 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. ! Local variables - real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS. - real :: Rho_0 ! A reference density [kg m-3] + real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS [s] real :: maxvel ! The maximum permitted velocity [m s-1] -! 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_sum_output" ! This module's name. character(len=200) :: energyfile ! The name of the energy file. character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs @@ -162,6 +161,8 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & endif allocate(CS) + CS%initialized = .true. + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "CALCULATE_APE", CS%do_APE_calc, & @@ -297,7 +298,7 @@ end subroutine MOM_sum_output_end !> This subroutine calculates and writes the total model energy, the energy and !! mass of each layer, and other globally integrated physical quantities. -subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_forcing) +subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_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. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -314,11 +315,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ !! current execution. type(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. - type(tracer_flow_control_CS), & - optional, pointer :: tracer_CSp !< tracer control structure. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. + type(tracer_flow_control_CS), pointer :: tracer_CSp !< Control structure with the tree of + !! all registered tracer packages type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step + ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The height of interfaces [Z ~> m]. real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT [L2 ~> m2]. @@ -380,11 +380,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ mass_anom_EFP ! The change in fresh water that cannot be accounted for by the surface ! fluxes [kg]. type(EFP_type), dimension(5) :: EFP_list ! An array of EFP types for joint global sums. - real :: CFL_Iarea ! Direction-based inverse area used in CFL test [L-2]. + real :: CFL_Iarea ! Direction-based inverse area used in CFL test [L-2 ~> m-2]. real :: CFL_trans ! A transport-based definition of the CFL number [nondim]. real :: CFL_lin ! A simpler definition of the CFL number [nondim]. real :: max_CFL(2) ! The maxima of the CFL numbers [nondim]. - real :: Irho0 ! The inverse of the reference density [m3 kg-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & tmp1 ! A temporary array real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -393,9 +392,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: HL2_to_kg ! A conversion factor from a thickness-volume to mass [kg H-1 L-2 ~> kg m-3 or 1] real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy - ! calculation [kg T2 H-1 L-2 s-2 ~> kg m-3 or nondim] + ! calculation [kg T2 H-1 L-2 s-2 ~> kg m-3 or 1] real :: PE_scale_factor ! The combination of unit rescaling factors in the potential energy - ! calculation [kg T2 R-1 Z-1 L-2 s-2 ~> nondim] + ! calculation [kg T2 R-1 Z-1 L-2 s-2 ~> 1] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq, isr, ier, jsr, jer @@ -409,17 +408,22 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ character(len=32) :: mesg_intro, time_units, day_str, n_str, date_str logical :: date_stamped type(time_type) :: dt_force ! A time_type version of the forcing timestep. - real :: Tr_stocks(MAX_FIELDS_) - real :: Tr_min(MAX_FIELDS_), Tr_max(MAX_FIELDS_) - real :: Tr_min_x(MAX_FIELDS_), Tr_min_y(MAX_FIELDS_), Tr_min_z(MAX_FIELDS_) - real :: Tr_max_x(MAX_FIELDS_), Tr_max_y(MAX_FIELDS_), Tr_max_z(MAX_FIELDS_) - logical :: Tr_minmax_got(MAX_FIELDS_) = .false. + real :: Tr_stocks(MAX_FIELDS_) ! The total amounts of each of the registered tracers + real :: Tr_min(MAX_FIELDS_) ! The global minimum unmasked value of the tracers + real :: Tr_max(MAX_FIELDS_) ! The global maximum unmasked value of the tracers + real :: Tr_min_x(MAX_FIELDS_) ! The x-positions of the global tracer minima + real :: Tr_min_y(MAX_FIELDS_) ! The y-positions of the global tracer minima + real :: Tr_min_z(MAX_FIELDS_) ! The z-positions of the global tracer minima + real :: Tr_max_x(MAX_FIELDS_) ! The x-positions of the global tracer maxima + real :: Tr_max_y(MAX_FIELDS_) ! The y-positions of the global tracer maxima + real :: Tr_max_z(MAX_FIELDS_) ! The z-positions of the global tracer maxima + logical :: Tr_minmax_avail(MAX_FIELDS_) ! A flag indicating whether the global minimum and + ! maximum information are available for each of the tracers character(len=40), dimension(MAX_FIELDS_) :: & - Tr_names, Tr_units - integer :: nTr_stocks + Tr_names, & ! The short names for each of the tracers + Tr_units ! The units for each of the tracers + integer :: nTr_stocks ! The total number of tracers in all registered tracer packages integer :: iyear, imonth, iday, ihour, iminute, isecond, itick ! For call to get_date() - logical :: local_open_BC - type(OBC_segment_type), pointer :: segment => NULL() ! A description for output of each of the fields. type(vardesc) :: vars(NUM_FIELDS+MAX_FIELDS_) @@ -479,21 +483,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ vars(17) = var_desc("Heat_anom","Joules","Anomalous Total Heat Change",'1','1') endif - local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then - local_open_BC = (OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) - endif ; endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isr = is - (G%isd-1) ; ier = ie - (G%isd-1) ; jsr = js - (G%jsd-1) ; jer = je - (G%jsd-1) - HL2_to_kg = GV%H_to_kg_m2*US%L_to_m**2 if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "write_energy: Module must be initialized before it is used.") + do j=js,je ; do i=is,ie areaTm(i,j) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo @@ -504,34 +505,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ tmp1(i,j,k) = h(i,j,k) * (HL2_to_kg*areaTm(i,j)) enddo ; enddo ; enddo - ! This block avoids using the points beyond an open boundary condition - ! in the accumulation of mass, but perhaps it would be unnecessary if there - ! were a more judicious use of masks in the loops 4 or 7 lines above. - if (local_open_BC) then - do ns=1, OBC%number_of_segments - segment => OBC%segment(ns) - if (.not. segment%on_pe .or. segment%specified) cycle - I=segment%HI%IsdB ; J=segment%HI%JsdB - if (segment%direction == OBC_DIRECTION_E) then - do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed - tmp1(i+1,j,k) = 0.0 - enddo ; enddo - elseif (segment%direction == OBC_DIRECTION_W) then - do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed - tmp1(i,j,k) = 0.0 - enddo ; enddo - elseif (segment%direction == OBC_DIRECTION_N) then - do k=1,nz ; do i=segment%HI%isd,segment%HI%ied - tmp1(i,j+1,k) = 0.0 - enddo ; enddo - elseif (segment%direction == OBC_DIRECTION_S) then - do k=1,nz ; do i=segment%HI%isd,segment%HI%ied - tmp1(i,j,k) = 0.0 - enddo ; enddo - endif - enddo - endif - mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) do k=1,nz ; vol_lay(k) = (US%m_to_L**2*GV%H_to_Z/GV%H_to_kg_m2)*mass_lay(k) ; enddo else @@ -558,19 +531,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Boussinesq nTr_stocks = 0 - if (present(tracer_CSp)) then - call call_tracer_stocks(h, Tr_stocks, G, GV, tracer_CSp, stock_names=Tr_names, & - stock_units=Tr_units, num_stocks=nTr_stocks,& - got_min_max=Tr_minmax_got, global_min=Tr_min, global_max=Tr_max, & - xgmin=Tr_min_x, ygmin=Tr_min_y, zgmin=Tr_min_z,& - xgmax=Tr_max_x, ygmax=Tr_max_y, zgmax=Tr_max_z) - if (nTr_stocks > 0) then - do m=1,nTr_stocks - vars(num_nc_fields+m) = var_desc(Tr_names(m), units=Tr_units(m), & - longname=Tr_names(m), hor_grid='1', z_grid='1') - enddo - num_nc_fields = num_nc_fields + nTr_stocks - endif + Tr_minmax_avail(:) = .false. + call call_tracer_stocks(h, Tr_stocks, G, GV, US, tracer_CSp, stock_names=Tr_names, & + stock_units=Tr_units, num_stocks=nTr_stocks,& + got_min_max=Tr_minmax_avail, global_min=Tr_min, global_max=Tr_max, & + xgmin=Tr_min_x, ygmin=Tr_min_y, zgmin=Tr_min_z,& + xgmax=Tr_max_x, ygmax=Tr_max_y, zgmax=Tr_max_z) + if (nTr_stocks > 0) then + do m=1,nTr_stocks + vars(num_nc_fields+m) = var_desc(Tr_names(m), units=Tr_units(m), & + longname=Tr_names(m), hor_grid='1', z_grid='1') + enddo + num_nc_fields = num_nc_fields + nTr_stocks endif if (CS%previous_calls == 0) then @@ -767,7 +739,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ if (nTr_stocks > 0) call sum_across_PEs(Tr_stocks,nTr_stocks) call max_across_PEs(max_CFL, 2) - Irho0 = 1.0 / (US%R_to_kg_m3*GV%Rho0) if (CS%use_temperature) then if (CS%previous_calls == 0) then @@ -884,7 +855,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ write(stdout,'(" Total ",a,": ",ES24.16,X,a)') & trim(Tr_names(m)), Tr_stocks(m), trim(Tr_units(m)) - if (Tr_minmax_got(m)) then + if (Tr_minmax_avail(m)) then write(stdout,'(64X,"Global Min:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & Tr_min(m),Tr_min_x(m),Tr_min_y(m),Tr_min_z(m) write(stdout,'(64X,"Global Max:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & @@ -1064,7 +1035,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) ! 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]. + ! integrate salt_flux in [R Z T-1 ~> kgSalt m-2 s-1] to give [ppt kg] salt_in(i,j) = RZL2_to_kg * dt * & G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif @@ -1277,7 +1248,7 @@ subroutine write_depth_list(G, US, DL, filename) character(len=16) :: depth_chksum, area_chksum ! All ranks are required to compute the global checksum - call get_depth_list_checksums(G, depth_chksum, area_chksum) + call get_depth_list_checksums(G, US, depth_chksum, area_chksum) if (.not.is_root_pe()) return @@ -1342,7 +1313,7 @@ subroutine read_depth_list(G, US, DL, filename, require_chksum, file_matches) call MOM_error(WARNING, trim(var_msg) // " some diagnostics may not be reproducible.") endif else - call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) + call get_depth_list_checksums(G, US, depth_grid_chksum, area_grid_chksum) if ((trim(depth_grid_chksum) /= trim(depth_file_chksum)) .or. & (trim(area_grid_chksum) /= trim(area_file_chksum)) ) then @@ -1389,8 +1360,9 @@ end subroutine read_depth_list !! !! Checksums are saved as hexadecimal strings, in order to avoid potential !! datatype issues with netCDF attributes. -subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) +subroutine get_depth_list_checksums(G, US, depth_chksum, area_chksum) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=16), intent(out) :: depth_chksum !< Depth checksum hexstring character(len=16), intent(out) :: area_chksum !< Area checksum hexstring @@ -1407,7 +1379,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Area checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') field_chksum(field(:,:)) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 6a4d9660d7..6765f9aa12 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -26,6 +26,7 @@ module MOM_wave_speed !> Control structure for MOM_wave_speed type, public :: wave_speed_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: use_ebt_mode = .false. !< If true, calculate the equivalent barotropic wave speed instead !! of the first baroclinic wave speed. !! This parameter controls the default behavior of wave_speed() which @@ -55,7 +56,7 @@ module MOM_wave_speed !> Calculates the wave speed of the first baroclinic mode. subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_N2_column_fraction, & - mono_N2_depth, modal_structure, better_speed_est, min_speed, wave_speed_tol) + mono_N2_depth, modal_structure) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -63,7 +64,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed [L T-1 ~> m s-1] - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent @@ -76,12 +77,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !! modal structure [Z ~> m]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: modal_structure !< Normalized model structure [nondim] - logical, optional, intent(in) :: better_speed_est !< If true, use a more robust estimate of the first - !! mode speed as the starting point for iterations. - real, optional, intent(in) :: min_speed !< If present, set a floor in the first mode speed - !! below which 0 is returned [L T-1 ~> m s-1]. - real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the - !! wave speeds [nondim] ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -109,9 +104,9 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] real :: det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 - real :: lam ! The eigenvalue [T2 L-2 ~> s m-1] - real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s m-1] - real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s m-1] + real :: lam ! The eigenvalue [T2 L-2 ~> s2 m-2] + real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] + real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s2 m-2] real :: min_h_frac ! [nondim] real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & @@ -125,7 +120,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 L-2 ~> 1]. - real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant ! and its derivative with lam between rows of the Thomas algorithm solver. The @@ -153,8 +147,9 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & "Module must be initialized before it is used.") + if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -175,16 +170,15 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ enddo ; enddo ; enddo endif - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) use_EOS = associated(tv%eqn_of_state) - better_est = CS%better_cg1_est ; if (present(better_speed_est)) better_est = better_speed_est + better_est = CS%better_cg1_est if (better_est) then - tol_solve = CS%wave_speed_tol ; if (present(wave_speed_tol)) tol_solve = wave_speed_tol + tol_solve = CS%wave_speed_tol tol_Hfrac = 0.1*tol_solve ; tol_merge = tol_solve / real(nz) else tol_solve = 0.001 ; tol_Hfrac = 0.0001 ; tol_merge = 0.001 @@ -197,12 +191,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! worst possible oceanic case of g'H < 0.5*10m/s2*1e4m = 5.e4 m2/s2 < 1024**2*c2_scale, suggesting ! that c2_scale can safely be set to 1/(16*1024**2), which would decrease the stable floor on ! min_speed to ~6.9e-8 m/s for 90 layers or 2.33e-7 m/s for 1000 layers. - cg1_min2 = CS%min_speed2 ; if (present(min_speed)) cg1_min2 = min_speed**2 + cg1_min2 = CS%min_speed2 rescale = 1024.0**4 ; I_rescale = 1.0/rescale c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. min_h_frac = tol_Hfrac / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S,tv,& +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & !$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2, & @@ -235,12 +229,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! Start a new layer H_here(i) = h(i,j,k)*GV%H_to_Z - HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) else H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = HxT_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -629,7 +623,7 @@ subroutine tdma6(n, a, c, lam, y) endif yy(k) = y(k) + a(k) * yy(k-1) * I_beta(k-1) enddo - ! The units of y change by a factor of [L2 T-2] in the following lines. + ! The units of y change by a factor of [L2 T-2 ~> m2 s-2] in the following lines. y(n) = yy(n) * I_beta(n) do k = n-1, 1, -1 y(k) = ( yy(k) + c(k) * y(k+1) ) * I_beta(k) @@ -638,8 +632,7 @@ subroutine tdma6(n, a, c, lam, y) end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. -subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_speed_est, & - min_speed, wave_speed_tol) +subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -647,15 +640,9 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] - type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), optional, intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. - logical, optional, intent(in) :: better_speed_est !< If true, use a more robust estimate of the first - !! mode speed as the starting point for iterations. - real, optional, intent(in) :: min_speed !< If present, set a floor in the first mode speed - !! below which 0 is returned [L T-1 ~> m s-1]. - real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the - !! wave speeds [nondim] ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -688,7 +675,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee real :: det, ddet ! determinant & its derivative of eigen system real :: lam_1 ! approximate mode-1 eigenvalue [T2 L-2 ~> s2 m-2] real :: lam_n ! approximate mode-n eigenvalue [T2 L-2 ~> s2 m-2] - real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s m-1] + real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] real :: lamMin ! minimum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamMax ! maximum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamInc ! width of moving window for root searching [T2 L-2 ~> s2 m-2] @@ -740,7 +727,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(CS)) then - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & "Module must be initialized before it is used.") endif @@ -757,16 +744,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. better_est = .false. ; if (present(CS)) better_est = CS%better_cg1_est - if (present(better_speed_est)) better_est = better_speed_est if (better_est) then tol_solve = 0.001 ; if (present(CS)) tol_solve = CS%wave_speed_tol - if (present(wave_speed_tol)) tol_solve = wave_speed_tol tol_Hfrac = 0.1*tol_solve ; tol_merge = tol_solve / real(nz) else tol_solve = 0.001 ; tol_Hfrac = 0.0001 ; tol_merge = 0.001 endif cg1_min2 = 0.0 ; if (present(CS)) cg1_min2 = CS%min_speed2 - if (present(min_speed)) cg1_min2 = min_speed**2 ! Zero out all wave speeds. Values over land or for columns that are too weakly stratified ! are not changed from this zero value. @@ -1151,18 +1135,16 @@ subroutine tridiag_det(a, c, ks, ke, lam, det, ddet, row_scale) real, intent(in) :: lam !< Value subtracted from b real, intent(out):: det !< Determinant real, intent(out):: ddet !< Derivative of determinant with lam - real, optional, intent(in) :: row_scale !< A scaling factor of the rows of the + real, intent(in) :: row_scale !< A scaling factor of the rows of the !! matrix to limit the growth of the determinant ! Local variables real :: detKm1, detKm2 ! Cumulative value of the determinant for the previous two layers. real :: ddetKm1, ddetKm2 ! Derivative of the cumulative determinant with lam for the previous two layers. real, parameter :: rescale = 1024.0**4 ! max value of determinant allowed before rescaling - real :: rscl ! A rescaling factor that is applied succesively to each row. real :: I_rescale ! inverse of rescale integer :: k ! row (layer interface) index I_rescale = 1.0 / rescale - rscl = 1.0 ; if (present(row_scale)) rscl = row_scale detKm1 = 1.0 ; ddetKm1 = 0.0 det = (a(ks)+c(ks)) - lam ; ddet = -1.0 @@ -1189,7 +1171,7 @@ end subroutine tridiag_det !> Initialize control structure for MOM_wave_speed subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & better_speed_est, min_speed, wave_speed_tol) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), intent(inout) :: CS !< Wave speed control struct logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over @@ -1212,11 +1194,7 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de # include "version_variable.h" character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "wave_speed_init called with an "// & - "associated control structure.") - return - else ; allocate(CS) ; endif + CS%initialized = .true. ! Write all relevant parameters to the model log. call log_version(mdl, version) @@ -1232,7 +1210,8 @@ end subroutine wave_speed_init !> Sets internal parameters for MOM_wave_speed subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & better_speed_est, min_speed, wave_speed_tol) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), intent(inout) :: CS + !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over @@ -1251,9 +1230,6 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] - if (.not.associated(CS)) call MOM_error(FATAL, & - "wave_speed_set_param called with an associated control structure.") - if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 678c48bd03..c833e973c5 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -36,6 +36,7 @@ module MOM_wave_structure !> The control structure for the MOM_wave_structure module type, public :: wave_structure_CS ; !private + logical :: initialized = .false. !< True if this control structure has been initialized. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. real, allocatable, dimension(:,:,:) :: w_strct @@ -102,8 +103,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! gravity wave speed [L T-1 ~> m s-1]. integer, intent(in) :: ModeNum !< Mode number real, intent(in) :: freq !< Intrinsic wave frequency [T-1 ~> s-1]. - type(wave_structure_CS), pointer :: CS !< The control structure returned by a - !! previous call to wave_structure_init. + type(wave_structure_CS), intent(inout) :: CS !< Wave structure control struct real, dimension(SZI_(G),SZJ_(G)), & 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 @@ -112,7 +112,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(GV)+1) :: & 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 [R L H T-2 ~> Pa] + pres, & !< Interface pressure [R L2 T-2 ~> Pa] T_int, & !< Temperature interpolated to interfaces [degC] S_int, & !< Salinity interpolated to interfaces [ppt] gprime !< The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. @@ -145,7 +145,6 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. ! real :: rescale, I_rescale integer :: kf(SZI_(G)) @@ -172,11 +171,11 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(GV)) :: dz !< thicknesses of merged layers (same as Hc I hope) [Z ~> m] ! real, dimension(SZK_(GV)+1) :: dWdz_profile !< profile of dW/dz real :: w2avg !< average of squared vertical velocity structure funtion [Z ~> m] - 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 :: int_dwdz2 !< Vertical integral of the square of u_strct [Z ~> m] + real :: int_w2 !< Vertical integral of the square of w_strct [Z ~> m] + real :: int_N2w2 !< Vertical integral of N2 [Z T-2 ~> m s-2] + real :: KE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] + real :: PE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] real :: W0 !< A vertical velocity magnitude [Z T-1 ~> m s-1] real :: gp_unscaled !< A version of gprime rescaled to [L T-2 ~> m s-2]. real, dimension(SZK_(GV)-1) :: lam_z !< product of eigen value and gprime(k); one value for each @@ -184,8 +183,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(GV)-1) :: a_diag, b_diag, c_diag !< diagonals of tridiagonal matrix; one value for each !< interface (excluding surface and bottom) - real, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitde (for TDMA) - real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) + real, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitude (for TDMA) [nondim] + real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) [nondim] real :: Pi integer :: kc integer :: i, j, k, k2, itt, is, ie, js, je, nz, nzm, row, ig, jg, ig_stop, jg_stop @@ -193,10 +192,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke I_a_int = 1/a_int - !if (present(CS)) then - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_structure: "// & - "Module must be initialized before it is used.") - !endif + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_structure: "// & + "Module must be initialized before it is used.") if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed @@ -204,7 +201,6 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo Pi = (4.0*atan(1.0)) - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 !if (CS%debug) call chksum0(g_Rho0, "g/rho0 in wave struct", & @@ -242,12 +238,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Start a new layer H_here(i) = h(i,j,k)*GV%H_to_Z - HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) else H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = HxT_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -527,7 +523,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (present(En) .and. (freq**2*Kmag2 > 0.0)) then - ! Units here are [R + ! Units here are [R Z ~> kg m-2] KE_term = 0.25*GV%Rho0*( ((freq**2 + f2) / (freq**2*Kmag2))*int_dwdz2 + int_w2 ) PE_term = 0.25*GV%Rho0*( int_N2w2 / freq**2 ) if (En(i,j) >= 0.0) then @@ -727,8 +723,8 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + type(wave_structure_CS), intent(inout) :: CS !< Wave structure control struct + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_structure" ! This module's name. @@ -736,11 +732,7 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - if (associated(CS)) then - call MOM_error(WARNING, "wave_structure_init called with an "// & - "associated control structure.") - return - else ; allocate(CS) ; endif + CS%initialized = .true. call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 23f22d8a24..39b626985a 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -37,9 +37,7 @@ module MOM_EOS #include -public EOS_allocate public EOS_domain -public EOS_end public EOS_init public EOS_manual_init public EOS_quadrature @@ -167,7 +165,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] 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 + type(EOS_type), intent(in) :: 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 in !! combination with scaling given by US [various] @@ -175,9 +173,6 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_scalar called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -216,7 +211,7 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, intent(in) :: Svar !< Variance of salinity [ppt2] real, intent(in) :: pressure !< Pressure [Pa] 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 + type(EOS_type), intent(in) :: 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] @@ -225,9 +220,6 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_stanley_density_scalar called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -266,15 +258,12 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re real, dimension(:), intent(inout) :: 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 + type(EOS_type), intent(in) :: 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 !! in combination with scaling given by US [various] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pressure, rho, start, npts, & @@ -312,7 +301,7 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [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 + type(EOS_type), intent(in) :: 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] @@ -320,9 +309,6 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pressure, rho, start, npts, & @@ -361,7 +347,7 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] @@ -375,9 +361,6 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -421,7 +404,7 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, dimension(:), intent(in) :: TScov !< Covariance of potential temperature and salinity [degC ppt] real, dimension(:), intent(in) :: Svar !< Variance of salinity [ppt2] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] @@ -434,9 +417,6 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -489,7 +469,7 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] 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 + type(EOS_type), intent(in) :: 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 in combination with scaling given by US [various] @@ -497,9 +477,6 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, dimension(size(specvol)) :: rho ! Density [kg m-3] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & @@ -534,7 +511,7 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] 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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] or [R-1 m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -543,9 +520,6 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real :: spv_reference ! spv_ref converted to [m3 kg-1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") - pres(1) = EOS%RL2_T2_to_Pa*pressure Ta(1) = T ; Sa(1) = S @@ -572,7 +546,7 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] @@ -587,9 +561,6 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real :: spv_reference ! spv_ref converted to [m3 kg-1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -626,15 +597,12 @@ subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: pressure !< Pressure [Pa] or [other] real, intent(out) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa ! Local variables real :: p_scale ! A factor to convert pressure to units of Pa. - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale select case (EOS%form_of_TFreeze) @@ -659,7 +627,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca !! to the surface [degC] 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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. ! Local variables @@ -667,9 +635,6 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca real :: p_scale ! A factor to convert pressure to units of Pa. integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale if (p_scale == 1.0) then @@ -709,19 +674,16 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star real, dimension(:), intent(inout) :: drho_dT !< The partial derivative of density with potential !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1] or [R degC-1 ~> kg m-3 ppt-1] + !! in [kg m-3 ppt-1] or [R ppt-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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables integer :: j - 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, & @@ -754,8 +716,8 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do real, dimension(:), intent(inout) :: drho_dT !< The partial derivative of density with potential !! temperature [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity - !! [R degC-1 ~> kg m-3 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + !! [R ppt-1 ~> kg m-3 ppt-1] + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density @@ -766,9 +728,6 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -804,7 +763,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS !! 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] or [R ppt-1 ~> kg m-3 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -812,9 +771,6 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -856,7 +812,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh !! [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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -866,9 +822,6 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then @@ -938,7 +891,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! [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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -946,9 +899,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -994,7 +944,7 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start !! [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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(size(T)) :: press ! Pressure converted to [Pa] @@ -1003,9 +953,6 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start real, dimension(size(T)) :: dRho_dS ! Derivative of density with salinity [kg m-3 ppt-1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & @@ -1044,7 +991,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity !! [R-1 ppt-1 ~> m3 kg-1 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific @@ -1056,9 +1003,6 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -1095,15 +1039,12 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) !! [s2 m-2] or [T2 L-2] 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 + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] integer :: i, is, ie - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_compress called with an unassociated EOS_type EOS.") - is = start ; ie = is + npts - 1 do i=is,ie ; pressure(i) = EOS%RL2_T2_to_Pa * press(i) ; enddo @@ -1142,13 +1083,11 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(out) :: rho !< In situ density [kg m-3] or [R ~> kg m-3] real, intent(out) :: drho_dp !< The partial derivative of density with pressure (also the !! inverse of the square of sound speed) [s2 m-2] or [T2 L-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_compress called with an unassociated EOS_type EOS.") Ta(1) = T ; Sa(1) = S; pa(1) = pressure call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS) @@ -1198,7 +1137,7 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dza !< The change in the geopotential anomaly across !! the layer [L2 T-2 ~> m2 s-2] or [m2 s-2] @@ -1226,9 +1165,6 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real :: SV_scale ! A multiplicative factor by which to scale specific ! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "int_specific_vol_dp called with an unassociated EOS_type EOS.") - ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical ! integration be used instead of analytic. This is a safety check. if (EOS%EOS_quadrature) call MOM_error(FATAL, "EOS_quadrature is set!") @@ -1271,7 +1207,7 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dpa !< The change in the pressure anomaly !! across the layer [R L2 T-2 ~> Pa] or [Pa] @@ -1299,9 +1235,6 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, ! desired units [R m3 kg-1 ~> 1] real :: pres_scale ! A multiplicative factor to convert pressure into Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "int_density_dz called with an unassociated EOS_type EOS.") - ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical ! integration be used instead of analytic. This is a safety check. if (EOS%EOS_quadrature) call MOM_error(FATAL, "EOS_quadrature is set!") @@ -1338,10 +1271,7 @@ end subroutine analytic_int_density_dz !> Returns true if the equation of state is compressible (i.e. has pressure dependence) logical function query_compressible(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "query_compressible called with an unassociated EOS_type EOS.") + type(EOS_type), intent(in) :: EOS !< Equation of state structure query_compressible = EOS%compressible end function query_compressible @@ -1349,7 +1279,7 @@ end function query_compressible !> Initializes EOS_type by allocating and reading parameters subroutine EOS_init(param_file, EOS, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(inout) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type optional :: US ! Local variables @@ -1357,8 +1287,6 @@ subroutine EOS_init(param_file, EOS, US) character(len=40) :: mdl = "MOM_EOS" ! This module's name. character(len=40) :: tmpstr - if (.not.associated(EOS)) call EOS_allocate(EOS) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1457,7 +1385,7 @@ end subroutine EOS_init !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS) subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(inout) :: EOS !< Equation of state structure integer, optional, intent(in) :: form_of_EOS !< A coded integer indicating the equation of state to use. integer, optional, intent(in) :: form_of_TFreeze !< A coded integer indicating the expression for !! the potential temperature of the freezing point. @@ -1488,20 +1416,6 @@ subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Co end subroutine EOS_manual_init -!> Allocates EOS_type -subroutine EOS_allocate(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) allocate(EOS) -end subroutine EOS_allocate - -!> Deallocates EOS_type -subroutine EOS_end(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (associated(EOS)) deallocate(EOS) -end subroutine EOS_end - !> Set equation of state structure (EOS) to linear with given coefficients !! !! \note This routine is primarily for testing and allows a local copy of the @@ -1513,10 +1427,7 @@ subroutine EOS_use_linear(Rho_T0_S0, dRho_dT, dRho_dS, EOS, use_quadrature) real, intent(in) :: dRho_dS !< Partial derivative of density with salinity [kg m-3 ppt-1] logical, optional, intent(in) :: use_quadrature !< If true, always use the generic (quadrature) !! code for the integrals of density. - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "MOM_EOS.F90: EOS_use_linear() called with an unassociated EOS_type EOS.") + type(EOS_type), intent(inout) :: EOS !< Equation of state structure EOS%form_of_EOS = EOS_LINEAR EOS%Compressible = .false. @@ -1539,15 +1450,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) intent(inout) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(in) :: mask_z !< 3d mask regulating which points to convert. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer :: i, j, k real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp real :: p - if (.not.associated(EOS)) call MOM_error(FATAL, & - "convert_temp_salt_to_TEOS10 called with an unassociated EOS_type EOS.") - if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec @@ -1564,7 +1472,7 @@ end subroutine convert_temp_salt_for_TEOS10 !> Return value of EOS_quadrature logical function EOS_quadrature(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure EOS_quadrature = EOS%EOS_quadrature @@ -1573,7 +1481,7 @@ end function EOS_quadrature !> Extractor routine for the EOS type if the members need to be accessed outside this module subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, optional, intent(out) :: form_of_EOS !< A coded integer indicating the equation of state to use. integer, optional, intent(out) :: form_of_TFreeze !< A coded integer indicating the expression for !! the potential temperature of the freezing point. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 76d8f64ff1..5ab2874175 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -357,7 +357,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer [R L2 Z T-2 ~> Pa Z] or [Pa Z]. + !! at the top of the layer [R L2 Z T-2 ~> Pa m] or [Pa m]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -549,7 +549,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & real :: dp, dpL, dpR ! Layer pressure thicknesses [R L2 T-2 ~> Pa] or [Pa]. real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] or [Pa]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa] or [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-2 ~> Pa-2] or [Pa-2]. + real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] or [Pa-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 718a796802..d1a8102fc1 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -110,7 +110,7 @@ subroutine chksum0(scalar, mesg, scale, logunit) call chksum_error(FATAL, 'NaN detected: '//trim(mesg)) scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then rs = scaling * scalar @@ -147,7 +147,7 @@ subroutine zchksum(array, mesg, scale, logunit) endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -352,7 +352,7 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -618,7 +618,7 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -901,7 +901,7 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1079,7 +1079,7 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1246,7 +1246,7 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -1397,7 +1397,7 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1576,7 +1576,7 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1754,7 +1754,7 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1944,8 +1944,8 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg) - real, dimension(:,:) :: array !< The array to be checksummed - character(len=*) :: mesg !< An identifying message + real, dimension(:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,i,j,sum1,bc real :: sum @@ -1972,8 +1972,8 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg) - real, dimension(:,:,:) :: array !< The array to be checksummed - character(len=*) :: mesg !< An identifying message + real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 real :: sum diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 374f54548e..eb24c994f8 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -39,6 +39,7 @@ module MOM_diag_mediator #define MAX_DSAMP_LEV 2 public set_axes_info, post_data, register_diag_field, time_type +public post_product_u, post_product_sum_u, post_product_v, post_product_sum_v public set_masks_for_axes public post_data_1d_k public safe_alloc_ptr, safe_alloc_alloc @@ -1802,6 +1803,108 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) end subroutine post_data_3d_low +!> Calculate and write out diagnostics that are the product of two 3-d arrays at u-points +subroutine post_product_u(id, u_a, u_b, G, nz, diag, mask, alt_h) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_a !< The first u-point array in arbitrary units [A] + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_b !< The second u-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask [nondim] + real, target, optional, intent(in) :: alt_h(:,:,:) !< An alternate thickness to use for vertically + !! remapping this diagnostic [H ~> m or kg m-2] + + ! Local variables + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz) :: u_prod ! The product of u_a and u_b [A B] + integer :: i, j, k + + if (id <= 0) return + + do k=1,nz ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB + u_prod(I,j,k) = u_a(I,j,k) * u_b(I,j,k) + enddo ; enddo ; enddo + call post_data(id, u_prod, diag, mask=mask, alt_h=alt_h) + +end subroutine post_product_u + +!> Calculate and write out diagnostics that are the vertical sum of the product of two 3-d arrays at u-points +subroutine post_product_sum_u(id, u_a, u_b, G, nz, diag) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_a !< The first u-point array in arbitrary units [A] + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_b !< The second u-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed) :: u_sum ! The vertical sum of the product of u_a and u_b [A B] + integer :: i, j, k + + if (id <= 0) return + + u_sum(:,:) = 0.0 + do k=1,nz ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB + u_sum(I,j) = u_sum(I,j) + u_a(I,j,k) * u_b(I,j,k) + enddo ; enddo ; enddo + call post_data(id, u_sum, diag) + +end subroutine post_product_sum_u + +!> Calculate and write out diagnostics that are the product of two 3-d arrays at v-points +subroutine post_product_v(id, v_a, v_b, G, nz, diag, mask, alt_h) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_a !< The first v-point array in arbitrary units [A] + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_b !< The second v-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask [nondim] + real, target, optional, intent(in) :: alt_h(:,:,:) !< An alternate thickness to use for vertically + !! remapping this diagnostic [H ~> m or kg m-2] + + ! Local variables + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz) :: v_prod ! The product of v_a and v_b [A B] + integer :: i, j, k + + if (id <= 0) return + + do k=1,nz ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec + v_prod(i,J,k) = v_a(i,J,k) * v_b(i,J,k) + enddo ; enddo ; enddo + call post_data(id, v_prod, diag, mask=mask, alt_h=alt_h) + +end subroutine post_product_v + +!> Calculate and write out diagnostics that are the vertical sum of the product of two 3-d arrays at v-points +subroutine post_product_sum_v(id, v_a, v_b, G, nz, diag) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_a !< The first v-point array in arbitrary units [A] + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_b !< The second v-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + + real, dimension(G%isd:G%ied, G%JsdB:G%JedB) :: v_sum ! The vertical sum of the product of v_a and v_b [A B] + integer :: i, j, k + + if (id <= 0) return + + v_sum(:,:) = 0.0 + do k=1,nz ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec + v_sum(i,J) = v_sum(i,J) + v_a(i,J,k) * v_b(i,J,k) + enddo ; enddo ; enddo + call post_data(id, v_sum, diag) + +end subroutine post_product_sum_v + !> Post the horizontally area-averaged diagnostic subroutine post_xy_average(diag_cs, diag, field) type(diag_type), intent(in) :: diag !< This diagnostic diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index bb11d92673..f9e5a35a09 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -280,7 +280,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe real, dimension(:,:,:), intent(in) :: h !< New thickness [H ~> m or kg m-2] real, dimension(:,:,:), intent(in) :: T !< New temperatures [degC] real, dimension(:,:,:), intent(in) :: S !< New salinities [ppt] - type(EOS_type), pointer :: eqn_of_state !< A pointer to the equation of state + type(EOS_type), intent(in) :: eqn_of_state !< A pointer to the equation of state real, dimension(:,:,:), intent(inout) :: h_target !< The new diagnostic thicknesses [H ~> m or kg m-2] ! Local variables diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index ff0934ac55..24f77a0eb2 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -672,22 +672,22 @@ function real_array_string(vals, sep) integer :: j, n, ns logical :: doWrite character(len=10) :: separator - n=1 ; doWrite=.true. ; real_array_string='' + n = 1 ; doWrite = .true. ; real_array_string = '' if (present(sep)) then - separator=sep ; ns=len(sep) + separator = sep ; ns = len(sep) else - separator=', ' ; ns=2 + separator = ', ' ; ns = 2 endif do j=1,size(vals) - doWrite=.true. - if (j0) then ! Write separator if a number has already been written + if (len(real_array_string) > 0) then ! Write separator if a number has already been written real_array_string = real_array_string // separator(1:ns) endif if (n>1) then diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 43aeb3372a..8264a903cf 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -4,15 +4,16 @@ module MOM_dyn_horgrid ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_hor_index, only : hor_index_type -use MOM_domains, only : MOM_domain_type, deallocate_MOM_domain -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_unit_scaling, only : unit_scale_type +use MOM_array_transform, only : rotate_array, rotate_array_pair +use MOM_domains, only : MOM_domain_type, deallocate_MOM_domain +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_hor_index, only : hor_index_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid -public rescale_dyn_horgrid_bathymetry +public rescale_dyn_horgrid_bathymetry, rotate_dyn_horgrid ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -108,6 +109,16 @@ module MOM_dyn_horgrid IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. + real, allocatable, dimension(:,:) :: & + porous_DminU, & !< minimum topographic height of U-face [Z ~> m] + porous_DmaxU, & !< maximum topographic height of U-face [Z ~> m] + porous_DavgU !< average topographic height of U-face [Z ~> m] + + real, allocatable, dimension(:,:) :: & + porous_DminV, & !< minimum topographic height of V-face [Z ~> m] + porous_DmaxV, & !< maximum topographic height of V-face [Z ~> m] + porous_DavgV !< average topographic height of V-face [Z ~> m] + real, allocatable, dimension(:,:) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. @@ -162,10 +173,11 @@ module MOM_dyn_horgrid ! initialization routines (but not all) real :: south_lat !< The latitude (or y-coordinate) of the first v-line real :: west_lon !< The longitude (or x-coordinate) of the first u-line - real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain - real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. - real :: max_depth !< The maximum depth of the ocean [Z ~> m]. + real :: len_lat !< The latitudinal (or y-coord) extent of physical domain + real :: len_lon !< The longitudinal (or x-coord) extent of physical domain + real :: Rad_Earth !< The radius of the planet [m] + real :: Rad_Earth_L !< The radius of the planet in rescaled units [L ~> m] + real :: max_depth !< The maximum depth of the ocean [Z ~> m] end type dyn_horgrid_type contains @@ -255,6 +267,15 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%IareaCu(IsdB:IedB,jsd:jed), source=0.0) allocate(G%IareaCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%porous_DminU(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%porous_DmaxU(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%porous_DavgU(IsdB:IedB,jsd:jed), source=0.0) + + allocate(G%porous_DminV(isd:ied,JsdB:JedB), source=0.0) + allocate(G%porous_DmaxV(isd:ied,JsdB:JedB), source=0.0) + allocate(G%porous_DavgV(isd:ied,JsdB:JedB), source=0.0) + + allocate(G%bathyT(isd:ied, jsd:jed), source=0.0) allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB), source=0.0) allocate(G%dF_dx(isd:ied, jsd:jed), source=0.0) @@ -279,6 +300,102 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) end subroutine create_dyn_horgrid + +!> Copy the rotated contents of one horizontal grid type into another. The input +!! and output grid type arguments can not use the same object. +subroutine rotate_dyn_horgrid(G_in, G, US, turns) + type(dyn_horgrid_type), intent(in) :: G_in !< The input horizontal grid type + type(dyn_horgrid_type), intent(inout) :: G !< An output rotated horizontal grid type + !! that has already been allocated, but whose + !! contents are largely replaced here. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: turns !< Number of quarter turns + + integer :: jsc, jec, jscB, jecB + integer :: qturn + + ! Center point + call rotate_array(G_in%geoLonT, turns, G%geoLonT) + call rotate_array(G_in%geoLatT, turns, G%geoLatT) + call rotate_array_pair(G_in%dxT, G_in%dyT, turns, G%dxT, G%dyT) + call rotate_array(G_in%areaT, turns, G%areaT) + call rotate_array(G_in%bathyT, turns, G%bathyT) + + call rotate_array_pair(G_in%df_dx, G_in%df_dy, turns, G%df_dx, G%df_dy) + call rotate_array(G_in%sin_rot, turns, G%sin_rot) + call rotate_array(G_in%cos_rot, turns, G%cos_rot) + call rotate_array(G_in%mask2dT, turns, G%mask2dT) + + ! Face points + call rotate_array_pair(G_in%geoLonCu, G_in%geoLonCv, turns, G%geoLonCu, G%geoLonCv) + call rotate_array_pair(G_in%geoLatCu, G_in%geoLatCv, turns, G%geoLatCu, G%geoLatCv) + call rotate_array_pair(G_in%dxCu, G_in%dyCv, turns, G%dxCu, G%dyCv) + call rotate_array_pair(G_in%dxCv, G_in%dyCu, turns, G%dxCv, G%dyCu) + call rotate_array_pair(G_in%dx_Cv, G_in%dy_Cu, turns, G%dx_Cv, G%dy_Cu) + + call rotate_array_pair(G_in%mask2dCu, G_in%mask2dCv, turns, G%mask2dCu, G%mask2dCv) + call rotate_array_pair(G_in%areaCu, G_in%areaCv, turns, G%areaCu, G%areaCv) + call rotate_array_pair(G_in%IareaCu, G_in%IareaCv, turns, G%IareaCu, G%IareaCv) + + call rotate_array_pair(G_in%porous_DminU, G_in%porous_DminV, & + turns, G%porous_DminU, G%porous_DminV) + call rotate_array_pair(G_in%porous_DmaxU, G_in%porous_DmaxV, & + turns, G%porous_DmaxU, G%porous_DmaxV) + call rotate_array_pair(G_in%porous_DavgU, G_in%porous_DavgV, & + turns, G%porous_DavgU, G%porous_DavgV) + + + ! Vertex point + call rotate_array(G_in%geoLonBu, turns, G%geoLonBu) + call rotate_array(G_in%geoLatBu, turns, G%geoLatBu) + call rotate_array_pair(G_in%dxBu, G_in%dyBu, turns, G%dxBu, G%dyBu) + call rotate_array(G_in%areaBu, turns, G%areaBu) + call rotate_array(G_in%CoriolisBu, turns, G%CoriolisBu) + call rotate_array(G_in%mask2dBu, turns, G%mask2dBu) + + ! Topography at the cell faces + G%bathymetry_at_vel = G_in%bathymetry_at_vel + if (G%bathymetry_at_vel) then + call rotate_array_pair(G_in%Dblock_u, G_in%Dblock_v, turns, G%Dblock_u, G%Dblock_v) + call rotate_array_pair(G_in%Dopen_u, G_in%Dopen_v, turns, G%Dopen_u, G%Dopen_v) + endif + + ! Nominal grid axes + ! TODO: We should not assign lat values to the lon axis, and vice versa. + ! We temporarily copy lat <-> lon since several components still expect + ! lat and lon sizes to match the first and second dimension sizes. + ! But we ought to instead leave them unchanged and adjust the references to + ! these axes. + if (modulo(turns, 2) /= 0) then + G%gridLonT(:) = G_in%gridLatT(G_in%jeg:G_in%jsg:-1) + G%gridLatT(:) = G_in%gridLonT(:) + G%gridLonB(:) = G_in%gridLatB(G_in%jeg:(G_in%jsg-1):-1) + G%gridLatB(:) = G_in%gridLonB(:) + else + G%gridLonT(:) = G_in%gridLonT(:) + G%gridLatT(:) = G_in%gridLatT(:) + G%gridLonB(:) = G_in%gridLonB(:) + G%gridLatB(:) = G_in%gridLatB(:) + endif + + G%x_axis_units = G_in%y_axis_units + G%y_axis_units = G_in%x_axis_units + G%south_lat = G_in%south_lat + G%west_lon = G_in%west_lon + G%len_lat = G_in%len_lat + G%len_lon = G_in%len_lon + + ! Rotation-invariant fields + G%areaT_global = G_in%areaT_global + G%IareaT_global = G_in%IareaT_global + G%Rad_Earth = G_in%Rad_Earth + G%Rad_Earth_L = G_in%Rad_Earth_L + G%max_depth = G_in%max_depth + + call set_derived_dyn_horgrid(G, US) +end subroutine rotate_dyn_horgrid + + !> rescale_dyn_horgrid_bathymetry permits a change in the internal units for the bathymetry on the !! grid, both rescaling the depths and recording the new internal depth units. subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) @@ -318,12 +435,8 @@ subroutine set_derived_dyn_horgrid(G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -401,6 +514,9 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%dx_Cv) ; deallocate(G%dy_Cu) + deallocate(G%porous_DminU) ; deallocate(G%porous_DmaxU) ; deallocate(G%porous_DavgU) + deallocate(G%porous_DminV) ; deallocate(G%porous_DmaxV) ; deallocate(G%porous_DavgV) + deallocate(G%bathyT) ; deallocate(G%CoriolisBu) deallocate(G%dF_dx) ; deallocate(G%dF_dy) deallocate(G%sin_rot) ; deallocate(G%cos_rot) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 0f16a5b301..de511688a9 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -16,9 +16,8 @@ module MOM_horizontal_regridding use MOM_interpolate, only : build_horiz_interp_weights, run_horiz_interp, horiz_interp_type use MOM_interp_infra, only : axistype, get_external_field_info, get_axis_data use MOM_time_manager, only : time_type - -use netcdf, only : NF90_OPEN, NF90_NOWRITE, NF90_GET_ATT, NF90_GET_VAR -use netcdf, only : NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, NF90_INQUIRE_DIMENSION +use MOM_io, only : axis_info, get_axis_info, get_var_axes_info, MOM_read_data +use MOM_io, only : read_attribute, read_variable implicit none ; private @@ -304,10 +303,12 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real :: max_lat, min_lat, pole, max_depth, npole real :: roundoff ! The magnitude of roundoff, usually ~2e-16. real :: add_offset, scale_factor + logical :: found_attr logical :: add_np logical :: is_ongrid character(len=8) :: laynum type(horiz_interp_type) :: Interp + type(axis_info), dimension(4) :: axes_info ! Axis information used for regridding integer :: is, ie, js, je ! compute domain indices integer :: isc, iec, jsc, jec ! global compute domain indices integer :: isg, ieg, jsg, jeg ! global extent @@ -334,6 +335,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + PI_180 = atan(1.0)/45. ! Open NetCDF file and if present, extract data and spatial coordinate information @@ -341,64 +345,23 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call cpu_clock_begin(id_clock_read) - rcode = NF90_OPEN(filename, NF90_NOWRITE, ncid) - if (rcode /= 0) call MOM_error(FATAL,"error opening file "//trim(filename)//& - " in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, varnam, varid) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(varnam)//& - " in file "//trim(filename)//" in hinterp_extrap") - - rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) - if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(varnam)//& - " in file "//trim(filename)//" in hinterp_extrap") - if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(varnam)//" in file "//trim(filename)// & - " has too few dimensions to be read as a 3-d array.") - - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& - " in file "//trim(filename)//" in hinterp_extrap") - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& - " in file "//trim(filename)//" in hinterp_extrap") - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& - " in file "//trim(filename)//" in hinterp_extrap") - - missing_value=0.0 - rcode = NF90_GET_ATT(ncid, varid, "_FillValue", missing_value) - if (rcode /= 0) call MOM_error(FATAL,"error finding missing value for "//trim(varnam)//& - " in file "// trim(filename)//" in hinterp_extrap") - - rcode = NF90_GET_ATT(ncid, varid, "add_offset", add_offset) - if (rcode /= 0) add_offset = 0.0 - - rcode = NF90_GET_ATT(ncid, varid, "scale_factor", scale_factor) - if (rcode /= 0) scale_factor = 1.0 + call get_var_axes_info(trim(filename), trim(varnam), axes_info) + + if (allocated(z_in)) deallocate(z_in) + if (allocated(z_edges_in)) deallocate(z_edges_in) + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + + call get_axis_info(axes_info(1),ax_size=id) + call get_axis_info(axes_info(2),ax_size=jd) + call get_axis_info(axes_info(3),ax_size=kd) allocate(lon_in(id), lat_in(jd), z_in(kd), z_edges_in(kd+1)) allocate(tr_z(isd:ied,jsd:jed,kd), mask_z(isd:ied,jsd:jed,kd)) - start = 1 ; count = 1 ; count(1) = id - rcode = NF90_GET_VAR(ncid, dim_id(1), lon_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & - trim(varnam)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1 ; count = 1 ; count(1) = jd - rcode = NF90_GET_VAR(ncid, dim_id(2), lat_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & - trim(varnam)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1 ; count = 1 ; count(1) = kd - rcode = NF90_GET_VAR(ncid, dim_id(3), z_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & - trim(varnam//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") + call get_axis_info(axes_info(1),ax_data=lon_in) + call get_axis_info(axes_info(2),ax_data=lat_in) + call get_axis_info(axes_info(3),ax_data=z_in) call cpu_clock_end(id_clock_read) @@ -422,6 +385,21 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif ! construct level cell boundaries as the mid-point between adjacent centers + ! Set the I/O attributes + call read_attribute(trim(filename), "_FillValue", missing_value, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) call MOM_error(FATAL, & + "error finding missing value for " // trim(varnam) // & + " in file " // trim(filename) // " in hinterp_extrap") + + call read_attribute(trim(filename), "scale_factor", scale_factor, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) scale_factor = 1. + + call read_attribute(trim(filename), "add_offset", add_offset, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) add_offset = 0. + z_edges_in(1) = 0.0 do K=2,kd z_edges_in(K) = 0.5*(z_in(k-1)+z_in(k)) @@ -458,12 +436,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, mask_in = 0.0 if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k - count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1 - rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"horiz_interp_and_extrap_tracer_record: "//& - "error reading level "//trim(laynum)//" of variable "//& - trim(varnam)//" in file "// trim(filename)) - + count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1; start(4) = 1; count(4) = 1 + call MOM_read_data(trim(filename), trim(varnam), tr_in, G%Domain, timelevel=1) do j=js,je do i=is,ie if (abs(tr_in(i,j)-missing_value) > abs(roundoff*missing_value)) then @@ -474,15 +448,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif enddo enddo - else + start(:) = 1 ; start(3) = k + count(:) = 1 ; count(1) = id ; count(2) = jd + call read_variable(trim(filename), trim(varnam), tr_in, start=start, nread=count) if (is_root_pe()) then - start = 1 ; start(3) = k ; count(:) = 1 ; count(1) = id ; count(2) = jd - rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"horiz_interp_and_extrap_tracer_record: "//& - "error reading level "//trim(laynum)//" of variable "//& - trim(varnam)//" in file "// trim(filename)) - if (add_np) then pole = 0.0 ; npole = 0.0 do i=1,id @@ -603,6 +573,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, enddo ! kd + deallocate(lon_in, lat_in) + end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 00eeb4cf89..8928d2e56b 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -6,7 +6,7 @@ module MOM_io use MOM_array_transform, only : allocate_rotated_array, rotate_array use MOM_array_transform, only : rotate_array_pair, rotate_vector use MOM_domains, only : MOM_domain_type, domain1D, broadcast, get_domain_components -use MOM_domains, only : rescale_comp_data, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : rescale_comp_data, num_PEs, AGRID, BGRID_NE, CGRID_NE use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_ensemble_manager, only : get_ensemble_id use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING, is_root_PE @@ -51,6 +51,8 @@ module MOM_io public :: slasher, write_field, write_version_number public :: io_infra_init, io_infra_end public :: stdout_if_root +public :: get_var_axes_info +public :: get_axis_info ! This is used to set up information descibing non-domain-decomposed axes. public :: axis_info, set_axis_info, delete_axis_info ! This is used to set up global file attributes @@ -98,6 +100,7 @@ module MOM_io interface read_variable module procedure read_variable_0d, read_variable_0d_int module procedure read_variable_1d, read_variable_1d_int + module procedure read_variable_2d end interface read_variable !> Read a global or variable attribute from a named netCDF file using netCDF calls @@ -236,6 +239,8 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim IsgB = dG%IsgB ; IegB = dG%IegB ; JsgB = dG%JsgB ; JegB = dG%JegB endif + if (domain_set .and. (num_PEs() == 1)) thread = SINGLE_FILE + one_file = .true. if (domain_set) one_file = (thread == SINGLE_FILE) @@ -885,6 +890,136 @@ subroutine read_variable_1d_int(filename, varname, var, ncid_in) call broadcast(var, size(var), blocking=.true.) end subroutine read_variable_1d_int +!> Read a 2d array from a netCDF input file and save to a variable. +!! +!! Start and nread lenths may exceed var rank. This allows for reading slices +!! of larger arrays. +!! +!! Previous versions of the model required a time axis on IO fields. This +!! constraint was dropped in later versions. As a result, versions both with +!! and without a time axis now exist. In order to support all such versions, +!! we use a reshaped version of start and nread in order to read the variable +!! as it exists in the file. +!! +!! Certain constraints are still applied to start and nread in order to ensure +!! that varname is a valid 2d array, or contains valid 2d slices. +!! +!! I/O occurs only on the root PE, and data is broadcast to other ranks. +!! Due to potentially large memory communication and storage, this subroutine +!! should only be used when domain-decomposition is unavaialable. +subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) + character(len=*), intent(in) :: filename !< Name of file to be read + character(len=*), intent(in) :: varname !< Name of variable to be read + real, intent(out) :: var(:,:) !< Output array of variable + integer, optional, intent(in) :: start(:) !< Starting index on each axis. + integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis + integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. + !! If absent, the file is opened and closed within this routine. + + integer :: ncid, varid + integer :: field_ndims, dim_len + integer, allocatable :: field_dimids(:), field_shape(:) + integer, allocatable :: field_start(:), field_nread(:) + integer :: i, rc + character(len=*), parameter :: hdr = "read_variable_2d: " + character(len=128) :: msg + + ! Validate shape of start and nread + if (present(start)) then + if (size(start) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start must have at least two dimensions.") + endif + + if (present(nread)) then + if (size(nread) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread must have at least two dimensions.") + + if (any(nread(3:) > 1)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread may only read a single level in higher dimensions.") + endif + + ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure + ! that their lengths are equivalent, and must do it here. + if (present(start) .and. present(nread)) then + if (size(start) /= size(nread)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start and nread must have the same length.") + endif + + ! Open and read `varname` from `filename` + if (is_root_pe()) then + if (present(ncid_in)) then + ncid = ncid_in + else + call open_file_to_Read(filename, ncid) + endif + + call get_varid(varname, ncid, filename, varid, match_case=.false.) + if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//& + " in "//trim(filename)) + + ! Query for the dimensionality of the input field + rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + ! Confirm that field is at least 2d + if (field_ndims < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) // " " // & + trim(varname) // " from " // trim(filename) // " is not a 2D field.") + + ! If start and nread are present, then reshape them to match field dims + if (present(start) .or. present(nread)) then + allocate(field_shape(field_ndims)) + allocate(field_dimids(field_ndims)) + + rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + do i = 1, field_ndims + rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // ": Difficulties reading dimensions from " // trim(filename)) + field_shape(i) = dim_len + enddo + + ! Reshape start(:) and nreads(:) in case ranks differ + allocate(field_start(field_ndims)) + field_start(:) = 1 + if (present(start)) then + dim_len = min(size(start), size(field_start)) + field_start(:dim_len) = start(:dim_len) + endif + + allocate(field_nread(field_ndims)) + field_nread(:2) = field_shape(:2) + field_nread(3:) = 1 + if (present(nread)) field_shape(:2) = nread(:2) + + rc = nf90_get_var(ncid, varid, var, field_start, field_nread) + + deallocate(field_start) + deallocate(field_nread) + deallocate(field_shape) + deallocate(field_dimids) + else + rc = nf90_get_var(ncid, varid, var) + endif + + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + " Difficulties reading "//trim(varname)//" from "//trim(filename)) + + if (.not.present(ncid_in)) call close_file_to_read(ncid, filename) + endif + + call broadcast(var, size(var), blocking=.true.) +end subroutine read_variable_2d + !> Read a character-string global or variable attribute subroutine read_attribute_str(filename, attname, att_val, varname, found, all_read, ncid_in) character(len=*), intent(in) :: filename !< Name of the file to read @@ -1540,6 +1675,32 @@ subroutine delete_axis_info(axes) enddo end subroutine delete_axis_info + +!> Retrieve the information from an axis_info type. +subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) + type(axis_info), intent(in) :: axis !< An axis type + character(len=*), intent(out), optional :: name !< The axis name. + character(len=*), intent(out), optional :: longname !< The axis longname. + character(len=*), intent(out), optional :: units !< The axis units. + character(len=*), intent(out), optional :: cartesian !< The cartesian attribute + !! of the axis [X,Y,Z,T]. + integer, intent(out), optional :: ax_size !< The size of the axis. + real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. + + if (present(ax_data)) then + if (allocated(ax_data)) deallocate(ax_data) + allocate(ax_data(axis%ax_size)) + ax_data(:) = axis%ax_data + endif + + if (present(name)) name = axis%name + if (present(longname)) longname = axis%longname + if (present(units)) units = axis%units + if (present(cartesian)) cartesian = axis%cartesian + if (present(ax_size)) ax_size = axis%ax_size + +end subroutine get_axis_info + !> Store information that can be used to create an attribute in a subsequent call to create_file. subroutine set_attribute_info(attribute, name, str_value) type(attribute_info), intent(inout) :: attribute !< A type with information about a named attribute @@ -2231,7 +2392,80 @@ subroutine MOM_io_init(param_file) call log_version(param_file, mdl, version) end subroutine MOM_io_init - +!> Returns the dimension variable information for a netCDF variable +subroutine get_var_axes_info(filename, fieldname, axes_info) + character(len=*), intent(in) :: filename !< A filename from which to read + character(len=*), intent(in) :: fieldname !< The name of the field to read + type(axis_info), dimension(4), intent(inout) :: axes_info !< A returned array of field axis information + + !! local variables + integer :: rcode + logical :: success + integer :: ncid, varid, ndims + integer :: id, jd, kd + integer, dimension(4) :: dims, dim_id + real :: missing_value + character(len=128) :: dim_name(4) + integer, dimension(1) :: start, count + !! cartesian axis data + real, allocatable, dimension(:) :: x + real, allocatable, dimension(:) :: y + real, allocatable, dimension(:) :: z + + + call open_file_to_read(filename, ncid, success=success) + + rcode = NF90_INQ_VARID(ncid, trim(fieldname), varid) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(fieldname)//& + " in file "//trim(filename)//" in hinterp_extrap") + + rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) + if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(fieldname)//& + " in file "//trim(filename)//" in hinterp_extrap") + if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(fieldname)//" in file "//trim(filename)// & + " has too few dimensions to be read as a 3-d array.") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& + " in file "//trim(filename)//" in hinterp_extrap") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& + " in file "//trim(filename)//" in hinterp_extrap") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& + " in file "//trim(filename)//" in hinterp_extrap") + allocate(x(id), y(jd), z(kd)) + + start = 1 ; count = 1 ; count(1) = id + rcode = NF90_GET_VAR(ncid, dim_id(1), x, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & + trim(fieldname)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") + start = 1 ; count = 1 ; count(1) = jd + rcode = NF90_GET_VAR(ncid, dim_id(2), y, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & + trim(fieldname)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") + start = 1 ; count = 1 ; count(1) = kd + rcode = NF90_GET_VAR(ncid, dim_id(3), z, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & + trim(fieldname//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") + + call set_axis_info(axes_info(1), name=trim(dim_name(1)), ax_size=id, ax_data=x,cartesian='X') + call set_axis_info(axes_info(2), name=trim(dim_name(2)), ax_size=jd, ax_data=y,cartesian='Y') + call set_axis_info(axes_info(3), name=trim(dim_name(3)), ax_size=kd, ax_data=z,cartesian='Z') + + call close_file_to_read(ncid, filename) + + deallocate(x,y,z) + +end subroutine get_var_axes_info !> \namespace mom_io !! !! This file contains a number of subroutines that manipulate diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 709fd27731..bef78a433a 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -223,9 +223,9 @@ function new_RandomNumberSequence(seed) result(twister) twister%state(0) = iand(seed, -1) do i = 1, blockSize - 1 ! ubound(twister%state) - twister%state(i) = 1812433253 * ieor(twister%state(i-1), & - ishft(twister%state(i-1), -30)) + i - twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines + twister%state(i) = 1812433253 * ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30)) + i + twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines end do twister%currentElement = blockSize end function new_RandomNumberSequence @@ -236,7 +236,7 @@ end function new_RandomNumberSequence integer function getRandomInt(twister) type(randomNumberSequence), intent(inout) :: twister !< The Mersenne Twister container - if(twister%currentElement >= blockSize) call nextState(twister) + if (twister%currentElement >= blockSize) call nextState(twister) getRandomInt = temper(twister%state(twister%currentElement)) twister%currentElement = twister%currentElement + 1 @@ -251,7 +251,7 @@ double precision function getRandomReal(twister) integer :: localInt localInt = getRandomInt(twister) - if(localInt < 0) then + if (localInt < 0) then getRandomReal = dble(localInt + 2.0d0**32)/(2.0d0**32 - 1.0d0) else getRandomReal = dble(localInt )/(2.0d0**32 - 1.0d0) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 7896962bc1..1328fd676c 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -69,14 +69,15 @@ module MOM_restart !> A restart registry and the control structure for restarts type, public :: MOM_restart_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: restart !< restart is set to .true. if the run has been started from a full restart !! file. Otherwise some fields must be initialized approximately. integer :: novars = 0 !< The number of restart fields that have been registered. integer :: num_obsolete_vars = 0 !< The number of obsolete restart fields that have been registered. - logical :: parallel_restartfiles !< If true, each PE writes its own restart file, - !! otherwise they are combined internally. - logical :: large_file_support !< If true, NetCDF 3.6 or later is being used - !! and large-file-support is enabled. + logical :: parallel_restartfiles !< If true, the IO layout is used to group processors that write + !! to the same restart file or each processor writes its own + !! (numbered) restart file. If false, a single restart file is + !! generated after internally combining output from all PEs. logical :: new_run !< If true, the input filenames and restart file existence will !! result in a new run that is not initialized from restart files. logical :: new_run_set = .false. !< If true, new_run has been determined for this restart_CS. @@ -137,7 +138,7 @@ module MOM_restart subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) character(*), intent(in) :: field_name !< Name of restart field that is no longer in use character(*), intent(in) :: replacement_name !< Name of replacement restart field, if applicable - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct CS%num_obsolete_vars = CS%num_obsolete_vars+1 CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name @@ -151,9 +152,9 @@ subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") call lock_check(CS, var_desc) @@ -184,9 +185,9 @@ subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") call lock_check(CS, var_desc) @@ -217,9 +218,9 @@ subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") call lock_check(CS, var_desc) @@ -249,9 +250,9 @@ subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") call lock_check(CS, var_desc) @@ -281,9 +282,9 @@ subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") call lock_check(CS, var_desc) @@ -316,7 +317,7 @@ subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, & type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing - type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -338,7 +339,7 @@ subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, & type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing - type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -360,7 +361,7 @@ subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, & type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing - type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -384,7 +385,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -393,7 +394,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_4d: Module must be initialized before "//& "it is used to register "//trim(name)) @@ -414,7 +415,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -423,7 +424,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_3d: Module must be initialized before "//& "it is used to register "//trim(name)) @@ -444,7 +445,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -454,9 +455,10 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd character(len=8) :: Zgrid - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_2d: Module must be initialized before "//& "it is used to register "//trim(name)) + zgrid = '1' ; if (present(z_grid)) zgrid = z_grid call lock_check(CS, name=name) @@ -475,7 +477,7 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, '1' if absent @@ -485,9 +487,10 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd character(len=8) :: hgrid - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_3d: Module must be initialized before "//& "it is used to register "//trim(name)) + hgrid = '1' ; if (present(hor_grid)) hgrid = hor_grid call lock_check(CS, name=name) @@ -506,14 +509,14 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_0d: Module must be initialized before "//& "it is used to register "//trim(name)) @@ -530,14 +533,15 @@ end subroutine register_restart_field_0d !> query_initialized_name determines whether a named field has been successfully !! read from a restart file yet. function query_initialized_name(name, CS) result(query_initialized) - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -563,13 +567,14 @@ end function query_initialized_name !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_0d(f_ptr, CS) result(query_initialized) real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -588,13 +593,14 @@ end function query_initialized_0d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_1d(f_ptr, CS) result(query_initialized) real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -614,13 +620,14 @@ end function query_initialized_1d function query_initialized_2d(f_ptr, CS) result(query_initialized) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -640,13 +647,14 @@ end function query_initialized_2d function query_initialized_3d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -666,13 +674,14 @@ end function query_initialized_3d function query_initialized_4d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -692,14 +701,15 @@ end function query_initialized_4d !! name has been initialized from a restart file. function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -726,14 +736,15 @@ end function query_initialized_0d_name function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -760,14 +771,15 @@ end function query_initialized_1d_name function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -794,14 +806,15 @@ end function query_initialized_2d_name function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -828,14 +841,15 @@ end function query_initialized_3d_name function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -863,8 +877,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ !! are to be written type(time_type), intent(in) :: time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct logical, optional, intent(in) :: time_stamped !< If present and true, add time-stamp !! to the restart file names character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile @@ -885,9 +898,10 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ ! to the name of files after the first. integer(kind=8) :: var_sz, size_in_file ! The size in bytes of each variable ! and the variables already in a file. - integer(kind=8) :: max_file_size = 2147483647_8 ! The maximum size in bytes - ! for any one file. With NetCDF3, - ! this should be 2 Gb or less. + integer(kind=8), parameter :: max_file_size = 4294967292_8 ! The maximum size in bytes for the + ! starting position of each variable in a file's record, + ! based on the use of NetCDF 3.6 or later. For earlier + ! versions of NetCDF, the value was 2147483647_8. integer :: start_var, next_var ! The starting variables of the ! current and next files. type(file_type) :: IO_handle ! The I/O handle of the open fileset @@ -905,15 +919,12 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ turns = CS%turns - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "save_restart: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) ! With parallel read & write, it is possible to disable the following... - - ! The maximum file size is 4294967292, according to the NetCDF documentation. - if (CS%large_file_support) max_file_size = 4294967292_8 - num_files = 0 next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke @@ -1071,8 +1082,7 @@ subroutine restore_state(filename, directory, day, G, CS) character(len=*), intent(in) :: directory !< The directory in which to find restart files type(time_type), intent(out) :: day !< The time of the restarted run type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct ! Local variables character(len=200) :: filepath ! The path (dir/file) to the file being opened. @@ -1100,8 +1110,9 @@ subroutine restore_state(filename, directory, day, G, CS) integer(kind=8) :: checksum_file ! The checksum value recorded in the input file. integer(kind=8) :: checksum_data ! The checksum value for the data that was read in. - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "restore_state: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) ! Get NetCDF ids for all of the restart files. @@ -1288,14 +1299,13 @@ function restart_files_exist(filename, directory, G, CS) !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: restart_files_exist !< The function result, which indicates whether !! any of the explicitly or automatically named !! restart files exist in directory integer :: num_files - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "restart_files_exist: Module must be initialized before it is used.") if ((LEN_TRIM(filename) == 1) .and. (filename(1:1) == 'F')) then @@ -1304,7 +1314,6 @@ function restart_files_exist(filename, directory, G, CS) num_files = get_num_restart_files(filename, directory, G, CS) endif restart_files_exist = (num_files > 0) - end function restart_files_exist !> determine_is_new_run determines from the value of filename and the existence @@ -1315,14 +1324,14 @@ function determine_is_new_run(filename, directory, G, CS) result(is_new_run) !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct logical :: is_new_run !< The function result, which indicates whether !! this is a new run, based on the value of !! filename and whether restart files exist - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "determine_is_new_run: Module must be initialized before it is used.") + if (LEN_TRIM(filename) > 1) then CS%new_run = .false. elseif (LEN_TRIM(filename) == 0) then @@ -1342,13 +1351,14 @@ end function determine_is_new_run !> is_new_run returns whether this is going to be a new run based on the !! information stored in CS by a previous call to determine_is_new_run. function is_new_run(CS) - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + logical :: is_new_run !< The function result, which had been stored in CS during !! a previous call to determine_is_new_run - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "is_new_run: Module must be initialized before it is used.") + if (.not.CS%new_run_set) call MOM_error(FATAL, "MOM_restart " // & "determine_is_new_run must be called for a restart file before is_new_run.") @@ -1363,8 +1373,8 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + type(file_type), dimension(:), & optional, intent(out) :: IO_handles !< The I/O handles of all opened files character(len=*), dimension(:), & @@ -1391,7 +1401,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, character(len=32) :: filename_appendix = '' ! Filename appendix for ensemble runs character(len=80) :: restartname - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "open_restart_units: Module must be initialized before it is used.") ! Get NetCDF ids for all of the restart files. @@ -1499,14 +1509,14 @@ function get_num_restart_files(filenames, directory, G, CS, file_paths) result(n !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct character(len=*), dimension(:), & optional, intent(out) :: file_paths !< The full paths to the restart files. + integer :: num_files !< The function result, the number of files (both automatically named !! restart files and others explicitly in filename) that have been opened - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "get_num_restart_files: Module must be initialized before it is used.") ! This call uses open_restart_units without the optional arguments needed to actually @@ -1538,16 +1548,16 @@ subroutine restart_init(param_file, CS, restart_root) endif allocate(CS) + CS%initialized = .true. + ! Determine whether all paramters are set to their default values. call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", CS%large_file_support, & - default=.true., do_not_log=.true.) call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, default=100, do_not_log=.true.) call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", CS%checksum_required, & default=.true., do_not_log=.true.) - all_default = ((.not.CS%parallel_restartfiles) .and. (CS%large_file_support) .and. & - (CS%max_fields == 100) .and. (CS%checksum_required)) + all_default = ((.not.CS%parallel_restartfiles) .and. (CS%max_fields == 100) .and. & + (CS%checksum_required)) if (.not.present(restart_root)) then call get_param(param_file, mdl, "RESTARTFILE", CS%restartfile, & default="MOM.res", do_not_log=.true.) @@ -1557,8 +1567,9 @@ subroutine restart_init(param_file, CS, restart_root) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "", all_default=all_default) call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & - "If true, each processor writes its own restart file, "//& - "otherwise a single restart file is generated", & + "If true, the IO layout is used to group processors that write to the same "//& + "restart file or each processor writes its own (numbered) restart file. "//& + "If false, a single restart file is generated combining output from all PEs.", & default=.false.) if (present(restart_root)) then @@ -1568,10 +1579,6 @@ subroutine restart_init(param_file, CS, restart_root) call get_param(param_file, mdl, "RESTARTFILE", CS%restartfile, & "The name-root of the restart file.", default="MOM.res") endif - call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", CS%large_file_support, & - "If true, use the file-size limits with NetCDF large "//& - "file support (4Gb), otherwise the limit is 2Gb.", & - default=.true.) call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, & "The maximum number of restart fields that can be used.", & default=100) @@ -1662,7 +1669,7 @@ subroutine restart_end(CS) end subroutine restart_end subroutine restart_error(CS) - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct character(len=16) :: num ! String for error messages diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index dbcd2405ec..cd339f410c 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -8,39 +8,47 @@ module MOM_unit_scaling implicit none ; private -public unit_scaling_init, unit_scaling_end, fix_restart_unit_scaling +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, T, R and Q, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the rescaled +! combination is a nondimensional variable, the notation would be "a slope [Z L-1 ~> nondim]", +! but if (as the case for the variables here), the rescaled combination is exactly 1, the right +! notation would be something like "a dimensional scaling factor [Z m-1 ~> 1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. + +public unit_scaling_init, unit_no_scaling_init, unit_scaling_end, fix_restart_unit_scaling !> Describes various unit conversion factors type, public :: unit_scale_type - real :: m_to_Z !< A constant that translates distances in meters to the units of depth. - 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 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. - real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram. - real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy. + real :: m_to_Z !< A constant that translates distances in meters to the units of depth [Z m-1 ~> 1] + real :: Z_to_m !< A constant that translates distances in the units of depth to meters [m Z-1 ~> 1] + real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths [L m-1 ~> 1] + real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters [m L-1 ~> 1] + real :: s_to_T !< A constant that translates time intervals in seconds to the units of time [T s-1 ~> 1] + real :: T_to_s !< A constant that translates the units of time to seconds [s T-1 ~> 1] + real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed [kg m-3 R-1 ~> 1] + real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density [R m3 kg-1 ~> 1] + real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram [J kg-1 Q-1 ~> 1] + real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy [Q kg J-1 ~> 1] ! These are useful combinations of the fundamental scale conversion factors above. - real :: Z_to_L !< Convert vertical distances to lateral lengths - real :: L_to_Z !< Convert lateral lengths to vertical distances - real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. - real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1. - real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. - real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. - real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. - real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1. - real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2. - ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z. - real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2. - real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1. - real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1. - real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2. - real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3. - real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. - ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2. + real :: Z_to_L !< Convert vertical distances to lateral lengths [L Z-1 ~> 1] + real :: L_to_Z !< Convert lateral lengths to vertical distances [Z L-1 ~> 1] + real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1 [T m L-1 s-1 ~> 1] + real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1 [L s T-1 m-1 ~> 1] + real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2 [L s2 T-2 m-1 ~> 1] + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T1 m2 Z-2 s-1 ~> 1] + real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1 [Z2 s T-1 m-2 ~> 1] + real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1 [Q R Z m2 T-1 W-1 ~> 1] + real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2 [W T Q-1 R-1 Z-1 m-2 ~> 1] + ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z [R Z m2 kg-1 ~> 1] + real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2 [kg R-1 Z-1 m-2 ~> 1] + real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1 [R Z m2 s T-1 kg-1 ~> 1] + real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1 [T kg R-1 Z-1 m-2 s-1 ~> 1] + real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2 [W T3 R-1 Z-3 m-2 ~> 1] + real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3 [R Z3 m2 T-3 W-1 ~> 1] + real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa [Pa T2 R-1 L-2 ~> 1] + ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2 [R L2 T-2 Pa-1 ~> 1] ! These are used for changing scaling across restarts. real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. @@ -130,7 +138,32 @@ subroutine unit_scaling_init( param_file, US ) US%Q_to_J_kg = 1.0 * Q_Rescale_factor US%J_kg_to_Q = 1.0 / Q_Rescale_factor - ! These are useful combinations of the fundamental scale conversion factors set above. + call set_unit_scaling_combos(US) +end subroutine unit_scaling_init + +!> Allocates and initializes the ocean model unit scaling type to unscaled values. +subroutine unit_no_scaling_init(US) + type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + + if (associated(US)) call MOM_error(FATAL, & + 'unit_scaling_init: called with an associated US pointer.') + allocate(US) + + US%Z_to_m = 1.0 ; US%m_to_Z = 1.0 + US%L_to_m = 1.0 ; US%m_to_L = 1.0 + US%T_to_s = 1.0 ; US%s_to_T = 1.0 + US%R_to_kg_m3 = 1.0 ; US%kg_m3_to_R = 1.0 + US%Q_to_J_kg = 1.0 ; US%J_kg_to_Q = 1.0 + + call set_unit_scaling_combos(US) +end subroutine unit_no_scaling_init + +!> This subroutine sets useful combinations of the fundamental scale conversion factors +!! in the unit scaling type. +subroutine set_unit_scaling_combos(US) + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type + + ! Convert vertical to horizontal length scales and the reverse: US%Z_to_L = US%Z_to_m * US%m_to_L US%L_to_Z = US%L_to_m * US%m_to_Z ! Horizontal velocities: @@ -159,7 +192,7 @@ subroutine unit_scaling_init( param_file, US ) ! It does not seem like US%Pa_to_RL2_T2 would be used enough in MOM6 to justify its existence. ! US%Pa_to_RL2_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 -end subroutine unit_scaling_init +end subroutine set_unit_scaling_combos !> Set the unit scaling factors for output to restart files to the unit scaling !! factors for this run. diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index c9200cf41c..9df994448b 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -20,6 +20,7 @@ module MOM_write_cputime !> A control structure that regulates the writing of CPU time type, public :: write_cputime_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: maxcpu !< The maximum amount of cpu time per processor !! for which MOM should run before saving a restart !! file and quiting with a return value that @@ -71,6 +72,8 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) CS%prev_cputime = new_cputime endif + CS%initialized = .true. + ! Read all relevant parameters and write them to the model log. ! Determine whether all paramters are set to their default values. @@ -141,6 +144,9 @@ subroutine write_cputime(day, n, CS, nmax, call_end) if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "write_cputime: Module must be initialized before it is used.") + call SYSTEM_CLOCK(new_cputime, CLOCKS_PER_SEC, MAX_TICKS) ! The following lines extract useful information even if the clock has rolled ! over, assuming a 32-bit SYSTEM_CLOCK. With more bits, rollover is essentially diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index cfe75ba380..13af5a936a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -21,7 +21,6 @@ module MOM_ice_shelf use MOM_domains, only : MOM_domains_init, pass_var, pass_vector, clone_MOM_domain use MOM_domains, only : TO_ALL, CGRID_NE, BGRID_NE, CORNER use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_grid, only : MOM_grid_init, ocean_grid_type @@ -157,7 +156,7 @@ module MOM_ice_shelf real :: input_thickness !< Ice thickness at an upstream open boundary [m]. type(time_type) :: Time !< The component's time. - type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the + type(EOS_type) :: eqn_of_state !< Type that indicates the !! equation of state to use. logical :: active_shelf_dynamics !< True if the ice shelf mass changes as a result !! the dynamic ice-shelf model. @@ -250,10 +249,10 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) exch_vel_s !< Sub-shelf salt exchange velocity [Z T-1 ~> m s-1] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & - mass_flux !< Total mass flux of freshwater across the ice-ocean interface. [R Z L2 T-1 ~> kg/s] + mass_flux !< Total mass flux of freshwater across the ice-ocean interface. [R Z L2 T-1 ~> kg s-1] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & haline_driving !< (SSS - S_boundary) ice-ocean - !! interface, positive for melting and negative for freezing. + !! interface, positive for melting and negative for freezing [ppt]. !! This is computed as part of the ISOMIP diagnostics. real, parameter :: VK = 0.40 !< Von Karman's constant - dimensionless real :: ZETA_N = 0.052 !> The fraction of the boundary layer over which the @@ -1159,7 +1158,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes) if (bal_frac(i,j) > 0.0) then ! evap is negative, and vprec has units of [R Z T-1 ~> kg m-2 s-1] fluxes%vprec(i,j) = -balancing_flux - fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! [ Q R Z T-1 ~> W /m^2 ] + fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! [Q R Z T-1 ~> W m-2] fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! [kgSalt/kg R Z T-1 ~> kgSalt m-2 s-1] endif enddo ; enddo @@ -1306,9 +1305,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call create_dyn_horgrid(dG, CS%Grid%HI) call clone_MOM_domain(CS%Grid%Domain,dG%Domain) call set_grid_metrics(dG,param_file,CS%US) - ! Set up the bottom depth, G%D either analytically or from file - call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file) - call rescale_dyn_horgrid_bathymetry(dG, CS%US%Z_to_m) + ! Set up the bottom depth, dG%bathyT, either analytically or from file + call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file, CS%US) call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) call destroy_dyn_horgrid(dG) ! endif @@ -1409,12 +1407,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "If true, user specifies a constant nondimensional heat-transfer coefficient "//& "(GAMMA_T_3EQ), from which the default salt-transfer coefficient is set "//& "as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.) - if (CS%threeeq) then - call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & + call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & "If SHELF_S_ROOT = True, salinity at the ice/ocean interface (Sbdry) "//& "is computed from a quadratic equation. Otherwise, the previous "//& - "interactive method to estimate Sbdry is used.", default=.false.) - else + "interactive method to estimate Sbdry is used.", & + default=.false., do_not_log=.not.CS%threeeq) + if (.not.CS%threeeq) then call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", CS%gamma_t, & "If SHELF_THREE_EQN is false, this the fixed turbulent "//& "exchange velocity at the ice-ocean interface.", & @@ -2034,11 +2032,12 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) end subroutine update_shelf_mass !> Save the ice shelf restart file -subroutine ice_shelf_query(CS, G, frac_shelf_h) +subroutine ice_shelf_query(CS, G, frac_shelf_h, mass_shelf) type(ice_shelf_CS), pointer :: CS !< ice shelf control structure type(ocean_grid_type), intent(in) :: G !< A pointer to an ocean grid control structure. - real, optional, dimension(SZI_(G),SZJ_(G)) :: frac_shelf_h !< - !< Ice shelf area fraction [nodim]. + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: frac_shelf_h !< Ice shelf area fraction [nodim]. + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: mass_shelf ! kg m-2] + integer :: i, j @@ -2049,6 +2048,13 @@ subroutine ice_shelf_query(CS, G, frac_shelf_h) enddo ; enddo endif + if (present(mass_shelf)) then + do j=G%jsd,G%jed ; do i=G%isd,G%ied + mass_shelf(i,j) = 0.0 + if (G%areaT(i,j)>0.) mass_shelf(i,j) = CS%ISS%mass_shelf(i,j) + enddo ; enddo + endif + end subroutine ice_shelf_query !> Save the ice shelf restart file diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 2a3066dfbd..ef4ad7b6d9 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -448,7 +448,7 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & type(diag_type), pointer :: diag => NULL() MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -537,7 +537,7 @@ integer function register_MOM_IS_static_field(module_name, field_name, axes, & type(diag_ctrl), pointer :: diag_cs !< A structure that is used to regulate diagnostic output MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -582,8 +582,8 @@ function i2s(a, n_in) character(len=15) :: i2s_temp integer :: i,n - n=size(a) - if(present(n_in)) n = n_in + n = size(a) + if (present(n_in)) n = n_in i2s = '' do i=1,n diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 7c7705ef35..8fb674e36c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -80,7 +80,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, often in [R L4 Z T-1 ~> kg m2 s-1]. real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity, - !!often in [R-1/3 L-2/3 Z-1/3 T-1 ~> kg-1/3 m-1/3 s-1]. + !! often in [kg-1/3 m-1/3 s-1]. real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries !! [L yr-1 ~> m yr-1] @@ -228,7 +228,7 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. @@ -260,9 +260,9 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0 ) ! [degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Units?] + allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3s-1] allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Units?] + allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) @@ -553,8 +553,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) - !initialize ice flow velocities from file - call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & + !initialize ice flow characteristic (velocities, bed elevation under the grounded part, etc) from file + call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, & G, US, param_file) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) call pass_var(CS%bed_elev, G%domain,CENTER) @@ -567,9 +567,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) ! I think that the conversion factors for the next two diagnostics are wrong. - RWH CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesB1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%RL2_T2_to_Pa) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesB1, Time, & - 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) + 'y-driving stress of ice', 'kPa', conversion=1.e-3*US%RL2_T2_to_Pa) CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesB1, Time, & 'mask for u-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesB1, Time, & @@ -579,9 +579,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & - 'viscosity', 'm', conversion=1e-6*US%Z_to_m) + 'vi-viscosity', 'Pa s-1 m', conversion=US%RL2_T2_to_Pa*US%L_T_to_m_s) !vertically integrated viscosity CS%id_taub = register_diag_field('ice_shelf_model','taub_beta',CS%diag%axesT1, Time, & - 'taub', 'Pa yr m-1', conversion=1e-6*US%Z_to_m) + 'taub', 'MPa', conversion=1e-6*US%RL2_T2_to_Pa) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) endif @@ -673,7 +673,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - + real, dimension(SZDIB_(G),SZDJB_(G)) ::taud_x,taud_y ! Pa] + real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc ! Pa s-1 m] + real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr ! Pa] integer :: iters logical :: update_ice_vel, coupled_GL @@ -706,12 +709,24 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) ! if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_taudx_shelf > 0) then + taud_x(:,:) = CS%taudx_shelf(:,:)*G%IareaT(:,:) + call post_data(CS%id_taudx_shelf,taud_x , CS%diag) + endif + if (CS%id_taudy_shelf > 0) then + taud_y(:,:) = CS%taudy_shelf(:,:)*G%IareaT(:,:) + call post_data(CS%id_taudy_shelf,taud_y , CS%diag) + endif if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) + if (CS%id_visc_shelf > 0) then + ice_visc(:,:)=CS%ice_visc(:,:)*G%IareaT(:,:) + call post_data(CS%id_visc_shelf, ice_visc,CS%diag) + endif + if (CS%id_taub > 0) then + basal_tr(:,:) = CS%basal_traction(:,:)*G%IareaT(:,:) + call post_data(CS%id_taub, basal_tr,CS%diag) + endif !! if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -874,6 +889,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) > 0) then float_cond(i,j) = 1.0 CS%ground_frac(i,j) = 1.0 + CS%OD_av(i,j) =0.0 endif enddo enddo @@ -960,7 +976,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i !! begin loop - do iter=1,100 + do iter=1,50 call ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) @@ -1378,7 +1394,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, LB, time_step, hmask, h0, h_after integer :: i, j integer :: ish, ieh, jsh, jeh - real :: u_face ! Zonal velocity at a face [L Z-1 ~> m s-1] + real :: u_face ! Zonal velocity at a face [L T-1 ~> m s-1] real :: h_face ! Thickness at a face for transport [Z ~> m] real :: slope_lim ! The value of the slope limiter, in the range of 0 to 2 [nondim] @@ -1461,7 +1477,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, LB, time_step, hmask, h0, h_after integer :: i, j integer :: ish, ieh, jsh, jeh - real :: v_face ! Pseudo-meridional velocity at a face [L Z-1 ~> m s-1] + real :: v_face ! Pseudo-meridional velocity at a face [L T-1 ~> m s-1] real :: h_face ! Thickness at a face for transport [Z ~> m] real :: slope_lim ! The value of the slope limiter, in the range of 0 to 2 [nondim] @@ -1775,7 +1791,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) intent(inout) :: taudx !< X-direction driving stress at q-points [kg L s-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: taudy !< Y-direction driving stress at q-points [kg L s-2 ~> kg m s-2] - ! This will become [R L3 Z T-2 ~> kg m s-2] + ! This will become [R L3 Z T-2 ~> kg m s-2] ! driving stress! @@ -1790,12 +1806,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation [Z ~> m]. BASE ! basal elevation of shelf/stream [Z ~> m]. + real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian + ! quadrature points surrounding the cell vertices [m-1]. real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] - real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> m s-1] + real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] - real :: dxh, dyh ! Local grid spacing [L ~> m] + real :: dxh, dyh,Dx,Dy ! Local grid spacing [L ~> m] real :: grav ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq @@ -1813,6 +1831,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset + rho = CS%density_ice rhow = CS%density_ocean_avg grav = CS%g_Earth @@ -1821,13 +1840,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! or is this faster? BASE(:,:) = -CS%bed_elev(:,:) + OD(:,:) - S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) - + S(:,:) = -CS%bed_elev(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded do j=jsc-G%domain%njhalo,jec+G%domain%njhalo do i=isc-G%domain%nihalo,iec+G%domain%nihalo if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) + else + S(i,j)=ISS%h_shelf(i,j)-CS%bed_elev(i,j) endif enddo enddo @@ -1838,7 +1858,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) sy = 0 dxh = G%dxT(i,j) dyh = G%dyT(i,j) - + Dx=dxh + Dy=dyh if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell ! calculate sx @@ -1857,12 +1878,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) else ! interior if (ISS%hmask(i+1,j) == 1) then cnt = cnt+1 + Dx =dxh+ G%dxT(i+1,j) sx = S(i+1,j) else sx = S(i,j) endif if (ISS%hmask(i-1,j) == 1) then cnt = cnt+1 + Dx =dxh+ G%dxT(i-1,j) sx = sx - S(i-1,j) else sx = sx - S(i,j) @@ -1870,7 +1893,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (cnt == 0) then sx = 0 else - sx = sx / (cnt * dxh) + sx = sx / ( Dx) endif endif @@ -1892,6 +1915,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) else ! interior if (ISS%hmask(i,j+1) == 1) then cnt = cnt+1 + Dy =dyh+ G%dyT(i,j+1) sy = S(i,j+1) else sy = S(i,j) @@ -1899,13 +1923,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (ISS%hmask(i,j-1) == 1) then cnt = cnt+1 sy = sy - S(i,j-1) + Dy =dyh+ G%dyT(i,j-1) else sy = sy - S(i,j) endif if (cnt == 0) then sy = 0 else - sy = sy / (cnt * dyh) + sy = sy / (Dy) endif endif @@ -1930,10 +1955,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif if (CS%ground_frac(i,j) == 1) then -! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2) +! neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2)) neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 + neumann_val = (.5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2) endif if ((CS%u_face_mask(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then @@ -1971,7 +1996,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) endif enddo enddo - end subroutine calc_shelf_driving_stress subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) @@ -2528,8 +2552,8 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) end subroutine apply_boundary_values + !> Update depth integrated viscosity, based on horizontal strain rates, and also update the -!! nonlinear part of the basal traction. subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe @@ -2540,9 +2564,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) intent(inout) :: u_shlf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. - + real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian + ! quadrature points surrounding the cell vertices [m-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve -! so there is an "upper" and "lower" bilinear viscosity ! also this subroutine updates the nonlinear part of the basal traction @@ -2553,7 +2577,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) real :: Visc_coef, n_g real :: ux, uy, vx, vy real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] - real, dimension(8,4) :: Phi +! real, dimension(8,4) :: Phi real, dimension(2) :: xquad ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] @@ -2566,6 +2590,12 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset + allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0) + + do j=jsc,jec ; do i=isc,iec + call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) + enddo ; enddo + n_g = CS%n_glen; eps_min = CS%eps_glen_min CS%ice_visc(:,:)=1e22 ! Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) @@ -2575,21 +2605,35 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%AGlen_visc(i,j))**(-1./CS%n_glen) - ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & - (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & - (v_shlf(I-1,J) + (v_shlf(I-1,J-1) + v_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) - uy = ((u_shlf(I,J) + (u_shlf(I-1,J) + u_shlf(I+1,J))) - & - (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) - vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & - (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) + do iq=1,2 ; do jq=1,2 + + ux = ( (u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & + u_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + & + (u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + & + u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) ) + + vx = ( (v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & + v_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + & + (v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + & + v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) ) + + uy = ( (u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + & + u_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + & + (u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & + u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) + + vy = ( (v_shlf(I-1,j-1) * Phi(2,2*(jq-1)+iq,i,j) + & + v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + & + (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & + v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) + enddo ; enddo ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) endif enddo enddo - + deallocate(Phi) end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 469cba39ce..7cc3c020a3 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -149,14 +149,13 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U enddo ; enddo endif - if (len_sidestress > 0.) then do j=jsc,jec do i=isc,iec ! taper ice shelf in area where there is no sidestress - ! but do not interfere with hmask - if (G%geoLonCv(i,j) > len_sidestress) then + if ((len_sidestress > 0.) .and. (G%geoLonCv(i,j) > len_sidestress)) then udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) if (udh <= 25.0) then h_shelf(i,j) = 0.0 @@ -180,7 +179,6 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U endif enddo enddo - endif end subroutine initialize_ice_thickness_from_file !> Initialize ice shelf thickness for a channel configuration @@ -397,13 +395,13 @@ end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file -subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& - hmask,h_shelf, G, US, PF) -!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,ice_visc,float_cond,& +!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& ! hmask,h_shelf, G, US, PF) +subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& + G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: bed_elev !< The ice shelf u velocity [Z ~> m]. + intent(inout) :: bed_elev !< The bed elevation [Z ~> m]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & @@ -412,12 +410,12 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< A mask indicating which tracer points are +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(in) :: h_shelf !< A mask indicating which tracer points are +! !! partly or fully covered by an ice-shelf type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -453,10 +451,10 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& "The name of the thickness variable in ICE_VELOCITY_FILE.", & default="viscosity") call get_param(PF, mdl, "BED_TOPO_FILE", bed_topo_file, & - "The file from which the velocity is read.", & + "The file from which the bed elevation is read.", & default="ice_shelf_vel.nc") call get_param(PF, mdl, "BED_TOPO_VARNAME", bed_varname, & - "The name of the thickness variable in ICE_VELOCITY_FILE.", & + "The name of the thickness variable in ICE_INPUT_FILE.", & default="depth") if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) @@ -470,15 +468,8 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& filename = trim(inputdir)//trim(bed_topo_file) call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.) - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec +! isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec -! do j=jsc,jec -! do i=isc,iec -! if (hmask(i,j) == 1.) then -! ice_visc(i,j) = ice_visc(i,j) * (G%areaT(i,j) * h_shelf(i,j)) -! endif -! enddo -! enddo end subroutine initialize_ice_flow_from_file @@ -510,7 +501,7 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness + intent(in) :: h_shelf !< Ice-shelf thickness type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -535,9 +526,9 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask call get_param(PF, mdl, "ICE_THICKNESS_FILE", icethick_file, & "The file from which the ice-shelf thickness is read.", & default="ice_shelf_thick.nc") - call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", h_varname, & - "The name of the thickness variable in ICE_THICKNESS_FILE.", & - default="h_shelf") +! call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", h_varname, & +! "The name of the thickness variable in ICE_THICKNESS_FILE.", & +! default="h_shelf") call get_param(PF, mdl, "ICE_THICKNESS_MASK_VARNAME", hmsk_varname, & "The name of the icethickness mask variable in ICE_THICKNESS_FILE.", & default="h_mask") @@ -574,7 +565,7 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask call MOM_read_data(filename,trim(vmask_varname), vmask, G%Domain, position=CORNER,scale=1.) filename = trim(inputdir)//trim(icethick_file) - call MOM_read_data(filename, trim(h_varname), h_shelf, G%Domain, scale=US%m_to_Z) +! call MOM_read_data(filename, trim(h_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(hmsk_varname), hmask, G%Domain, scale=1.) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 4f04fb285f..286dfa7d95 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -48,9 +48,6 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept ! This include declares and sets the variable "version". #include "version_variable.h" integer :: nz - type(EOS_type), pointer :: eos => NULL() - - if (associated(tv%eqn_of_state)) eos => tv%eqn_of_state nz = GV%ke @@ -86,17 +83,17 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept case ("linear") call set_coord_linear(GV%Rlay, GV%g_prime, GV, US, PF) case ("ts_ref") - call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("ts_profile") - call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("ts_range") - call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) 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, US, PF, eos) + call user_set_coord(GV%Rlay, GV%g_prime, GV, US, PF) case ("BFB") - call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) + call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF) 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: "// & @@ -208,7 +205,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state !! [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 to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. @@ -258,7 +255,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s !! 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 to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. @@ -305,20 +302,20 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta !! 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 to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. ! Local variables real, dimension(GV%ke) :: T0, S0, Pref real :: S_Ref, S_Light, S_Dense ! Salinity range parameters [ppt]. - real :: T_Ref, T_Light, T_Dense ! Temperature range parameters [decC]. + real :: T_Ref, T_Light, T_Dense ! Temperature range parameters [degC]. real :: res_rat ! The ratio of density space resolution in the denser part ! of the range to that in the lighter part of the range. ! Setting this greater than 1 increases the resolution for - ! the denser water. + ! the denser water [nondim]. real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. - real :: a1, frac_dense, k_frac + real :: a1, frac_dense, k_frac ! Nondimensional temporary variables [nondim] integer :: k, nz, k_light character(len=40) :: mdl = "set_coord_from_TS_range" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 069d576b2c..f0fb1d23f9 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -6,7 +6,7 @@ module MOM_fixed_initialization use MOM_debugging, only : hchksum, qchksum, uvchksum use MOM_domains, only : pass_var -use MOM_dyn_horgrid, only : dyn_horgrid_type, rescale_dyn_horgrid_bathymetry +use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type @@ -82,7 +82,6 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF, US) -! call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) @@ -144,7 +143,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) endif ! Calculate the value of the Coriolis parameter at the latitude ! -! of the q grid points [s-1]. +! of the q grid points [T-1 ~> s-1]. call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US) ! Calculate the components of grad f (beta) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) @@ -167,27 +166,23 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed !> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this -!! point the topography is in units of [m], but this can be changed later. +!! point the topography is in units of [Z ~> m] or [m], depending on the presence of US. subroutine MOM_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m] + intent(out) :: D !< Ocean bottom depth [Z ~> m] or [m] type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model [m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] or [m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. ! Local variables - real :: m_to_Z, Z_to_m ! Dimensional rescaling factors character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - Z_to_m = 1.0 ; if (present(US)) Z_to_m = US%Z_to_m - call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& " \t file - read bathymetric information from the file \n"//& @@ -216,7 +211,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - max_depth = -1.e9*m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=m_to_Z) + max_depth = -1.e9*US%m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=US%m_to_Z) select case ( trim(config) ) case ("file"); call initialize_topography_from_file(D, G, PF, US) case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) @@ -241,11 +236,11 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*Z_to_m, & + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*US%Z_to_m, & "The maximum depth of the ocean.", units="m") else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*Z_to_m, & + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*US%Z_to_m, & "The (diagnosed) maximum depth of the ocean.", units="m", like_default=.true.) endif if (trim(config) /= "DOME") then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 81e7b66d7a..498e1915ba 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -26,14 +26,14 @@ module MOM_grid_initialize ! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Global positioning system (aka container for information to describe the grid) -type, public :: GPS ; private +type, private :: GPS ; private real :: len_lon !< The longitudinal or x-direction length of the domain. real :: len_lat !< The latitudinal or y-direction length of the domain. real :: west_lon !< The western longitude of the domain or the equivalent !! starting value for the x-axis. real :: south_lat !< The southern latitude of the domain or the equivalent !! starting value for the y-axis. - real :: Rad_Earth !< The radius of the Earth [m]. + real :: Rad_Earth_L !< The radius of the Earth in rescaled units [L ~> m] real :: Lat_enhance_factor !< The amount by which the meridional resolution !! is enhanced within LAT_EQ_ENHANCE of the equator. real :: Lat_eq_enhance !< The latitude range to the north and south of the equator @@ -58,10 +58,11 @@ module MOM_grid_initialize subroutine set_grid_metrics(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" logical :: debug character(len=256) :: config @@ -82,6 +83,7 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" + G%Rad_Earth_L = -1.0*US%m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 select case (trim(config)) case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) @@ -93,6 +95,15 @@ subroutine set_grid_metrics(G, param_file, US) case default ; call MOM_error(FATAL, "MOM_grid_init: set_grid_metrics "//& "Unrecognized grid configuration "//trim(config)) end select + if (G%Rad_Earth_L <= 0.0) then + ! The grid metrics were set with an option that does not explicitly initialize Rad_Earth. + ! ### Rad_Earth should be read as in: + ! call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & + ! "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) + ! but for now it is being set via a hard-coded value to reproduce current behavior. + G%Rad_Earth_L = 6.378e6*US%m_to_L + endif + G%Rad_Earth = US%L_to_m*G%Rad_Earth_L ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") @@ -111,39 +122,35 @@ end subroutine set_grid_metrics subroutine grid_metrics_chksum(parent, G, US) character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: halo - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m halo = min(G%ied-G%iec, G%jed-G%jec, 1) call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, & - haloshift=halo, scale=L_to_m, scalar_pair=.true.) + haloshift=halo, scale=US%L_to_m, scalar_pair=.true.) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) + call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=US%L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=US%L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=US%L_to_m) call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, & - haloshift=halo, scale=m_to_L, scalar_pair=.true.) + haloshift=halo, scale=US%m_to_L, scalar_pair=.true.) - call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=m_to_L) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=US%m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=US%m_to_L) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=US%m_to_L) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) + call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=US%L_to_m**2) + call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=US%L_to_m**2) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) + call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=US%m_to_L**2) + call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=US%m_to_L**2) call hchksum(G%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -162,8 +169,8 @@ end subroutine grid_metrics_chksum !> Sets the grid metrics from a mosaic file. subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 @@ -181,7 +188,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -191,7 +197,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) @@ -315,16 +320,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) + G%dxT(i,j) = US%m_to_L*dxT(i,j) ; G%dyT(i,j) = US%m_to_L*dyT(i,j) ; G%areaT(i,j) = US%m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) + G%dxCu(I,j) = US%m_to_L*dxCu(I,j) ; G%dyCu(I,j) = US%m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) + G%dxCv(i,J) = US%m_to_L*dxCv(i,J) ; G%dyCv(i,J) = US%m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = m_to_L*dxBu(I,J) ; G%dyBu(I,J) = m_to_L*dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) + G%dxBu(I,J) = US%m_to_L*dxBu(I,J) ; G%dyBu(I,J) = US%m_to_L*dyBu(I,J) ; G%areaBu(I,J) = US%m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -379,18 +384,16 @@ end subroutine set_grid_metrics_from_mosaic !! sets of points. subroutine set_grid_metrics_cartesian(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dx_everywhere, dy_everywhere ! Grid spacings [m]. - real :: I_dx, I_dy ! Inverse grid spacings [m-1]. + real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. + real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. real :: PI - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -401,8 +404,6 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -423,8 +424,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call get_param(param_file, mdl, "LENLON", G%len_lon, & "The longitudinal or x-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) - call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" @@ -462,14 +463,14 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) enddo if (units_temp(1:1) == 'k') then ! Axes are measured in km. - dx_everywhere = 1000.0 * G%len_lon / (REAL(niglobal)) - dy_everywhere = 1000.0 * G%len_lat / (REAL(njglobal)) + dx_everywhere = 1000.0*US%m_to_L * G%len_lon / (REAL(niglobal)) + dy_everywhere = 1000.0*US%m_to_L * G%len_lat / (REAL(njglobal)) elseif (units_temp(1:1) == 'm') then ! Axes are measured in m. - dx_everywhere = G%len_lon / (REAL(niglobal)) - dy_everywhere = G%len_lat / (REAL(njglobal)) + dx_everywhere = US%m_to_L*G%len_lon / (REAL(niglobal)) + dy_everywhere = US%m_to_L*G%len_lat / (REAL(njglobal)) else ! Axes are measured in degrees of latitude and longitude. - dx_everywhere = G%Rad_Earth * G%len_lon * PI / (180.0 * niglobal) - dy_everywhere = G%Rad_Earth * G%len_lat * PI / (180.0 * njglobal) + dx_everywhere = G%Rad_Earth_L * G%len_lon * PI / (180.0 * niglobal) + dy_everywhere = G%Rad_Earth_L * G%len_lat * PI / (180.0 * njglobal) endif I_dx = 1.0 / dx_everywhere ; I_dy = 1.0 / dy_everywhere @@ -477,30 +478,30 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = grid_lonB(I) ; G%geoLatBu(I,J) = grid_latB(J) - G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = L_to_m*I_dx - G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = L_to_m*I_dy - G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy + G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx + G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy + G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = I_dx * I_dy enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) - G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = L_to_m*I_dx - G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = L_to_m*I_dy - G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy + G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx + G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy + G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) - G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = L_to_m*I_dx - G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*I_dy + G%dxCu(I,j) = dx_everywhere ; G%IdxCu(I,j) = I_dx + G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) - G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = L_to_m*I_dx - G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = L_to_m*I_dy + G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx + G%dyCv(i,J) = dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") @@ -517,8 +518,8 @@ end subroutine set_grid_metrics_cartesian !! sets of points. subroutine set_grid_metrics_spherical(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -527,7 +528,6 @@ subroutine set_grid_metrics_spherical(G, param_file, US) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -537,7 +537,6 @@ subroutine set_grid_metrics_spherical(G, param_file, US) i_offset = G%idg_offset ; j_offset = G%jdg_offset call callTree_enter("set_grid_metrics_spherical(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. @@ -555,8 +554,8 @@ subroutine set_grid_metrics_spherical(G, param_file, US) call get_param(param_file, mdl, "LENLON", G%len_lon, & "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) dLon = G%len_lon/G%Domain%niglobal dLat = G%len_lat/G%Domain%njglobal @@ -600,9 +599,9 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxBu(I,J) = m_to_L*G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di -! G%dxBu(I,J) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) - G%dyBu(I,J) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxBu(I,J) = G%Rad_Earth_L * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di +! G%dxBu(I,J) = G%Rad_Earth_L * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) + G%dyBu(I,J) = G%Rad_Earth_L * dLat*PI_180 G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo @@ -612,9 +611,9 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCv(i,J) = m_to_L*G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di -! G%dxCv(i,J) = m_to_L*G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) - G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxCv(i,J) = G%Rad_Earth_L * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di +! G%dxCv(i,J) = G%Rad_Earth_L * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) + G%dyCv(i,J) = G%Rad_Earth_L * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -623,9 +622,9 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCu(I,j) = m_to_L*G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di -! G%dxCu(I,j) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyCu(I,j) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxCu(I,j) = G%Rad_Earth_L * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di +! G%dxCu(I,j) = G%Rad_Earth_L * dLon*PI_180 * COS( latitude ) + G%dyCu(I,j) = G%Rad_Earth_L * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -634,13 +633,13 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxT(i,j) = m_to_L*G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di -! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyT(i,j) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxT(i,j) = G%Rad_Earth_L * COS( G%geoLatT(i,j)*PI_180 ) * dL_di +! G%dxT(i,j) = G%Rad_Earth_L * dLon*PI_180 * COS( latitude ) + G%dyT(i,j) = G%Rad_Earth_L * dLat*PI_180 ! latitude = G%geoLatCv(i,J)*PI_180 ! In radians ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians -! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) +! G%areaT(i,j) = Rad_Earth_L**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) enddo ; enddo @@ -656,8 +655,8 @@ end subroutine set_grid_metrics_spherical !! sets of points. subroutine set_grid_metrics_mercator(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -677,7 +676,6 @@ subroutine set_grid_metrics_mercator(G, param_file, US) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -696,7 +694,6 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI @@ -713,11 +710,12 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call get_param(param_file, mdl, "LENLON", GP%len_lon, & "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) G%south_lat = GP%south_lat ; G%len_lat = GP%len_lat G%west_lon = GP%west_lon ; G%len_lon = GP%len_lon - G%Rad_Earth = GP%Rad_Earth + G%Rad_Earth_L = GP%Rad_Earth_L + call get_param(param_file, mdl, "ISOTROPIC", GP%isotropic, & "If true, an isotropic grid on a sphere (also known as "//& "a Mercator grid) is used. With an isotropic grid, the "//& @@ -826,8 +824,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = xq(I,J)*180.0/PI G%geoLatBu(I,J) = yq(I,J)*180.0/PI - G%dxBu(I,J) = m_to_L*ds_di(xq(I,J), yq(I,J), GP) - G%dyBu(I,J) = m_to_L*ds_dj(xq(I,J), yq(I,J), GP) + G%dxBu(I,J) = ds_di(xq(I,J), yq(I,J), GP) + G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) @@ -836,8 +834,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = xh(i,j)*180.0/PI G%geoLatT(i,j) = yh(i,j)*180.0/PI - G%dxT(i,j) = m_to_L*ds_di(xh(i,j), yh(i,j), GP) - G%dyT(i,j) = m_to_L*ds_dj(xh(i,j), yh(i,j), GP) + G%dxT(i,j) = ds_di(xh(i,j), yh(i,j), GP) + G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) @@ -846,20 +844,20 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = xu(I,j)*180.0/PI G%geoLatCu(I,j) = yu(I,j)*180.0/PI - G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) - G%dyCu(I,j) = m_to_L*ds_dj(xu(I,j), yu(I,j), GP) + G%dxCu(I,j) = ds_di(xu(I,j), yu(I,j), GP) + G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI - G%dxCv(i,J) = m_to_L*ds_di(xv(i,J), yv(i,J), GP) - G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) + G%dxCv(i,J) = ds_di(xv(i,J), yv(i,J), GP) + G%dyCv(i,J) = ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo if (.not.simple_area) then do j=JsdB+1,jed ; do i=IsdB+1,ied - G%areaT(I,J) = m_to_L**2*GP%Rad_Earth**2 * & + G%areaT(I,J) = GP%Rad_Earth_L**2 * & (dL(xq(I-1,J-1),xq(I-1,J),yq(I-1,J-1),yq(I-1,J)) + & (dL(xq(I-1,J),xq(I,J),yq(I-1,J),yq(I,J)) + & (dL(xq(I,J),xq(I,J-1),yq(I,J),yq(I,J-1)) + & @@ -884,31 +882,31 @@ subroutine set_grid_metrics_mercator(G, param_file, US) end subroutine set_grid_metrics_mercator -!> This function returns the grid spacing in the logical x direction. +!> This function returns the grid spacing in the logical x direction in [L ~> m]. function ds_di(x, y, GP) real, intent(in) :: x !< The longitude in question real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: ds_di - ! Local variables - ds_di = GP%Rad_Earth * cos(y) * dx_di(x,GP) + real :: ds_di ! The returned grid spacing [L ~> m] + + ds_di = GP%Rad_Earth_L * cos(y) * dx_di(x,GP) ! In general, this might be... - ! ds_di = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + & + ! ds_di = GP%Rad_Earth_L * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + & ! dy_di(x,y,GP)*dy_di(x,y,GP)) end function ds_di -!> This function returns the grid spacing in the logical y direction. +!> This function returns the grid spacing in the logical y direction in [L ~> m]. function ds_dj(x, y, GP) real, intent(in) :: x !< The longitude in question real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters - ! Local variables - real :: ds_dj - ds_dj = GP%Rad_Earth * dy_dj(y,GP) + real :: ds_dj ! The returned grid spacing [L ~> m] + + ds_dj = GP%Rad_Earth_L * dy_dj(y,GP) ! In general, this might be... - ! ds_dj = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + & + ! ds_dj = GP%Rad_Earth_L * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + & ! dy_dj(x,y,GP)*dy_dj(x,y,GP)) end function ds_dj @@ -1195,12 +1193,10 @@ end function Adcroft_reciprocal !! any land or boundary point. For points in the interior, mask2dCu, !! mask2dCv, and mask2dBu are all 1.0. subroutine initialize_masks(G, PF, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z_scale ! A unit conversion factor from m to Z. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: Dmask ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1208,23 +1204,21 @@ subroutine initialize_masks(G, PF, US) integer :: i, j call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") - m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z_scale) + units="m", default=0.0, scale=US%m_to_Z) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z_scale) + units="m", default=-9999.0, scale=US%m_to_Z) Dmask = mask_depth - if (mask_depth == -9999.*m_to_Z_scale) Dmask = min_depth + if (mask_depth == -9999.0*US%m_to_Z) Dmask = min_depth G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 5ac326ee44..fc5ceaf3e4 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -57,7 +57,7 @@ subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [T-1 ~> s-1] type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the Coriolis parameter. ! This is a separate subroutine so that it can be made public and shared with @@ -95,11 +95,8 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: f1, f2 - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. @@ -139,19 +136,16 @@ end function diagnoseMaximumDepth subroutine initialize_topography_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. character(len=200) :: filename, topo_file, inputdir ! Strings for file/path character(len=200) :: topo_varname ! Variable name in file character(len=40) :: mdl = "initialize_topography_from_file" ! This subroutine's name. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_FILE", topo_file, & @@ -167,13 +161,13 @@ subroutine initialize_topography_from_file(D, G, param_file, US) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) - D(:,:) = -9.e30*m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere + D(:,:) = -9.0e30*US%m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere ! before reading from a file should do nothing. However, in the instance of ! masked-out PEs, halo regions are not updated when a processor does not ! exist. We need to ensure the depth in masked-out PEs appears to be that ! of land so this line does that in the halo regions. For non-masked PEs ! the halo region is filled properly with a later pass_var(). - call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=m_to_Z) + call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=US%m_to_Z) call apply_topography_edits_from_file(D, G, param_file, US) @@ -184,12 +178,12 @@ end subroutine initialize_topography_from_file subroutine apply_topography_edits_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m or Z if US is present + intent(inout) :: D !< Ocean bottom depth [m] or [Z ~> m] if + !! US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real, dimension(:), allocatable :: new_depth ! The new values of the depths [m] integer, dimension(:), allocatable :: ig, jg ! The global indicies of the points to modify character(len=200) :: topo_edits_file, inputdir ! Strings for file/path @@ -201,8 +195,6 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & @@ -216,13 +208,13 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z) - if (mask_depth == -9999.*m_to_Z) mask_depth = min_depth + units="m", default=-9999.0, scale=US%m_to_Z) + if (mask_depth == -9999.*US%m_to_Z) mask_depth = min_depth if (len_trim(topo_edits_file)==0) return @@ -262,15 +254,15 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) i = ig(n) - G%isd_global + 2 ! +1 for python indexing and +1 for ig-isd_global+1 j = jg(n) - G%jsd_global + 2 if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then - if (new_depth(n)*m_to_Z /= mask_depth) then + if (new_depth(n)*US%m_to_Z /= mask_depth) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j - D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)*US%Z_to_m, '->', abs(new_depth(n)), i, j + D(i,j) = abs(US%m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else if (topo_edits_change_mask) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j - D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)*US%Z_to_m,'->',abs(new_depth(n)),i,j + D(i,j) = abs(US%m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& "A zero depth edit would change the land mask and is not allowed in"//trim(topo_edits_file)) @@ -288,23 +280,21 @@ end subroutine apply_topography_edits_from_file subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: topog_config !< The name of an idealized !! topographic configuration - real, intent(in) :: max_depth !< Maximum depth of model in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine places the bottom depth in m into D(:,:), shaped according to the named config. ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum depth [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH. - real :: expdecay ! A decay scale of associated with the sloping boundaries [m]. - real :: Dedge ! The depth [Z ~> m], at the basin edge -! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth + real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] + real :: expdecay ! A decay scale of associated with the sloping boundaries [L ~> m] + real :: Dedge ! The depth at the basin edge [Z ~> m] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed character(len=40) :: mdl = "initialize_topography_named" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -314,34 +304,18 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth call MOM_mesg(" MOM_shared_initialization.F90, initialize_topography_named: "//& "TOPO_CONFIG = "//trim(topog_config), 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) if (max_depth<=0.) call MOM_error(FATAL,"initialize_topography_named: "// & "MAXIMUM_DEPTH has a non-sensical value! Was it set?") if (trim(topog_config) /= "flat") then call get_param(param_file, mdl, "EDGE_DEPTH", Dedge, & "The depth at the edge of one of the named topographies.", & - units="m", default=100.0, scale=m_to_Z) -! call get_param(param_file, mdl, "SOUTHLAT", south_lat, & -! "The southern latitude of the domain.", units="degrees", & -! fail_if_missing=.true.) -! call get_param(param_file, mdl, "LENLAT", len_lat, & -! "The latitudinal length of the domain.", units="degrees", & -! fail_if_missing=.true.) -! call get_param(param_file, mdl, "WESTLON", west_lon, & -! "The western longitude of the domain.", units="degrees", & -! default=0.0) -! call get_param(param_file, mdl, "LENLON", len_lon, & -! "The longitudinal length of the domain.", units="degrees", & -! fail_if_missing=.true.) -! call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth, & -! "The radius of the Earth.", units="m", default=6.378e6) + units="m", default=100.0, scale=US%m_to_Z) call get_param(param_file, mdl, "TOPOG_SLOPE_SCALE", expdecay, & "The exponential decay scale used in defining some of "//& - "the named topographies.", units="m", default=400000.0) + "the named topographies.", units="m", default=400000.0, scale=US%m_to_L) endif @@ -351,30 +325,30 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth do i=is,ie ; do j=js,je ; D(i,j) = max_depth ; enddo ; enddo elseif (trim(topog_config) == "spoon") then D0 = (max_depth - Dedge) / & - ((1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay))) * & - (1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay)))) + ((1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay))) * & + (1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay)))) do i=is,ie ; do j=js,je ! This sets a bowl shaped (sort of) bottom topography, with a ! ! maximum depth of max_depth. ! D(i,j) = Dedge + D0 * & (sin(PI * (G%geoLonT(i,j) - (G%west_lon)) / G%len_lon) * & - (1.0 - exp((G%geoLatT(i,j) - (G%south_lat+G%len_lat))*G%Rad_earth*PI / & + (1.0 - exp((G%geoLatT(i,j) - (G%south_lat+G%len_lat))*G%Rad_Earth_L*PI / & (180.0*expdecay)) )) enddo ; enddo elseif (trim(topog_config) == "bowl") then D0 = (max_depth - Dedge) / & - ((1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay))) * & - (1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay)))) + ((1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay))) * & + (1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay)))) ! This sets a bowl shaped (sort of) bottom topography, with a ! maximum depth of max_depth. do i=is,ie ; do j=js,je D(i,j) = Dedge + D0 * & (sin(PI * (G%geoLonT(i,j) - G%west_lon) / G%len_lon) * & - ((1.0 - exp(-(G%geoLatT(i,j) - G%south_lat)*G%Rad_Earth*PI/ & + ((1.0 - exp(-(G%geoLatT(i,j) - G%south_lat)*G%Rad_Earth_L*PI/ & (180.0*expdecay))) * & (1.0 - exp((G%geoLatT(i,j) - (G%south_lat+G%len_lat))* & - G%Rad_Earth*PI/(180.0*expdecay))))) + G%Rad_Earth_L*PI/(180.0*expdecay))))) enddo ; enddo elseif (trim(topog_config) == "halfpipe") then D0 = max_depth - Dedge @@ -401,13 +375,12 @@ end subroutine initialize_topography_named subroutine limit_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m or Z if US is present + intent(inout) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum depth of model [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j character(len=40) :: mdl = "limit_topography" ! This subroutine's name. real :: min_depth ! The shallowest value of wet points [Z ~> m] @@ -415,24 +388,22 @@ subroutine limit_topography(D, G, param_file, max_depth, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z, do_not_log=.true.) + units="m", default=-9999.0, scale=US%m_to_Z, do_not_log=.true.) ! Make sure that min_depth < D(x,y) < max_depth for ocean points ! TBD: The following f.p. equivalence uses a special value. Originally, any negative value ! indicated the branch. We should create a logical flag to indicate this branch. - if (mask_depth == -9999.*m_to_Z) then + if (mask_depth == -9999.*US%m_to_Z) then if (min_depth<0.) then call MOM_error(FATAL, trim(mdl)//": MINIMUM_DEPTH<0 does not work as expected "//& "unless MASKING_DEPTH has been set appropriately. Set a meaningful "//& @@ -472,22 +443,19 @@ subroutine set_rotation_planetary(f, G, param_file, US) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J real :: PI real :: omega ! The planetary rotation rate [T-1 ~> s-1] - real :: T_to_s ! A time unit conversion factor call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s - call get_param(param_file, "set_rotation_planetary", "OMEGA", omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=T_to_s) + default=7.2921e-5, scale=US%T_to_s) PI = 4.0*atan(1.0) do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB @@ -505,15 +473,15 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] - real :: beta ! The meridional gradient of the Coriolis parameter [T-1 m-1 ~> s-1 m-1] - real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] - real :: y_scl, Rad_Earth - real :: T_to_s ! A time unit conversion factor + real :: beta ! The meridional gradient of the Coriolis parameter [T-1 L-1 ~> s-1 m-1] + real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] + real :: Rad_Earth_L ! The radius of the planet in rescaled units [L ~> m] + real :: y_scl ! A scaling factor from the units of latitude [L lat-1 ~> m lat-1] real :: PI character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units @@ -521,29 +489,27 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s - call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the "//& - "betaplane option.", units="s-1", default=0.0, scale=T_to_s) + "betaplane option.", units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with "//& - "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s) + "the betaplane option.", units="m-1 s-1", default=0.0, scale=US%T_to_s*US%L_to_m) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) select case (axis_units(1:1)) case ("d") - call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) beta_lat_ref_units = "degrees" - y_scl = PI * Rad_Earth/ 180. + y_scl = PI * Rad_Earth_L / 180. case ("k") beta_lat_ref_units = "kilometers" - y_scl = 1.E3 + y_scl = 1.0e3 * US%m_to_L case ("m") beta_lat_ref_units = "meters" - y_scl = 1. + y_scl = 1.0 * US%m_to_L case default ; call MOM_error(FATAL, & " set_rotation_beta_plane: unknown AXIS_UNITS = "//trim(axis_units)) end select @@ -640,90 +606,89 @@ subroutine reset_face_lengths_named(G, param_file, name, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=*), intent(in) :: name !< The name for the set of face lengths. Only "global_1deg" !! is currently implemented. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=256) :: mesg ! Message for error messages. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] - real :: dx_2 = -1.0, dy_2 = -1.0 + real :: dx_2 ! Half the local zonal grid spacing [degreesE] + real :: dy_2 ! Half the local meridional grid spacing [degreesN] real :: pi_180 - integer :: option = -1 + integer :: option integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB pi_180 = (4.0*atan(1.0))/180.0 + dx_2 = -1.0 ; dy_2 = -1.0 + option = -1 + select case ( trim(name) ) case ("global_1deg") ; option = 1 ; dx_2 = 0.5*1.0 case default ; call MOM_error(FATAL, "reset_face_lengths_named: "//& "Unrecognized channel configuration name "//trim(name)) end select - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*m_to_L ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*US%m_to_L ! Gibraltar if ((abs(G%geoLatCu(I,j)-12.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-43.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*m_to_L ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*US%m_to_L ! Red Sea if ((abs(G%geoLatCu(I,j)-40.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-26.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*m_to_L ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*US%m_to_L ! Dardanelles if ((abs(G%geoLatCu(I,j)-41.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+220.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*m_to_L ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*US%m_to_L ! Tsugaru strait at 140.0e if ((abs(G%geoLatCu(I,j)-45.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+217.5) < 0.9)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*US%m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCu(I,j)-80.84) < 0.2) .and. (abs(G%geoLonCu(I,j)+64.9) < 0.8)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*m_to_L ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*US%m_to_L ! Smith Sound in Canadian Arch - tripolar region enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*US%m_to_L ! Bosporus - should be 1000.0 m wide. if ((abs(G%geoLatCv(i,J)-13.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-42.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*m_to_L ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*US%m_to_L ! Red Sea if ((abs(G%geoLatCv(i,J)+2.8) < 0.8) .and. (abs(G%geoLonCv(i,J)+241.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*m_to_L ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*US%m_to_L ! Makassar Straits at 241.5 W = 118.5 E if ((abs(G%geoLatCv(i,J)-0.56) < 0.5) .and. (abs(G%geoLonCv(i,J)+240.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*US%m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+230.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+229.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E if ((abs(G%geoLatCv(i,J)-0.0) < 0.25) .and. (abs(G%geoLonCv(i,J)+228.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+244.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*US%m_to_L ! Lombok Straits at 244.5 W = 115.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+235.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*US%m_to_L ! Timor Straits at 235.5 W = 124.5 E if ((abs(G%geoLatCv(i,J)-52.5) < dy_2) .and. (abs(G%geoLonCv(i,J)+218.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*US%m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCv(i,J)-76.8) < 0.06) .and. (abs(G%geoLonCv(i,J)+88.7) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*US%m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -731,10 +696,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then + if (G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & + US%L_to_m*G%dy_Cu(I,j), US%L_to_m*G%dyCu(I,j), US%L_to_m*(G%dy_Cu(I,j)-G%dyCu(I,j)), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif @@ -744,10 +709,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then + if (G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & + US%L_to_m*G%dx_Cv(i,J), US%L_to_m*G%dxCv(i,J), US%L_to_m*(G%dx_Cv(i,J)-G%dxCv(i,J)), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) @@ -766,22 +731,18 @@ end subroutine reset_face_lengths_named subroutine reset_face_lengths_file(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -796,14 +757,14 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=m_to_L) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then + if (G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & + US%L_to_m*G%dy_Cu(I,j), US%L_to_m*G%dyCu(I,j), US%L_to_m*(G%dy_Cu(I,j)-G%dyCu(I,j)), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif @@ -813,10 +774,10 @@ subroutine reset_face_lengths_file(G, param_file, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then + if (G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & + US%L_to_m*G%dx_Cv(i,J), US%L_to_m*G%dxCv(i,J), US%L_to_m*(G%dx_Cv(i,J)-G%dxCv(i,J)), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) @@ -836,7 +797,7 @@ end subroutine reset_face_lengths_file subroutine reset_face_lengths_list(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=120), pointer, dimension(:) :: lines => NULL() @@ -850,8 +811,10 @@ subroutine reset_face_lengths_list(G, param_file, US) integer, allocatable, dimension(:) :: & u_line_no, v_line_no, & ! The line numbers in lines of u- and v-face lines u_line_used, v_line_used ! The number of times each u- and v-line is used. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real, allocatable, dimension(:) :: & + Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] + real, allocatable, dimension(:) :: & + Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [m] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -865,12 +828,13 @@ subroutine reset_face_lengths_list(G, param_file, US) integer :: ios, iounit, isu, isv integer :: last, num_lines, nl_read, ln, npt, u_pt, v_pt integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + integer :: isu_por, isv_por + logical :: found_u_por, found_v_por + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -929,6 +893,14 @@ subroutine reset_face_lengths_list(G, param_file, US) allocate(v_line_used(num_lines), source=0) allocate(v_line_no(num_lines), source=0) + allocate(Dmin_u(num_lines)) ; Dmin_u(:) = 0.0 + allocate(Dmax_u(num_lines)) ; Dmax_u(:) = 0.0 + allocate(Davg_u(num_lines)) ; Davg_u(:) = 0.0 + + allocate(Dmin_v(num_lines)) ; Dmin_v(:) = 0.0 + allocate(Dmax_v(num_lines)) ; Dmax_v(:) = 0.0 + allocate(Davg_v(num_lines)) ; Davg_v(:) = 0.0 + ! Actually read the lines. if (is_root_pe()) then call read_face_length_list(iounit, filename, nl_read, lines) @@ -946,13 +918,21 @@ subroutine reset_face_lengths_list(G, param_file, US) line = lines(ln) ! Detect keywords found_u = .false.; found_v = .false. + found_u_por = .false.; found_v_por = .false. isu = index(uppercase(line), "U_WIDTH" ); if (isu > 0) found_u = .true. isv = index(uppercase(line), "V_WIDTH" ); if (isv > 0) found_v = .true. + isu_por = index(uppercase(line), "U_WIDTH_POR" ); if (isu_por > 0) found_u_por = .true. + isv_por = index(uppercase(line), "V_WIDTH_POR" ); if (isv_por > 0) found_v_por = .true. ! Store and check the relevant values. if (found_u) then u_pt = u_pt + 1 - read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) + if (found_u_por .eqv. .false.) then + read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) + elseif (found_u_por) then + read(line(isu_por+12:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt), & + Dmin_u(u_pt), Dmax_u(u_pt), Davg_u(u_pt) + endif u_line_no(u_pt) = ln if (is_root_PE()) then if (check_360) then @@ -977,10 +957,19 @@ subroutine reset_face_lengths_list(G, param_file, US) call MOM_error(WARNING, "reset_face_lengths_list : Negative "//& "u-width found when reading line "//trim(line)//" from file "//& trim(filename)) + if (Dmin_u(u_pt) > Dmax_u(u_pt)) & + call MOM_error(WARNING, "reset_face_lengths_list : Out-of-order "//& + "topographical min/max found when reading line "//trim(line)//" from file "//& + trim(filename)) endif elseif (found_v) then v_pt = v_pt + 1 - read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) + if (found_v_por .eqv. .false.) then + read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) + elseif (found_v_por) then + read(line(isv+12:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt), & + Dmin_v(v_pt), Dmax_v(v_pt), Davg_v(v_pt) + endif v_line_no(v_pt) = ln if (is_root_PE()) then if (check_360) then @@ -1005,6 +994,10 @@ subroutine reset_face_lengths_list(G, param_file, US) call MOM_error(WARNING, "reset_face_lengths_list : Negative "//& "v-width found when reading line "//trim(line)//" from file "//& trim(filename)) + if (Dmin_v(v_pt) > Dmax_v(v_pt)) & + call MOM_error(WARNING, "reset_face_lengths_list : Out-of-order "//& + "topographical min/max found when reading line "//trim(line)//" from file "//& + trim(filename)) endif endif enddo @@ -1022,7 +1015,11 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(US%m_to_L*u_width(npt), 0.0)) + G%porous_DminU(I,j) = US%m_to_Z*Dmin_u(npt) + G%porous_DmaxU(I,j) = US%m_to_Z*Dmax_u(npt) + G%porous_DavgU(I,j) = US%m_to_Z*Davg_u(npt) + if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -1031,7 +1028,10 @@ subroutine reset_face_lengths_list(G, param_file, US) u_line_used(npt) = u_line_used(npt) + 1 write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& - u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" + u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",US%L_to_m*G%dy_Cu(I,j),"m" + write(stdout,'(A,3F8.2,A)') & + "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminU(I,j),& + G%porous_DmaxU(I,j), G%porous_DavgU(I,j),")m" endif endif endif @@ -1052,7 +1052,11 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(US%m_to_L*v_width(npt), 0.0)) + G%porous_DminV(i,J) = US%m_to_Z*Dmin_v(npt) + G%porous_DmaxV(i,J) = US%m_to_Z*Dmax_v(npt) + G%porous_DavgV(i,J) = US%m_to_Z*Davg_v(npt) + if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1061,7 +1065,10 @@ subroutine reset_face_lengths_list(G, param_file, US) v_line_used(npt) = v_line_used(npt) + 1 write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& - v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" + v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",US%L_to_m*G%dx_Cv(I,j),"m" + write(stdout,'(A,3F8.2,A)') & + "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminV(i,J),& + G%porous_DmaxV(i,J), G%porous_DavgV(i,J),")m" endif endif endif @@ -1097,6 +1104,8 @@ subroutine reset_face_lengths_list(G, param_file, US) deallocate(u_line_used, v_line_used, u_line_no, v_line_no) deallocate(u_lat) ; deallocate(u_lon) ; deallocate(u_width) deallocate(v_lat) ; deallocate(v_lon) ; deallocate(v_width) + deallocate(Dmin_u) ; deallocate(Dmax_u) ; deallocate(Davg_u) + deallocate(Dmin_v) ; deallocate(Dmax_v) ; deallocate(Davg_v) endif call callTree_leave(trim(mdl)//'()') @@ -1200,15 +1209,15 @@ end subroutine set_velocity_depth_min !> Pre-compute global integrals of grid quantities (like masked ocean area) for !! later use in reporting diagnostics subroutine compute_global_grid_integrals(G, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming - real :: area_scale ! A scaling factor for area into MKS units + real :: area_scale ! A scaling factor for area into MKS units [m2 L-2 ~> 1] integer :: i,j - area_scale = 1.0 ; if (present(US)) area_scale = US%L_to_m**2 + area_scale = US%L_to_m**2 tmpForSumming(:,:) = 0. G%areaT_global = 0.0 ; G%IareaT_global = 0.0 @@ -1228,13 +1237,13 @@ end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- !> Write out a file describing the topography, Coriolis parameter, grid locations !! and various other fixed fields from the grid. -subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) +subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file !! (otherwise the file is "ocean_geometry") - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables. character(len=240) :: filepath ! The full path to the file to write @@ -1243,9 +1252,6 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) vars ! Types with metadata about the variables and their staggering type(fieldtype), dimension(:), allocatable :: & fields ! Opaque types used by MOM_io to store variable metadata information - real :: Z_to_m_scale ! A unit conversion factor from Z to m - real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1 - real :: L_to_m_scale ! A unit conversion factor from L to m type(file_type) :: IO_handle ! The I/O handle of the fileset integer :: nFlds ! The number of variables in this file integer :: file_threading @@ -1253,11 +1259,6 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call callTree_enter('write_ocean_geometry_file()') - Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m - s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T - L_to_m_scale = 1.0 ; if (present(US)) L_to_m_scale = US%L_to_m - - nFlds = 19 ; if (G%bathymetry_at_vel) nFlds = 23 allocate(vars(nFlds)) @@ -1308,8 +1309,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) endif call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", multiple_files, & - "If true, each processor writes its own restart file, "//& - "otherwise a single restart file is generated", & + "If true, the IO layout is used to group processors that write to the same "//& + "restart file or each processor writes its own (numbered) restart file. "//& + "If false, a single restart file is generated combining output from all PEs.", & default=.false.) file_threading = SINGLE_FILE if (multiple_files) file_threading = MULTIPLE @@ -1321,30 +1323,30 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call MOM_write_field(IO_handle, fields(3), G%Domain, G%geoLatT) call MOM_write_field(IO_handle, fields(4), G%Domain, G%geoLonT) - call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, scale=s_to_T_scale) + call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, scale=US%s_to_T) - call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, scale=L_to_m_scale) + call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, scale=US%L_to_m) - call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, scale=L_to_m_scale**2) - call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, scale=L_to_m_scale**2) + call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, scale=US%L_to_m**2) + call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, scale=US%L_to_m**2) - call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, scale=L_to_m_scale) + call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, scale=US%L_to_m) call MOM_write_field(IO_handle, fields(19), G%Domain, G%mask2dT) if (G%bathymetry_at_vel) then - call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=Z_to_m_scale) + call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=US%Z_to_m) endif call close_file(IO_handle) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 1ca466b7fa..22892817e6 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -34,7 +34,7 @@ module MOM_state_initialization use MOM_ALE_sponge, only : set_up_ALE_sponge_field, set_up_ALE_sponge_vel_field use MOM_ALE_sponge, only : ALE_sponge_CS, initialize_ALE_sponge use MOM_string_functions, only : uppercase, lowercase -use MOM_time_manager, only : time_type +use MOM_time_manager, only : time_type, operator(/=) use MOM_tracer_registry, only : tracer_registry_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs @@ -117,7 +117,7 @@ module MOM_state_initialization !! conditions or by reading them from a restart (or saves) file. subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & restart_CS, ALE_CSp, tracer_Reg, sponge_CSp, & - ALE_sponge_CSp, oda_incupd_CSp, OBC, Time_in, frac_shelf_h) + ALE_sponge_CSp, oda_incupd_CSp, OBC, Time_in, frac_shelf_h, mass_shelf) 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 @@ -136,8 +136,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !! for model parameter values. type(directories), intent(in) :: dirs !< A structure containing several relevant !! directory paths. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ALE_CS), pointer :: ALE_CSp !< The ALE control structure for remapping type(tracer_registry_type), pointer :: tracer_Reg !< A pointer to the tracer registry type(sponge_CS), pointer :: sponge_CSp !< The layerwise sponge control structure. @@ -148,6 +147,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: frac_shelf_h !< The fraction of the grid cell covered !! by a floating ice shelf [nondim]. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: mass_shelf !< The mass per unit area of the overlying + !! ice shelf [ R Z ~> kg m-2 ] ! Local variables real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] character(len=200) :: filename ! The name of an input file. @@ -159,10 +161,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real :: vel_rescale ! A rescaling factor for velocities from the representation in ! a restart file to the internal representation in this run. real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. + logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom logical :: use_temperature, use_sponge, use_OBC, use_oda_incupd + logical :: verify_restart_time logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. logical :: depress_sfc ! If true, remove the mass that would be displaced ! by a large surface pressure by squeezing the column. @@ -235,14 +239,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref enddo ; enddo + call get_param(PF, mdl, "FATAL_INCONSISTENT_RESTART_TIME", verify_restart_time, & + "If true and a time_in value is provided to MOM_initialize_state, verify that "//& + "the time read from a restart file is the same as time_in, and issue a fatal "//& + "error if it is not. Otherwise, simply set the time to time_in if present.", & + default=.false.) + ! The remaining initialization calls are done, regardless of whether the ! fields are actually initialized here (if just_read=.false.) or whether it ! is just to make sure that all valid parameters are read to enable the ! detection of unused parameters. call get_param(PF, mdl, "INIT_LAYERS_FROM_Z_FILE", from_Z_file, & - "If true, initialize the layer thicknesses, temperatures, "//& - "and salinities from a Z-space file on a latitude-longitude "//& - "grid.", default=.false., do_not_log=just_read) + "If true, initialize the layer thicknesses, temperatures, and "//& + "salinities from a Z-space file on a latitude-longitude grid.", & + default=.false., do_not_log=just_read) if (from_Z_file) then ! Initialize thickness and T/S from z-coordinate data in a file. @@ -250,7 +260,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") call MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, & - just_read_params=just_read, frac_shelf_h=frac_shelf_h) + just_read=just_read, frac_shelf_h=frac_shelf_h) else ! Initialize thickness, h. call get_param(PF, mdl, "THICKNESS_CONFIG", config, & @@ -283,9 +293,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & default="uniform", do_not_log=just_read) select case (trim(config)) case ("file") - call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .false., just_read_params=just_read) + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .false., just_read=just_read) case ("thickness_file") - call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .true., just_read_params=just_read) + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .true., just_read=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -294,41 +304,41 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "for THICKNESS_CONFIG of 'coord'") endif case ("uniform"); call initialize_thickness_uniform(h, depth_tot, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("list"); call initialize_thickness_list(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("DOME"); call DOME_initialize_thickness(h, depth_tot, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("ISOMIP"); call ISOMIP_initialize_thickness(h, depth_tot, G, GV, US, PF, tv, & - just_read_params=just_read) + just_read=just_read) case ("benchmark"); call benchmark_initialize_thickness(h, depth_tot, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) - case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref) + tv%eqn_of_state, tv%P_Ref, just_read=just_read) + case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, & + G, GV, US, PF, tv%P_Ref) case ("search"); call initialize_thickness_search() case ("circle_obcs"); call circle_obcs_initialize_thickness(h, depth_tot, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("DOME2D"); call DOME2d_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("seamount"); call seamount_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("dumbbell"); call dumbbell_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("soliton"); call soliton_initialize_thickness(h, depth_tot, G, GV, US) case ("phillips"); call Phillips_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("USER"); call user_initialize_thickness(h, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized layer thickness configuration "//trim(config)) end select @@ -359,37 +369,37 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! " \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, US, PF, & - eos, tv%P_Ref, just_read_params=just_read) + eos, tv%P_Ref, just_read=just_read) case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, GV, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & - G, GV, US, PF, eos, tv%P_Ref, just_read_params=just_read) + G, GV, US, PF, eos, tv%P_Ref, just_read=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & - G, GV, PF, just_read_params=just_read) + G, GV, PF, just_read=just_read) case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, eos, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, US, PF, eos, just_read=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, PF, just_read=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & - G, GV, US, PF, just_read_params=just_read) - case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & - h, just_read_params=just_read) - case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, eos, & - just_read_params=just_read) + G, GV, US, PF, just_read=just_read) + case ("dense"); call dense_water_initialize_TS(G, GV, PF, tv%T, tv%S, & + h, just_read=just_read) + case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, & + just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized Temp & salt configuration "//trim(config)) end select @@ -398,6 +408,23 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (use_temperature .and. use_OBC) & call fill_temp_salt_segments(G, GV, OBC, tv) + ! Calculate the initial surface displacement under ice shelf + + call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & + "If true, depress the initial surface to avoid huge "//& + "tsunamis when a large surface pressure is applied.", & + default=.false., do_not_log=just_read) + call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & + "If true, cuts way the top of the column for initial conditions "//& + "at the depth where the hydrostatic pressure matches the imposed "//& + "surface pressure which is read from file.", default=.false., & + do_not_log=just_read) + + if (new_sim) then + if (use_ice_shelf .and. present(mass_shelf) .and. .not. (trim_ic_for_p_surf .or. depress_sfc)) & + call calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + endif + ! The thicknesses in halo points might be needed to initialize the velocities. if (new_sim) call pass_var(h, G%Domain) @@ -416,27 +443,27 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & do_not_log=just_read) select case (trim(config)) case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & - G, GV, US, PF, just_read_params=just_read) + G, GV, US, PF, just_read=just_read) case ("soliton"); call soliton_initialize_velocity(u, v, h, G, GV, US) case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly @@ -452,21 +479,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call convert_thickness(h, G, GV, US, tv) ! Remove the mass that would be displaced by an ice shelf or inverse barometer. - call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & - "If true, depress the initial surface to avoid huge "//& - "tsunamis when a large surface pressure is applied.", & - default=.false., do_not_log=just_read) - call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & - "If true, cuts way the top of the column for initial conditions "//& - "at the depth where the hydrostatic pressure matches the imposed "//& - "surface pressure which is read from file.", default=.false., & - do_not_log=just_read) if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) - if (depress_sfc) call depress_surface(h, G, GV, US, PF, tv, just_read_params=just_read) - if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params=just_read) + if (depress_sfc) call depress_surface(h, G, GV, US, PF, tv, just_read=just_read) + if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read=just_read) ! Perhaps we want to run the regridding coordinate generator for multiple ! iterations here so the initial grid is consistent with the coordinate @@ -507,7 +525,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This line calls a subroutine that reads the initial conditions ! from a previously generated file. call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, G, restart_CS) - if (present(Time_in)) Time = Time_in + if (present(Time_in)) then + if (verify_restart_time .and. (Time /= Time_in)) call MOM_error(FATAL, & + "MOM6 attempted to restart from a file from a different time than given by Time_in.") + Time = Time_in + endif if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo @@ -610,7 +632,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & elseif (trim(config) == "shelfwave") then OBC%update_OBC = .true. elseif (lowercase(trim(config)) == "supercritical") then - call supercritical_set_OBC_data(OBC, G, GV, PF) + call supercritical_set_OBC_data(OBC, G, GV, US, PF) elseif (trim(config) == "tidal_bay") then OBC%update_OBC = .true. elseif (trim(config) == "USER") then @@ -620,7 +642,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "OBC_USER_CONFIG = "//trim(config)//" have not been fully implemented.") endif if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) + call set_tracer_data(OBC, tv, h, G, GV, PF) endif endif ! if (open_boundary_query(OBC, apply_nudged_OBC=.true.)) then @@ -642,13 +664,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, & PF, oda_incupd_CSp, restart_CS, Time) endif - - end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, file_has_thickness, & - just_read_params) + just_read) 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 @@ -661,22 +681,19 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f logical, intent(in) :: file_has_thickness !< If true, this file contains layer !! thicknesses; otherwise it contains !! interface heights. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. integer :: inconsistent = 0 logical :: correct_thickness - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -737,7 +754,7 @@ end subroutine initialize_thickness_from_file !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_m. +!! layers are contracted to ANGSTROM thickness (which may be 0). !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the @@ -821,7 +838,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta) end subroutine adjustEtaToFitBathymetry !> Initializes thickness to be uniform -subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_read_params) +subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_read) 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)), & @@ -830,21 +847,18 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units, usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units. - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -878,33 +892,30 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re end subroutine initialize_thickness_uniform !> Initialize thickness from a 1D list -subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "INTERFACE_IC_FILE", eta_file, & "The file from which horizontal mean initial conditions "//& "for interface depths can be read.", fail_if_missing=.true.) @@ -1036,7 +1047,7 @@ subroutine convert_thickness(h, G, GV, US, tv) end subroutine convert_thickness !> Depress the sea-surface based on an initial condition file -subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) +subroutine depress_surface(h, G, GV, US, param_file, tv, just_read, z_top_shelf) 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 @@ -1044,8 +1055,10 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: z_top_shelf !< Top interface position under ice shelf [Z ~> m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & eta_sfc ! The free surface height that the model should use [Z ~> m]. @@ -1057,33 +1070,41 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) character(len=40) :: mdl = "depress_surface" ! This subroutine's name. character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz + logical :: use_z_shelf + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + use_z_shelf = present(z_top_shelf) - ! Read the surface height (or pressure) from a file. - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& - "The initial condition file for the surface height.", & - fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & - "The initial condition variable for the surface height.",& - default="SSH", do_not_log=just_read) - filename = trim(inputdir)//trim(eta_srf_file) - if (.not.just_read) & - call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) + if (.not. use_z_shelf) then + ! Read the surface height (or pressure) from a file. - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & - "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into units of m", & - units="variable", default=1.0, scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& + "The initial condition file for the surface height.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & + "The initial condition variable for the surface height.",& + default="SSH", do_not_log=just_read) + filename = trim(inputdir)//trim(eta_srf_file) + if (.not.just_read) & + call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) + + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & + "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into units of m", & + units="variable", default=1.0, scale=US%m_to_Z, do_not_log=just_read) - if (just_read) return ! All run-time parameters have been read, so return. + if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) + call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) + else + do j=js,je ; do i=is,ie + eta_sfc(i,j) = z_top_shelf(i,j) + enddo; enddo + endif ! Convert thicknesses to interface heights. call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) @@ -1120,7 +1141,7 @@ end subroutine depress_surface !> Adjust the layer thicknesses by cutting away the top of each model column at the depth !! where the hydrostatic pressure matches an imposed surface pressure read from file. -subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) +subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) type(param_file_type), intent(in) :: PF !< Parameter file structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1129,8 +1150,8 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface [R L2 T-2 ~> Pa] @@ -1141,12 +1162,9 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. integer :: i, j, k logical :: default_2018_answers, remap_answers_2018 - logical :: just_read ! If true, just read parameters but set nothing. logical :: use_remapping ! If true, remap the initial conditions. type(remapping_CS), pointer :: remap_CS => NULL() - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(PF, mdl, "SURFACE_PRESSURE_FILE", p_surf_file, & "The initial condition file for the surface pressure exerted by ice.", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -1207,6 +1225,88 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) end subroutine trim_for_ice +!> Calculate the hydrostatic equilibrium position of the surface under an ice shelf +subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: mass_shelf !< Ice shelf mass [R Z ~> kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + + real :: z_top_shelf(SZI_(G),SZJ_(G)) ! The depth of the top interface under ice shelves [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & + eta ! The free surface height that the model should use [Z ~> m]. + ! temporary arrays + real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice + real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2] + real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] + real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] + real, dimension(SZK_(GV)+1) :: ei_tmp, ei_orig ! temporary storage for interface positions [Z ~> m] + real :: z_top ! An estimate of the height of the ice-ocean interface [Z ~> m] + real :: mass_disp ! The net mass of sea water that has been displaced by the shelf [R Z ~> kg m-2] + real :: residual ! The difference between the displaced ocean mass and the ice shelf + ! mass [R Z ~> kg m-2] + real :: tol ! The initialization tolerance for ice shelf initialization [Z ~> m] + integer :: is, ie, js, je, k, nz, i, j, max_iter, iter + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + call get_param(PF, mdl, "ICE_SHELF_INITIALIZATION_Z_TOLERANCE", tol, & + "A initialization tolerance for the calculation of the static "// & + "ice shelf displacement (m) using initial temperature and salinity profile.",& + default=0.001, units="m", scale=US%m_to_Z) + max_iter = 1e3 + call MOM_mesg("Started calculating initial interface position under ice shelf ") + ! Convert thicknesses to interface heights. + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) + do j=js,je ; do i=is,ie + iter = 1 + z_top_shelf(i,j) = 0.0 + p_ref(:) = tv%p_ref + if ((G%mask2dT(i,j) > 0.) .and. (mass_shelf(i,j) > 0.)) then + call calculate_density(tv%T(i,j,:), tv%S(i,j,:), P_Ref, rho_col, tv%eqn_of_state) + z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1), -G%bathyT(i,j)), 0.) + h_tmp(:) = 0.0 + ei_tmp(1:nz+1) = eta(i,j,1:nz+1) + ei_orig(1:nz+1) = eta(i,j,1:nz+1) + do k=1,nz+1 + if (ei_tmp(k) < z_top) ei_tmp(k) = z_top + enddo + mass_disp = 0.0 + do k=1,nz + h_tmp(k) = max(ei_tmp(k)-ei_tmp(k+1), GV%Angstrom_H) + rho_h(k) = h_tmp(k) * rho_col(k) + mass_disp = mass_disp + rho_h(k) + enddo + residual = mass_shelf(i,j) - mass_disp + do while ((abs(residual) > tol) .and. (z_top > -G%bathyT(i,j)) .and. (iter < max_iter)) + z_top = min(max(z_top-(residual*0.5e-3), -G%bathyT(i,j)), 0.0) + h_tmp(:) = 0.0 + ei_tmp(1:nz+1) = ei_orig(1:nz+1) + do k=1,nz+1 + if (ei_tmp(k) < z_top) ei_tmp(k) = z_top + enddo + mass_disp = 0.0 + do k=1,nz + h_tmp(k) = max(ei_tmp(k)-ei_tmp(k+1), GV%Angstrom_H) + rho_h(k) = h_tmp(k) * rho_col(k) + mass_disp = mass_disp + rho_h(k) + enddo + residual = mass_shelf(i,j) - mass_disp + iter = iter+1 + end do + if (iter >= max_iter) call MOM_mesg("Warning: calc_sfc_displacement too many iterations.") + z_top_shelf(i,j) = z_top + endif + enddo ; enddo + call MOM_mesg("Calling depress_surface ") + call depress_surface(h, G, GV, US, PF, tv, just_read=.false.,z_top_shelf=z_top_shelf) + call MOM_mesg("Finishing calling depress_surface ") +end subroutine calc_sfc_displacement !> Adjust the layer thicknesses by removing the top of the water column above the !! depth where the hydrostatic pressure matches p_surf @@ -1310,7 +1410,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, end subroutine cut_off_column_top !> Initialize horizontal velocity components from file -subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1320,14 +1420,11 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u or v. ! Local variables character(len=40) :: mdl = "initialize_velocity_from_file" ! This subroutine's name. character(len=200) :: filename,velocity_file,inputdir ! Strings for file/path - logical :: just_read ! If true, just read parameters but set nothing. - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -1352,7 +1449,7 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read_ end subroutine initialize_velocity_from_file !> Initialize horizontal velocity components to zero. -subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) +subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1361,17 +1458,15 @@ subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables character(len=200) :: mdl = "initialize_velocity_zero" ! This subroutine's name. - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (just_read) return ! All run-time parameters have been read, so return. @@ -1387,7 +1482,7 @@ subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1397,18 +1492,16 @@ subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read_pa type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u or v. ! Local variables integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real :: initial_u_const, initial_v_const - logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: mdl = "initialize_velocity_uniform" ! This subroutine's name. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & default=0.0, units="m s-1", scale=US%m_s_to_L_T, do_not_log=just_read) @@ -1429,7 +1522,7 @@ end subroutine initialize_velocity_uniform !> Sets the initial velocity components to be circular with !! no flow at edges of domain and center. -subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1439,20 +1532,17 @@ subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read_p type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing u or v. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u or v. ! Local variables character(len=200) :: mdl = "initialize_velocity_circular" real :: circular_max_u ! The amplitude of the zonal flow [L T-1 ~> m s-1] real :: dpi ! A local variable storing pi = 3.14159265358979... real :: psi1, psi2 ! Values of the streamfunction at two points [L2 T-1 ~> m2 s-1] - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the "// & "circular stream function [m s-1].", & @@ -1493,25 +1583,22 @@ end function my_psi end subroutine initialize_velocity_circular !> Initializes temperature and salinity from file -subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read_params) +subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is !! being initialized [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is !! being initialized [ppt] - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T or S. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, intent(in) :: just_read !< If true, this call will only + !! read parameters without changing T or S. ! Local variables - logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, salt_filename ! Full paths to input files character(len=200) :: ts_file, salt_file, inputdir ! Strings for file/path character(len=40) :: mdl = "initialize_temp_salt_from_file" character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & @@ -1550,7 +1637,7 @@ subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read_par end subroutine initialize_temp_salt_from_file !> Initializes temperature and salinity from a 1D profile -subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_params) +subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is @@ -1558,17 +1645,14 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is !! being initialized [ppt] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T or S. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. ! Local variables real, dimension(SZK_(GV)) :: T0, S0 integer :: i, j, k - logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, ts_file, inputdir ! Strings for file/path character(len=40) :: mdl = "initialize_temp_salt_from_profile" - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & @@ -1596,7 +1680,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_ end subroutine initialize_temp_salt_from_profile !> Initializes temperature and salinity by fitting to density -subroutine initialize_temp_salt_fit(T, S, G, GV, US, 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) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is @@ -1606,11 +1690,11 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P 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 !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T or S. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. ! Local variables real :: T0(SZK_(GV)) ! Layer potential temperatures [degC] real :: S0(SZK_(GV)) ! Layer salinities [degC] @@ -1621,13 +1705,10 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! 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. integer :: i, j, k, itt, nz nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_REF", T_Ref, & @@ -1690,7 +1771,7 @@ end subroutine initialize_temp_salt_fit !! !! \remark Note that the linear distribution is set up with respect to the layer !! number, not the physical position). -subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read_params) +subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is @@ -1699,7 +1780,7 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read_params !! being initialized [ppt] type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, + logical, intent(in) :: just_read !< If present and true, !! this call will only read parameters !! without changing T or S. @@ -1708,11 +1789,8 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read_params real :: S_top, T_top ! Reference salinity and temperature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical real :: delta - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's name. - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_TOP", T_top, & "Initial temperature of the top surface.", & @@ -1791,10 +1869,10 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge fields real, allocatable, dimension(:,:,:) :: tmp_u,tmp_v ! A temporary array for reading sponge fields - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. - real :: Idamp_u(SZIB_(G),SZJ_(G)) ! The inverse damping rate for velocity fields [T-1 ~> s-1]. - real :: Idamp_v(SZI_(G),SZJB_(G)) ! The inverse damping rate for velocity fields [T-1 ~> s-1]. - real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] + real :: Idamp_u(SZIB_(G),SZJ_(G)) ! The sponge damping rate for velocity fields [T-1 ~> s-1] + real :: Idamp_v(SZI_(G),SZJB_(G)) ! The sponge damping rate for velocity fields [T-1 ~> s-1] + real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz @@ -1880,7 +1958,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t "of sponge restoring data.", default=time_space_interp_sponge) - ! Read in inverse damping rate for tracers + ! Read in sponge damping rate for tracers filename = trim(inputdir)//trim(damping_file) call log_param(param_file, mdl, "INPUTDIR/SPONGE_DAMPING_FILE", filename) if (.not.file_exists(filename, G%Domain)) & @@ -1891,7 +1969,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t call MOM_read_data(filename, Idamp_var, Idamp(:,:), G%Domain, scale=US%T_to_s) - ! Read in inverse damping rate for velocities + ! Read in sponge damping rate for velocities if (sponge_uv) then if (separate_idamp_for_uv()) then filename = trim(inputdir)//trim(uv_damping_file) @@ -1939,7 +2017,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo - ! Set the inverse damping rates so that the model will know where to + ! Set the sponge damping rates so that the model will know where to ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, param_file, Layer_CSp, GV) deallocate(eta) @@ -2085,8 +2163,7 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(oda_incupd_CS), pointer :: oda_incupd_CSp !< A pointer that is set to point to the control !! structure for this module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in !! overrides any value set for !Time. @@ -2272,7 +2349,7 @@ end subroutine set_velocity_depth_min !> This subroutine determines the isopycnal or other coordinate interfaces and !! layer potential temperatures and salinities directly from a z-space file on !! a latitude-longitude grid. -subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just_read_params, frac_shelf_h) +subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just_read, frac_shelf_h) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -2284,8 +2361,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T or S. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: frac_shelf_h !< The fraction of the grid cell covered !! by a floating ice shelf [nondim]. @@ -2329,7 +2406,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just character(len=8) :: laynum integer, parameter :: niter=10 ! number of iterations for t/s adjustment to layer density - logical :: just_read ! If true, just read parameters but set nothing. logical :: adjust_temperature = .true. ! fit t/s to target densities real, parameter :: missing_value = -1.e20 real, parameter :: temp_land_fill = 0.0, salt_land_fill = 35.0 @@ -2382,8 +2458,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just PI_180=atan(1.0)/45. - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (.not.just_read) call log_version(PF, mdl, version, "") @@ -2629,6 +2703,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just old_remap=remap_old_alg, answers_2018=answers_2018 ) call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & old_remap=remap_old_alg, answers_2018=answers_2018 ) + deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 6c36cbbacb..f183231c88 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -17,6 +17,7 @@ module MOM_oda_driver_mod use MOM_io, only : SINGLE_FILE use MOM_interp_infra, only : init_extern_field, get_external_field_info use MOM_interp_infra, only : time_interp_extern +use MOM_remapping, only : remappingSchemesDoc use MOM_time_manager, only : time_type, real_to_time, get_date use MOM_time_manager, only : operator(+), operator(>=), operator(/=) use MOM_time_manager, only : operator(==), operator(<) @@ -65,11 +66,8 @@ module MOM_oda_driver_mod !>@{ CPU time clock ID integer :: id_clock_oda_init -integer :: id_clock_oda_filter integer :: id_clock_bias_adjustment integer :: id_clock_apply_increments -integer :: id_clock_oda_prior -integer :: id_clock_oda_posterior !>@} #include @@ -81,9 +79,9 @@ module MOM_oda_driver_mod !> A structure containing integer handles for bias adjustment of tracers type :: INC_CS - integer :: fldno = 0 !< The number of tracers - integer :: T_id !< The integer handle for the temperature file - integer :: S_id !< The integer handle for the salinity file + integer :: fldno = 0 !< The number of tracers + integer :: T_id !< The integer handle for the temperature file + integer :: S_id !< The integer handle for the salinity file end type INC_CS !> Control structure that contains a transpose of the ocean state across ensemble members. @@ -142,6 +140,7 @@ module MOM_oda_driver_mod !>@{ DA parameters integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 !>@} +character(len=40) :: mdl = "MOM_oda_driver" !< This module's name. contains @@ -178,15 +177,13 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) character(len=30) :: coord_mode character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric + character(len=80) :: remap_scheme character(len=80) :: bias_correction_file, inc_file if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) id_clock_oda_init=cpu_clock_id('(ODA initialization)') - id_clock_oda_prior=cpu_clock_id('(ODA setting prior)') - id_clock_oda_filter=cpu_clock_id('(ODA filter computation)') - id_clock_oda_posterior=cpu_clock_id('(ODA getting posterior)') call cpu_clock_begin(id_clock_oda_init) ! Use ens1 parameters , this could be changed at a later time @@ -195,44 +192,49 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call get_MOM_input(PF,dirs,ensemble_num=0) call unit_scaling_init(PF, CS%US) - call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & + call get_param(PF, mdl, "ASSIM_METHOD", assim_method, & "String which determines the data assimilation method "//& "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM') - call get_param(PF, "MOM", "ASSIM_FREQUENCY", CS%assim_frequency, & + call get_param(PF, mdl, "ASSIM_FREQUENCY", CS%assim_frequency, & "data assimilation frequency in hours") - call get_param(PF, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & + call get_param(PF, mdl, "USE_REGRIDDING", CS%use_ALE_algorithm , & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) - call get_param(PF, "MOM", "REENTRANT_X", CS%reentrant_x, & + call get_param(PF, mdl, "REENTRANT_X", CS%reentrant_x, & "If true, the domain is zonally reentrant.", default=.true.) - call get_param(PF, "MOM", "REENTRANT_Y", CS%reentrant_y, & + call get_param(PF, mdl, "REENTRANT_Y", CS%reentrant_y, & "If true, the domain is meridionally reentrant.", & default=.false.) - call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, & + call get_param(PF, mdl, "TRIPOLAR_N", CS%tripolar_N, & "Use tripolar connectivity at the northern edge of the "//& "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & default=.false.) - call get_param(PF,"MOM", "APPLY_TRACER_TENDENCY_ADJUSTMENT", CS%do_bias_adjustment, & + call get_param(PF, mdl, "APPLY_TRACER_TENDENCY_ADJUSTMENT", CS%do_bias_adjustment, & "If true, add a spatio-temporally varying climatological adjustment "//& "to temperature and salinity.", & default=.false.) if (CS%do_bias_adjustment) then - call get_param(PF,"MOM", "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & + call get_param(PF, mdl, "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & "A multiplicative scaling factor for the climatological tracer tendency adjustment ", & default=1.0) endif - call get_param(PF,"MOM", "USE_BASIN_MASK", CS%use_basin_mask, & + call get_param(PF, mdl, "USE_BASIN_MASK", CS%use_basin_mask, & "If true, add a basin mask to delineate weakly connected "//& "ocean basins for the purpose of data assimilation.", & default=.false.) - call get_param(PF,"MOM", "NIGLOBAL", CS%ni, & + call get_param(PF, mdl, "NIGLOBAL", CS%ni, & "The total number of thickness grid points in the "//& "x-direction in the physical domain.") - call get_param(PF,"MOM", "NJGLOBAL", CS%nj, & + call get_param(PF, mdl, "NJGLOBAL", CS%nj, & "The total number of thickness grid points in the "//& "y-direction in the physical domain.") - call get_param(PF, 'MOM', "INPUTDIR", inputdir) + call get_param(PF, mdl, "INPUTDIR", inputdir) + call get_param(PF, mdl, "ODA_REMAPPING_SCHEME", remap_scheme, & + "This sets the reconstruction scheme used "//& + "for vertical remapping for all variables. "//& + "It can be one of the following schemes: "//& + trim(remappingSchemesDoc), default="PPM_H4") inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) @@ -276,12 +278,12 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) allocate(dG) call create_dyn_horgrid(dG, HI) call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.) - call set_grid_metrics(dG,PF) - call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF) + call set_grid_metrics(dG, PF, CS%US) + call MOM_initialize_topography(dG%bathyT, dG%max_depth, dG, PF, CS%US) call MOM_initialize_coord(CS%GV, CS%US, PF, .false., & dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) - call MOM_grid_init(CS%Grid, PF) + call MOM_grid_init(CS%Grid, PF, global_indexing=.false.) call ALE_updateVerticalGridType(CS%ALE_CS, CS%GV) call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) CS%mpp_domain => CS%Grid%Domain%mpp_domain @@ -300,7 +302,7 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) "Coordinate mode for vertical regridding.", & default="ZSTAR", fail_if_missing=.false.) call initialize_regridding(CS%regridCS, CS%GV, CS%US, dG%max_depth,PF,'oda_driver',coord_mode,'','') - call initialize_remapping(CS%remapCS,'PLM') + call initialize_remapping(CS%remapCS,remap_scheme) call set_regrid_params(CS%regridCS, min_thickness=0.) isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed @@ -311,9 +313,9 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) !jsd=jsd+jdg_offset; jed=jed+jdg_offset ! TODO: switch to local indexing? (mjh) if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_m*CS%GV%H_to_m) + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_H) ! assign thicknesses - call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) + call ALE_initThicknessToCoord(CS%ALE_CS, G, CS%GV, CS%h) endif allocate(CS%tv) allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke), source=0.0) @@ -351,21 +353,21 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) if (CS%do_bias_adjustment) then - call get_param(PF, "MOM", "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & - "The name of the file containing temperature and salinity "//& - "tendency adjustments", default='temp_salt_adjustment.nc') + call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + "The name of the file containing temperature and salinity "//& + "tendency adjustments", default='temp_salt_adjustment.nc') - inc_file = trim(inputdir) // trim(bias_correction_file) - CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + inc_file = trim(inputdir) // trim(bias_correction_file) + CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) - CS%INC_CS%fldno = 2 - if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') - allocate(CS%tv_bc) ! storage for increment - allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) - allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + CS%INC_CS%fldno = 2 + if (CS%nk /= fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') + allocate(CS%tv_bc) ! storage for increment + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -405,7 +407,6 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) !call MOM_mesg('Setting prior') - call cpu_clock_begin(id_clock_oda_prior) ! computational domain for the analysis grid isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec @@ -432,7 +433,6 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) call pass_var(CS%Ocean_prior%S(:,:,:,m),CS%Grid%domain) enddo - call cpu_clock_end(id_clock_oda_prior) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -455,13 +455,12 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) integer :: seconds_per_hour = 3600. ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time .or. CS%assim_method .eq. NO_ASSIM) return + if (Time < CS%Time .or. CS%assim_method == NO_ASSIM) return !! switch to global pelist call set_PElist(CS%filter_pelist) call MOM_mesg('Getting posterior') - call cpu_clock_begin(id_clock_oda_posterior) if (present(h)) h => CS%h ! get analysis thickness !! Calculate and redistribute increments to CS%tv right after assimilation !! Retain CS%tv to calculate increments for IAU updates CS%tv_inc otherwise @@ -490,7 +489,6 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) if (present(tv)) tv => CS%tv if (present(h)) h => CS%h - call cpu_clock_end(id_clock_oda_posterior) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -518,12 +516,10 @@ subroutine oda(Time, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) - call cpu_clock_begin(id_clock_oda_filter) call get_profiles(Time, CS%Profiles, CS%CProfiles) #ifdef ENABLE_ECDA call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid) #endif - call cpu_clock_end(id_clock_oda_filter) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) call get_posterior_tracer(Time, CS, increment=.true.) @@ -535,43 +531,43 @@ subroutine oda(Time, CS) end subroutine oda subroutine get_bias_correction_tracer(Time, CS) - type(time_type), intent(in) :: Time !< the current model time - type(ODA_CS), pointer :: CS !< ocean DA control structure - - integer :: i,j,k - real, allocatable, dimension(:,:,:) :: T_bias, S_bias - real, allocatable, dimension(:,:,:) :: mask_z - real, allocatable, dimension(:), target :: z_in, z_edges_in - real :: missing_value - integer,dimension(3) :: fld_sz - - call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - - ! This should be replaced to use mask_z instead of the following lines - ! which are intended to zero land values using an arbitrary limit. - fld_sz=shape(T_bias) - do i=1,fld_sz(1) - do j=1,fld_sz(2) - do k=1,fld_sz(3) - if (T_bias(i,j,k) .gt. 1.0E-3) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) .gt. 1.0E-3) S_bias(i,j,k) = 0.0 - enddo - enddo + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + + integer :: i,j,k + real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: mask_z + real, allocatable, dimension(:), target :: z_in, z_edges_in + real :: missing_value + integer,dimension(3) :: fld_sz + + call cpu_clock_begin(id_clock_bias_adjustment) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + + ! This should be replaced to use mask_z instead of the following lines + ! which are intended to zero land values using an arbitrary limit. + fld_sz=shape(T_bias) + do i=1,fld_sz(1) + do j=1,fld_sz(2) + do k=1,fld_sz(3) + if (T_bias(i,j,k) > 1.0E-3) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) > 1.0E-3) S_bias(i,j,k) = 0.0 + enddo enddo + enddo - CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier - CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier + CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier - call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) - call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) - call cpu_clock_end(id_clock_bias_adjustment) + call cpu_clock_end(id_clock_bias_adjustment) - end subroutine get_bias_correction_tracer +end subroutine get_bias_correction_tracer !> Finalize DA module subroutine oda_end(CS) @@ -659,7 +655,7 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real :: missing_value if (.not. associated(CS)) return - if (CS%assim_method .eq. NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return + if (CS%assim_method == NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return call cpu_clock_begin(id_clock_apply_increments) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 91210a328d..ab3621296f 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -92,14 +92,12 @@ module MOM_oda_incupd !> This subroutine defined the control structure of module and register !the time counter to full update in restart subroutine initialize_oda_incupd_fixed( G, GV, US, CS, restart_CS) - - type(ocean_grid_type), intent(in) :: G !< The ocean's 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(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module (in/out). - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - + type(ocean_grid_type), intent(in) :: G !< The ocean's 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(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -116,28 +114,23 @@ subroutine initialize_oda_incupd_fixed( G, GV, US, CS, restart_CS) ! register ncount in restart call register_restart_field(CS%ncount, "oda_incupd_ncount", .false., restart_CS,& "Number of inc. update already done", "N/A") - - end subroutine initialize_oda_incupd_fixed !> This subroutine defined the number of time step for full update, stores the layer pressure !! increments and initialize remap structure. subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, restart_CS) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, intent(in) :: nz_data !< The total number of incr. input layers. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. - type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module (in/out). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: nz_data !< The total number of incr. input layers. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The ODA h !! [H ~> m or kg m-2]. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. - + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -242,8 +235,6 @@ subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, res ! Call the constructor for remapping control structure call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & answers_2018=.false.) - - end subroutine initialize_oda_incupd diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 5efb318db1..c786f395cf 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -29,9 +29,8 @@ module MOM_MEKE !> Control structure that contains MEKE parameters and diagnostics handles type, public :: MEKE_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. ! Parameters - real, dimension(:,:), pointer :: equilibrium_value => NULL() !< The equilbrium value - !! of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] @@ -81,7 +80,11 @@ module MOM_MEKE real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE [nondim] real :: MEKE_topographic_beta !< Weight for how much topographic beta is considered !! when computing beta in Rhines scale [nondim] - real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its equilibrium value [s-1]. + real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its + !! equilibrium value [T-1 ~> s-1]. + logical :: MEKE_advection_bug !< If true, recover a bug in the calculation of the barotropic + !! transport for the advection of MEKE, wherein only the transports in the + !! deepest layer are used. logical :: fixed_total_depth !< If true, use the nominal bathymetric depth as the estimate of !! the time-varying ocean depth. Otherwise base the depth on the total !! ocean mass per unit area. @@ -111,7 +114,7 @@ module MOM_MEKE !> Integrates forward-in-time the MEKE eddy energy equation. !! See \ref section_MEKE_equations. subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, hv) - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -120,7 +123,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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 [T ~> s]. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] @@ -138,17 +141,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2, & ! Ratio of EKE_bottom / EKE [nondim] - tmp ! Temporary variable for diagnostic computation + tmp, & ! Temporary variable for diagnostic computation + equilibrium_value ! The equilbrium value of MEKE to be calculated at each + ! time step [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m-2 s-3]. + MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. ! In one place, MEKE_uflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHu, & ! Depth integrated accumulated zonal mass flux [R Z L2 ~> kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at ! u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m-2 s-3]. + MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. ! In one place, MEKE_vflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHv, & ! Depth integrated accumulated meridional mass flux [R Z L2 ~> kg]. @@ -172,10 +177,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_MEKE: Module must be initialized before it is used.") - if (.not.associated(MEKE)) call MOM_error(FATAL, & - "MOM_MEKE: MEKE must be initialized before it is used.") if ((CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) .or. CS%visc_drag) then use_drag_rate = .true. @@ -184,19 +187,20 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Only integrate the MEKE equations if MEKE is required. - if (.not.associated(MEKE%MEKE)) then + if (.not. allocated(MEKE%MEKE)) then ! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") return endif if (CS%debug) then - if (associated(MEKE%mom_src)) & + if (allocated(MEKE%mom_src)) & call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%GME_snk)) & + if (allocated(MEKE%GME_snk)) & call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%GM_src)) & + if (allocated(MEKE%GM_src)) & call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) + if (allocated(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, & scalar_pair=.true.) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, & @@ -220,7 +224,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do j=js,je ; do I=is-1,ie - baroHu(I,j) = hu(I,j,k) * GV%H_to_RZ + baroHu(I,j) = baroHu(I,j) + hu(I,j,k) * GV%H_to_RZ enddo ; enddo enddo do J=js-1,je ; do i=is,ie @@ -228,9 +232,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do J=js-1,je ; do i=is,ie - baroHv(i,J) = hv(i,J,k) * GV%H_to_RZ + baroHv(i,J) = baroHv(i,J) + hv(i,J,k) * GV%H_to_RZ enddo ; enddo enddo + if (CS%MEKE_advection_bug) then + ! This code obviously incorrect code reproduces a bug in the original implementation of + ! the MEKE advection. + do j=js,je ; do I=is-1,ie + baroHu(I,j) = hu(I,j,nz) * GV%H_to_RZ + enddo ; enddo + do J=js-1,je ; do i=is,ie + baroHv(i,J) = hv(i,J,nz) * GV%H_to_RZ + enddo ; enddo + endif endif @@ -312,21 +326,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h src(i,j) = CS%MEKE_BGsrc enddo ; enddo - if (associated(MEKE%mom_src)) then + if (allocated(MEKE%mom_src)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) enddo ; enddo endif - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif - if (associated(MEKE%GM_src)) then + if (allocated(MEKE%GM_src)) then if (CS%GM_src_alt) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie @@ -342,9 +356,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif if (CS%MEKE_equilibrium_restoring) then - call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) + call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & + equilibrium_value) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - CS%equilibrium_value(i,j)) + src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - equilibrium_value(i,j)) enddo ; enddo endif @@ -459,10 +474,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_here = max(0., CS%MEKE_Kh) + & CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) - if (associated(MEKE%Kh_diff)) & + if (allocated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + & CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -477,9 +492,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) - if (associated(MEKE%Kh_diff)) & + if (allocated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -600,7 +615,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif - if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) then + if (allocated(MEKE%Kh) .or. allocated(MEKE%Ku) .or. allocated(MEKE%Au)) then call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Kh, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -661,8 +676,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution @@ -822,13 +837,16 @@ end subroutine MEKE_equilibrium !< This subroutine calculates a new equilibrium value for MEKE at each time step. This is not copied into !! MEKE%MEKE; rather, it is used as a restoring term to nudge MEKE%MEKE back to an equilibrium value -subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) +subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & + equilibrium_value) type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: equilibrium_value + !< Equilbrium value of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] ! Local variables real :: SN ! The local Eady growth rate [T-1 ~> s-1] @@ -837,20 +855,17 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec cd2 = CS%cdrag**2 - - if (.not. associated(CS%equilibrium_value)) allocate(CS%equilibrium_value(SZI_(G),SZJ_(G))) - CS%equilibrium_value(:,:) = 0.0 + equilibrium_value(:,:) = 0.0 !$OMP do do j=js,je ; do i=is,ie ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - CS%equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 + equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 enddo ; enddo - if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, CS%equilibrium_value, CS%diag) - + if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, equilibrium_value, CS%diag) end subroutine MEKE_equilibrium_restoring !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ @@ -858,8 +873,8 @@ end subroutine MEKE_equilibrium_restoring !! column eddy energy, respectively. See \ref section_MEKE_equations. subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & bottomFac2, barotrFac2, LmixScale) - type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. + type(MEKE_type), intent(in) :: MEKE !< MEKE field type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -933,7 +948,7 @@ end subroutine MEKE_lengthScales !! column eddy energy, respectively. See \ref section_MEKE_equations. subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: area !< Grid cell area [L2 ~> m2] real, intent(in) :: beta !< Planetary beta = \f$ \nabla f\f$ [T-1 L-1 ~> s-1 m-1] @@ -1010,9 +1025,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. - type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE-related fields. - type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. + type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this @@ -1038,18 +1053,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "a sub-grid mesoscale eddy kinetic energy budget.", & default=.false.) if (.not. MEKE_init) return - - if (.not. associated(MEKE)) then - ! The MEKE structure should have been allocated in MEKE_alloc_register_restart() - call MOM_error(WARNING, "MEKE_init called with NO associated "// & - "MEKE-type structure.") - return - endif - if (associated(CS)) then - call MOM_error(WARNING, & - "MEKE_init called with an associated control structure.") - return - else ; allocate(CS) ; endif + CS%initialized = .true. call MOM_mesg("MEKE_init: reading parameters ", 5) @@ -1212,6 +1216,10 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "Using unity would be normal but other values could accommodate a mismatch "//& "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) + call get_param(param_file, mdl, "MEKE_ADVECTION_BUG", CS%MEKE_advection_bug, & + "If true, recover a bug in the calculation of the barotropic transport for "//& + "the advection of MEKE. With the bug, only the transports in the deepest "//& + "layer are used.", default=.false., do_not_log=(CS%MEKE_advection_factor<=0.)) call get_param(param_file, mdl, "MEKE_TOPOGRAPHIC_BETA", CS%MEKE_topographic_beta, & "A scale factor to determine how much topographic beta is weighed in " //& "computing beta in the expression of Rhines scale. Use 1 if full "//& @@ -1247,25 +1255,25 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_MEKE = -1 CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & 'MEKE derived diffusivity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 + if (.not. allocated(MEKE%Kh)) CS%id_Kh = -1 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 + if (.not. allocated(MEKE%Ku)) CS%id_Ku = -1 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) - if (.not. associated(MEKE%Au)) CS%id_Au = -1 + if (.not. allocated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ue = -1 CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & 'MEKE derived bottom eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ub = -1 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & 'MEKE derived barotropic eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ut = -1 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3', conversion=(US%L_T_to_m_s**2)*US%s_to_T) CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & @@ -1273,15 +1281,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) 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%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 + if (.not. allocated(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%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 + if (.not. allocated(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%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 + if (.not. allocated(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) CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & @@ -1325,31 +1333,31 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) L_rescale = US%m_to_L / US%m_to_L_restart if (L_rescale*I_T_rescale /= 1.0) then - if (associated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then + if (allocated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = L_rescale*I_T_rescale * MEKE%MEKE(i,j) enddo ; enddo endif ; endif endif if (L_rescale**2*I_T_rescale /= 1.0) then - if (associated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then + if (allocated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Kh(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh(i,j) enddo ; enddo endif ; endif - if (associated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then + if (allocated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Ku(i,j) = L_rescale**2*I_T_rescale * MEKE%Ku(i,j) enddo ; enddo endif ; endif - if (associated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then + if (allocated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Kh_diff(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh_diff(i,j) enddo ; enddo endif ; endif endif if (L_rescale**4*I_T_rescale /= 1.0) then - if (associated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then + if (allocated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) enddo ; enddo @@ -1357,16 +1365,16 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) endif ! Set up group passes. In the case of a restart, these fields need a halo update now. - if (associated(MEKE%MEKE)) then + if (allocated(MEKE%MEKE)) then call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) - if (associated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) + if (allocated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) if (.not.CS%initialize) call do_group_pass(CS%pass_MEKE, G%Domain) endif - if (associated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) - if (associated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) - if (associated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) + if (allocated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + if (allocated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) + if (allocated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) - if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) & + if (allocated(MEKE%Kh) .or. allocated(MEKE%Ku) .or. allocated(MEKE%Au)) & call do_group_pass(CS%pass_Kh, G%Domain) end function MEKE_init @@ -1376,8 +1384,8 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. - type(MEKE_type), pointer :: MEKE !< A structure with MEKE-related fields. - type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_GMECoeff, MEKE_KHCoeff, MEKE_viscCoeff_Ku, MEKE_viscCoeff_Au @@ -1396,12 +1404,6 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) MEKE_viscCoeff_Ku =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_KU",MEKE_viscCoeff_Ku) MEKE_viscCoeff_Au =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_AU",MEKE_viscCoeff_Au) Use_KH_in_MEKE = .false.; call read_param(param_file,"USE_KH_IN_MEKE", Use_KH_in_MEKE) -! Allocate control structure - if (associated(MEKE)) then - call MOM_error(WARNING, "MEKE_alloc_register_restart called with an associated "// & - "MEKE type.") - return - else; allocate(MEKE); endif if (.not. useMEKE) return @@ -1453,15 +1455,15 @@ subroutine MEKE_end(MEKE) ! So these must all be conditional, even though MEKE%MEKE and MEKE%Rd_dx_h ! are always allocated (when MEKE is enabled) - if (associated(MEKE%Au)) deallocate(MEKE%Au) - if (associated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) - if (associated(MEKE%Ku)) deallocate(MEKE%Ku) - if (associated(MEKE%Rd_dx_h)) deallocate(MEKE%Rd_dx_h) - if (associated(MEKE%Kh)) deallocate(MEKE%Kh) - if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) - if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) - if (associated(MEKE%GM_src)) deallocate(MEKE%GM_src) - if (associated(MEKE%MEKE)) deallocate(MEKE%MEKE) + if (allocated(MEKE%Au)) deallocate(MEKE%Au) + if (allocated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) + if (allocated(MEKE%Ku)) deallocate(MEKE%Ku) + if (allocated(MEKE%Rd_dx_h)) deallocate(MEKE%Rd_dx_h) + if (allocated(MEKE%Kh)) deallocate(MEKE%Kh) + if (allocated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) + if (allocated(MEKE%mom_src)) deallocate(MEKE%mom_src) + if (allocated(MEKE%GM_src)) deallocate(MEKE%GM_src) + if (allocated(MEKE%MEKE)) deallocate(MEKE%MEKE) end subroutine MEKE_end !> \namespace mom_meke diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 01a602157a..57de7c0b02 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -7,21 +7,22 @@ module MOM_MEKE_types !> This type is used to exchange information related to the MEKE calculations. type, public :: MEKE_type ! 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) [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]. - Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. - !! Rd_dx_h is copied from VarMix_CS. - real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient - !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing - !! backscatter from unresolved eddies (see Jansen and Held, 2014). - real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity - !! coefficient [L4 T-1 ~> m4 s-1]. + real, allocatable :: MEKE(:,:) !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + real, allocatable :: GM_src(:,:) !< MEKE source due to thickness mixing (GM) [R Z L2 T-3 ~> W m-2]. + real, allocatable :: mom_src(:,:) !< MEKE source from lateral friction in the + !! momentum equations [R Z L2 T-3 ~> W m-2]. + real, allocatable :: GME_snk(:,:) !< MEKE sink from GME backscatter in the momentum equations [R Z L2 T-3 ~> W m-2]. + real, allocatable :: Kh(:,:) !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. + real, allocatable :: Kh_diff(:,:) !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse + !! MEKE [L2 T-1 ~> m2 s-1]. + real, allocatable :: Rd_dx_h(:,:) !< The deformation radius compared with the grid spacing [nondim]. + !! Rd_dx_h is copied from VarMix_CS. + real, allocatable :: Ku(:,:) !< The MEKE-derived lateral viscosity coefficient + !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! backscatter from unresolved eddies (see Jansen and Held, 2014). + real, allocatable :: Au(:,:) !< The MEKE-derived lateral biharmonic viscosity + !! coefficient [L4 T-1 ~> m4 s-1]. + ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7a3e56ef63..0249f79c2d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -6,6 +6,8 @@ module MOM_hor_visc use MOM_checksums, only : hchksum, Bchksum use MOM_coms, only : min_across_PEs use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, CORNER, pass_vector, AGRID, BGRID_NE use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe @@ -30,6 +32,7 @@ module MOM_hor_visc !> Control structure for horizontal viscosity type, public :: hor_visc_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: Laplacian !< Use a Laplacian horizontal viscosity if true. logical :: biharmonic !< Use a biharmonic horizontal viscosity if true. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -177,8 +180,8 @@ module MOM_hor_visc type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics - ! real, pointer :: hf_diffu(:,:,:) => NULL() ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, pointer :: hf_diffv(:,:,:) => NULL() ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffu(:,:,:) ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffv(:,:,:) ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. ! The code is retained for degugging purposes in the future. @@ -233,19 +236,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: diffv !< Meridional acceleration due to convergence !! of along-coordinate stress tensor [L T-2 ~> m s-2]. - type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! related to Mesoscale Eddy Kinetic Energy. - type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that - !! specify the spatially variable viscosities + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(hor_visc_CS), pointer :: CS !< Control structure returned by a previous - !! call to hor_visc_init. + type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type - type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing - !! barotropic velocities. - type(thickness_diffuse_CS), optional, pointer :: TD !< Pointer to a structure containing - !! thickness diffusivities. - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers + type(barotropic_CS), intent(in), optional :: BT !< Barotropic control struct + type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control struct + type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -419,35 +418,39 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, apply_OBC = .true. endif ; endif ; endif - if (.not.associated(CS)) call MOM_error(FATAL, & + if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_hor_visc: Module must be initialized before it is used.") + if (.not.(CS%Laplacian .or. CS%biharmonic)) return find_FrictWork = (CS%id_FrictWork > 0) if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. - if (associated(MEKE)) then - if (associated(MEKE%mom_src)) find_FrictWork = .true. - backscat_subround = 0.0 - if (find_FrictWork .and. associated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & - (MEKE%backscatter_Ro_Pow /= 0.0)) & - backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) - endif + + if (allocated(MEKE%mom_src)) find_FrictWork = .true. + backscat_subround = 0.0 + if (find_FrictWork .and. allocated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & + (MEKE%backscatter_Ro_Pow /= 0.0)) & + backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) + + ! Toggle whether to use a Laplacian viscosity derived from MEKE + use_MEKE_Ku = allocated(MEKE%Ku) + use_MEKE_Au = allocated(MEKE%Au) rescale_Kh = .false. - if (associated(VarMix)) then + if (VarMix%use_variable_mixing) then rescale_Kh = VarMix%Resoln_scaled_Kh - if (rescale_Kh .and. & - (.not.associated(VarMix%Res_fn_h) .or. .not.associated(VarMix%Res_fn_q))) & - call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and " //& - "VarMix%Res_fn_q both need to be associated with Resoln_scaled_Kh.") + if ((rescale_Kh .or. CS%res_scale_MEKE) & + .and. (.not. allocated(VarMix%Res_fn_h) .or. .not. allocated(VarMix%Res_fn_q))) & + call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and VarMix%Res_fn_q "//& + "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") + elseif (CS%res_scale_MEKE) then + call MOM_error(FATAL, "MOM_hor_visc: VarMix needs to be associated if "//& + "RES_SCALE_MEKE_VISC is True.") endif + legacy_bound = (CS%Smagorinsky_Kh .or. CS%Leith_Kh) .and. & (CS%bound_Kh .and. .not.CS%better_bound_Kh) - ! Toggle whether to use a Laplacian viscosity derived from MEKE - use_MEKE_Ku = associated(MEKE%Ku) - use_MEKE_Au = associated(MEKE%Au) - if (CS%use_GME) then do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 boundary_mask_h(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) @@ -811,7 +814,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) Del2vort_q(I,J) = DY_dxBu * (vort_xy_dx(i+1,J) * G%IdyCv(i+1,J) - vort_xy_dx(i,J) * G%IdyCv(i,J)) + & - DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j)) + DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j)) enddo ; enddo do J=Jsq,Jeq+1 ; do I=Isq,Ieq+1 Del2vort_h(i,j) = 0.25*(Del2vort_q(I,J) + Del2vort_q(I-1,J) + Del2vort_q(I,J-1) + Del2vort_q(I-1,J-1)) @@ -829,12 +832,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Magnitude of divergence gradient do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - grad_div_mag_h(i,j) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) + grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + (0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) enddo ; enddo do j=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+1 - grad_div_mag_q(I,J) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) + grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + (0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) enddo ; enddo else @@ -892,15 +895,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! CS%Leith_Kh - meke_res_fn = 1. - if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - sh_xx_sq = sh_xx(i,j) * sh_xx(i,j) - sh_xy_sq = 0.25 * ( & - (sh_xy(I-1,J-1) * sh_xy(I-1,J-1) + sh_xy(I,J) * sh_xy(I,J)) & - + (sh_xy(I-1,J) * sh_xy(I-1,J) + sh_xy(I,J-1) * sh_xy(I,J-1)) & - ) + sh_xx_sq = sh_xx(i,j)**2 + sh_xy_sq = 0.25 * ( (sh_xy(I-1,J-1)**2 + sh_xy(I,J)**2) & + + (sh_xy(I-1,J)**2 + sh_xy(I,J-1)**2) ) Shear_mag(i,j) = sqrt(sh_xx_sq + sh_xy_sq) enddo ; enddo endif @@ -977,13 +976,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Kh(i,j) = max(Kh(i,j), CS%Kh_bg_min) enddo ; enddo - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_h(i,j) - - if (use_MEKE_Ku) & - ! *Add* the MEKE contribution (might be negative) - Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) * meke_res_fn - enddo ; enddo + if (use_MEKE_Ku) then + ! *Add* the MEKE contribution (which might be negative) + if (CS%res_scale_MEKE) then + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) * VarMix%Res_fn_h(i,j) + enddo ; enddo + else + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) + enddo ; enddo + endif + endif if (CS%anisotropic) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -993,16 +997,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Newer method of bounding for stability - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if (CS%better_bound_Kh) then + if (CS%better_bound_Kh) then + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xx(i,j)) then visc_bound_rem(i,j) = 0.0 Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xx(i,j) else + ! ### NOTE: The denominator could be zero here - AJA ### visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xx(i,j)) endif - endif - enddo ; enddo + enddo ; enddo + endif if (CS%id_Kh_h>0 .or. CS%debug) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1173,12 +1178,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then do J=js-1,Jeq ; do I=is-1,Ieq - sh_xy_sq = sh_xy(I,J) * sh_xy(I,J) - sh_xx_sq = 0.25 * ( & - (sh_xx(i,j) * sh_xx(i,j) + sh_xx(i+1,j+1) * sh_xx(i+1,j+1)) & - + (sh_xx(i,j+1) * sh_xx(i,j+1) + sh_xx(i+1,j) * sh_xx(i+1,j)) & - ) - Shear_mag(i,j) = sqrt(sh_xy_sq + sh_xx_sq) + sh_xy_sq = sh_xy(I,J)**2 + sh_xx_sq = 0.25 * ( (sh_xx(i,j)**2 + sh_xx(i+1,j+1)**2) & + + (sh_xx(i,j+1)**2 + sh_xx(i+1,j)**2) ) + Shear_mag(I,J) = sqrt(sh_xy_sq + sh_xx_sq) enddo ; enddo endif @@ -1192,7 +1195,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%better_bound_Ah .or. CS%better_bound_Kh) then do J=js-1,Jeq ; do I=is-1,Ieq h_min = min(h_u(I,j), h_u(I,j+1), h_v(i,J), h_v(i+1,J)) - hrat_min(i,j) = min(1.0, h_min / (hq(I,J) + h_neglect)) + hrat_min(I,J) = min(1.0, h_min / (hq(I,J) + h_neglect)) enddo ; enddo if (CS%better_bound_Kh) then @@ -1215,11 +1218,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (G%mask2dCv(i,J) + G%mask2dCv(i+1,J)) == 0.0) then ! Only one of hu and hv is nonzero, so just add them. hq(I,J) = hu + hv - hrat_min(i,j) = 1.0 + hrat_min(I,J) = 1.0 else ! Both hu and hv are nonzero, so take the harmonic mean. hq(I,J) = 2.0 * (hu * hv) / ((hu + hv) + h_neglect) - hrat_min(i,j) = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) + hrat_min(I,J) = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) endif endif endif @@ -1232,11 +1235,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq grad_vort = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) grad_vort_qg = 3. * grad_vort_mag_q_2d(I,J) - vert_vort_mag(i,j) = min(grad_vort, grad_vort_qg) + vert_vort_mag(I,J) = min(grad_vort, grad_vort_qg) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - vert_vort_mag(i,j) = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) + vert_vort_mag(I,J) = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) enddo ; enddo endif endif @@ -1252,11 +1255,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Kh) then if (CS%add_LES_viscosity) then do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = Kh(i,j) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j) + Kh(I,J) = Kh(I,J) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = max(Kh(i,j), CS%Laplac2_const_xy(I,J) * Shear_mag(i,j) ) + Kh(I,J) = max(Kh(I,J), CS%Laplac2_const_xy(I,J) * Shear_mag(i,j) ) enddo ; enddo endif endif @@ -1264,11 +1267,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Leith_Kh) then if (CS%add_LES_viscosity) then do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = Kh(i,j) + CS%Laplac3_const_xx(i,j) * vert_vort_mag(i,j) * inv_PI3 + Kh(I,J) = Kh(I,J) + CS%Laplac3_const_xx(i,j) * vert_vort_mag(I,J) * inv_PI3 ! Is this right? -AJA enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = max(Kh(i,j), CS%Laplac3_const_xy(I,J) * vert_vort_mag(i,j) * inv_PI3) + Kh(I,J) = max(Kh(I,J), CS%Laplac3_const_xy(I,J) * vert_vort_mag(I,J) * inv_PI3) enddo ; enddo endif endif @@ -1279,40 +1282,40 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! stack size has been reduced. do J=js-1,Jeq ; do I=is-1,Ieq if (rescale_Kh) & - Kh(i,j) = VarMix%Res_fn_q(i,j) * Kh(i,j) + Kh(I,J) = VarMix%Res_fn_q(I,J) * Kh(I,J) if (CS%res_scale_MEKE) & - meke_res_fn = VarMix%Res_fn_q(i,j) + meke_res_fn = VarMix%Res_fn_q(I,J) ! Older method of bounding for stability if (legacy_bound) & - Kh(i,j) = min(Kh(i,j), CS%Kh_Max_xy(i,j)) + Kh(I,J) = min(Kh(I,J), CS%Kh_Max_xy(I,J)) - Kh(i,j) = max(Kh(i,j), CS%Kh_bg_min) ! Place a floor on the viscosity, if desired. + Kh(I,J) = max(Kh(I,J), CS%Kh_bg_min) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative) - Kh(i,j) = Kh(i,j) + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + Kh(I,J) = Kh(I,J) + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & (MEKE%Ku(i+1,j) + MEKE%Ku(i,j+1)) ) * meke_res_fn endif ! Older method of bounding for stability if (CS%anisotropic) & ! *Add* the shear component of anisotropic viscosity - Kh(i,j) = Kh(i,j) + CS%Kh_aniso * CS%n1n2_q(I,J)**2 + Kh(I,J) = Kh(I,J) + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! Newer method of bounding for stability if (CS%better_bound_Kh) then - if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xy(I,J)) then + if (Kh(i,j) >= hrat_min(I,J) * CS%Kh_Max_xy(I,J)) then visc_bound_rem(i,j) = 0.0 - Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xy(I,J) - elseif (CS%Kh_Max_xy(I,J)>0.) then - visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xy(I,J)) + Kh(i,j) = hrat_min(I,J) * CS%Kh_Max_xy(I,J) + elseif (hrat_min(I,J)*CS%Kh_Max_xy(I,J)>0.) then + visc_bound_rem(I,J) = 1.0 - Kh(I,J) / (hrat_min(I,J) * CS%Kh_Max_xy(I,J)) endif endif if (CS%id_Kh_q>0 .or. CS%debug) & - Kh_q(I,J,k) = Kh(i,j) + Kh_q(I,J,k) = Kh(I,J) if (CS%id_vort_xy_q>0) & vort_xy_q(I,J,k) = vort_xy(I,J) @@ -1350,15 +1353,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then do J=js-1,Jeq ; do I=is-1,Ieq - AhSm = Shear_mag(i,j) * (CS%Biharm_const_xy(I,J) & - + CS%Biharm_const2_xy(I,J) * Shear_mag(i,j) & + AhSm = Shear_mag(I,J) * (CS%Biharm_const_xy(I,J) & + + CS%Biharm_const2_xy(I,J) * Shear_mag(I,J) & ) Ah(i,j) = max(Ah(I,J), AhSm) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - AhSm = CS%Biharm_const_xy(I,J) * Shear_mag(i,j) - Ah(i,j) = max(Ah(I,J), AhSm) + AhSm = CS%Biharm_const_xy(I,J) * Shear_mag(I,J) + Ah(I,J) = max(Ah(I,J), AhSm) enddo ; enddo endif endif @@ -1366,13 +1369,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Leith_Ah) then do J=js-1,Jeq ; do I=is-1,Ieq AhLth = CS%Biharm6_const_xy(I,J) * abs(Del2vort_q(I,J)) * inv_PI6 - Ah(i,j) = max(Ah(I,J), AhLth) + Ah(I,J) = max(Ah(I,J), AhLth) enddo ; enddo endif if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(I,J), CS%Ah_Max_xy(I,J)) enddo ; enddo endif endif ! Smagorinsky_Ah or Leith_Ah @@ -1380,7 +1383,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (use_MEKE_Au) then ! *Add* the MEKE contribution do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = Ah(i,j) + 0.25 * ( & + Ah(I,J) = Ah(I,J) + 0.25 * ( & (MEKE%Au(i,j) + MEKE%Au(i+1,j+1)) + (MEKE%Au(i+1,j) + MEKE%Au(i,j+1)) & ) enddo ; enddo @@ -1389,31 +1392,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Re_Ah > 0.0) then do J=js-1,Jeq ; do I=is-1,Ieq KE = 0.125 * ((u(I,j,k) + u(I,j+1,k))**2 + (v(i,J,k) + v(i+1,J,k))**2) - Ah(i,j) = sqrt(KE) * CS%Re_Ah_const_xy(i,j) + Ah(I,J) = sqrt(KE) * CS%Re_Ah_const_xy(i,j) enddo ; enddo endif if (CS%better_bound_Ah) then if (CS%better_bound_Kh) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(i,j) * CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(I,J) * CS%Ah_Max_xy(I,J)) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), hrat_min(i,j) * CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(i,j), hrat_min(I,J) * CS%Ah_Max_xy(I,J)) enddo ; enddo endif endif if (CS%id_Ah_q>0 .or. CS%debug) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah_q(I,J,k) = Ah(i,j) + Ah_q(I,J,k) = Ah(I,J) enddo ; enddo endif ! Again, need to initialize str_xy as if its biharmonic do J=js-1,Jeq ; do I=is-1,Ieq - d_str = Ah(i,j) * (dDel2vdx(I,J) + dDel2udy(I,J)) + d_str = Ah(I,J) * (dDel2vdx(I,J) + dDel2udy(I,J)) str_xy(I,J) = str_xy(I,J) + d_str @@ -1423,6 +1426,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%use_GME) then + !### This call to get the 3-d GME diffusivity arrays and the subsequent blocking halo update + ! should occur outside of the k-loop, and perhaps the halo update should occur outside of + ! this routine altogether! call thickness_diffuse_get_KH(TD, KH_u_GME, KH_v_GME, G, GV) call pass_vector(KH_u_GME, KH_v_GME, G%Domain) @@ -1447,8 +1453,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! Applying GME diagonal term. This is linear and the arguments can be rescaled. - call smooth_GME(CS, G, GME_flux_h=str_xx_GME) - call smooth_GME(CS, G, GME_flux_q=str_xy_GME) + call smooth_GME(G, GME_flux_h=str_xx_GME) + call smooth_GME(G, GME_flux_q=str_xy_GME) do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) @@ -1463,7 +1469,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif enddo ; enddo - if (associated(MEKE%GME_snk)) then + if (allocated(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) enddo ; enddo @@ -1552,12 +1558,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Make a similar calculation as for FrictWork above but accumulating into ! the vertically integrated MEKE source term, and adjusting for any ! energy loss seen as a reduction in the (biharmonic) frictional source term. - if (find_FrictWork .and. associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + if (find_FrictWork .and. allocated(MEKE%mom_src)) then if (k==1) then do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = 0. enddo ; enddo - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie MEKE%GME_snk(i,j) = 0. enddo ; enddo @@ -1610,13 +1616,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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 + if (CS%use_GME .and. allocated(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 ; endif ! find_FrictWork and associated(mom_src) + endif ! find_FrictWork and associated(mom_src) enddo ! end of k loop @@ -1659,89 +1665,28 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call post_data(CS%id_FrictWorkIntz, FrictWorkIntz, CS%diag) endif - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (present(ADp) .and. (CS%id_hf_diffu > 0)) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_diffu, CS%hf_diffu, CS%diag) - !endif - !if (present(ADp) .and. (CS%id_hf_diffv > 0)) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_diffv, CS%hf_diffv, CS%diag) - !endif - if (present(ADp)) then - if (CS%id_hf_diffu_2d > 0) then - hf_diffu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_diffu_2d(I,j) = hf_diffu_2d(I,j) + diffu(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_diffu_2d, hf_diffu_2d, CS%diag) - endif - - if (CS%id_hf_diffv_2d > 0) then - hf_diffv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_diffv_2d(i,J) = hf_diffv_2d(i,J) + diffv(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_diffv_2d, hf_diffv_2d, CS%diag) - endif - - if (CS%id_intz_diffu_2d > 0) then - intz_diffu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_diffu_2d(I,j) = intz_diffu_2d(I,j) + diffu(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_diffu_2d, intz_diffu_2d, CS%diag) - endif - - if (CS%id_intz_diffv_2d > 0) then - intz_diffv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_diffv_2d(i,J) = intz_diffv_2d(i,J) + diffv(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_diffv_2d, intz_diffv_2d, CS%diag) - endif - endif - - if (present(ADp) .and. (CS%id_h_diffu > 0)) then - allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_diffu, h_diffu, CS%diag) - deallocate(h_diffu) - endif - if (present(ADp) .and. (CS%id_h_diffv > 0)) then - allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_diffv, h_diffv, CS%diag) - deallocate(h_diffv) - endif - - if (present(ADp) .and. (CS%id_diffu_visc_rem > 0)) then - allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - diffu_visc_rem(I,j,k) = diffu(I,j,k) * ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_diffu_visc_rem, diffu_visc_rem, CS%diag) - deallocate(diffu_visc_rem) - endif - if (present(ADp) .and. (CS%id_diffv_visc_rem > 0)) then - allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - diffv_visc_rem(i,J,k) = diffv(i,J,k) * ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) - deallocate(diffv_visc_rem) + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_diffu > 0) call post_product_u(CS%id_hf_diffu, diffu, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_diffv > 0) call post_product_v(CS%id_hf_diffv, diffv, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged momentum budget terms + if (CS%id_hf_diffu_2d > 0) call post_product_sum_u(CS%id_hf_diffu_2d, diffu, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_diffv_2d > 0) call post_product_sum_v(CS%id_hf_diffv_2d, diffv, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for the vertical sum of layer thickness x momentum budget terms + if (CS%id_intz_diffu_2d > 0) call post_product_sum_u(CS%id_intz_diffu_2d, diffu, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_diffv_2d > 0) call post_product_sum_v(CS%id_intz_diffv_2d, diffv, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for thickness x momentum budget terms + if (CS%id_h_diffu > 0) call post_product_u(CS%id_h_diffu, diffu, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_diffv > 0) call post_product_v(CS%id_h_diffv, diffv, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + if (CS%id_diffu_visc_rem > 0) call post_product_u(CS%id_diffu_visc_rem, diffu, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_diffv_visc_rem > 0) call post_product_v(CS%id_diffv_visc_rem, diffv, ADp%visc_rem_v, G, nz, CS%diag) endif end subroutine horizontal_viscosity @@ -1749,7 +1694,7 @@ end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) +subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) type(time_type), 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 @@ -1757,10 +1702,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. - type(hor_visc_CS), pointer :: CS !< Pointer to the control structure for this module - type(MEKE_type), pointer :: MEKE !< MEKE data - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers - ! Local variables + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics + real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities @@ -1798,11 +1742,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS - logical :: get_all ! If true, read and log all parameters, regardless of - ! whether they are used, to enable spell-checking of - ! valid parameters. logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. + logical :: use_MEKE ! If true, the MEKE parameterization is in use. logical :: default_2018_answers character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians @@ -1812,35 +1754,21 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: i, j -! 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_hor_visc" ! module name is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "hor_visc_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) + + CS%initialized = .true. + CS%diag => diag ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") - ! It is not clear whether these initialization lines are needed for the - ! cases where the corresponding parameters are not read. - CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. - CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. - CS%use_QG_Leith_visc = .false. - CS%bound_Coriolis = .false. - CS%Modified_Leith = .false. - CS%anisotropic = .false. - CS%dynamic_aniso = .false. - Kh = 0.0 ; Ah = 0.0 - ! If GET_ALL_PARAMS is true, all parameters are read in all cases to enable - ! parameter spelling checks. - call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.false.) + + ! All parameters are read in all cases to enable parameter spelling checks. call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) @@ -1852,181 +1780,202 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) - if (CS%Laplacian .or. get_all) then - call get_param(param_file, mdl, "KH", Kh, & + + call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & "The velocity scale which is multiplied by the grid "//& "spacing to calculate the Laplacian viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & - units="m s-1", default=0.0, scale=US%m_s_to_L_T) - call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & + units="m s-1", default=0.0, scale=US%m_s_to_L_T, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & "The amplitude of a latitudinally-dependent background "//& "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - if (Kh_sin_lat>0. .or. get_all) & - call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & "The power used to raise SIN(LAT) when using a latitudinally "//& "dependent background viscosity.", & - units = "nondim", default=4.0) - call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & + units="nondim", default=4.0, & + do_not_log=.not.(CS%Laplacian .and. (Kh_sin_lat>0.)) ) + call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & "If true, use a Smagorinsky nonlinear eddy viscosity.", & - default=.false.) - if (CS%Smagorinsky_Kh .or. get_all) & - call get_param(param_file, mdl, "SMAG_LAP_CONST", Smag_Lap_const, & + default=.false., do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%Smagorinsky_Kh = .false. + call get_param(param_file, mdl, "SMAG_LAP_CONST", Smag_Lap_const, & "The nondimensional Laplacian Smagorinsky constant, "//& "often 0.15.", units="nondim", default=0.0, & - fail_if_missing = CS%Smagorinsky_Kh) - call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & + fail_if_missing=CS%Smagorinsky_Kh, do_not_log=.not.CS%Smagorinsky_Kh) + call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & - default=.false.) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & + default=.false., do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%Leith_Kh = .false. + ! This call duplicates one that occurs 26 lines later, and is probably unneccessary. + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & - default=.false.) - call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & + default=.false., do_not_log=.not.CS%Laplacian) !### (.not.CS%Leith_Kh)? + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & "If true, the viscosity contribution from MEKE is scaled by "//& - "the resolution function.", default=.false.) - if (CS%Leith_Kh .or. get_all) then - call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & + "the resolution function.", default=.false., & + do_not_log=.not.(CS%Laplacian.and.use_MEKE)) + if (.not.(CS%Laplacian.and.use_MEKE)) CS%res_scale_MEKE = .false. + + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, "//& "often set to 1.0", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & + fail_if_missing=CS%Leith_Kh, do_not_log=.not.CS%Leith_Kh) + call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & "If true, use QG Leith nonlinear eddy viscosity.", & - default=.false.) - if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & - "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& + default=.false., do_not_log=.not.CS%Leith_Kh) + if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & + "MOM_hor_visc.F90, hor_visc_init:"//& "LEITH_KH must be True when USE_QG_LEITH_VISC=True.") - endif - if (CS%Leith_Kh .or. CS%Leith_Ah .or. get_all) then - call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & + + !### The following two get_param_calls need to occur after Leith_Ah is read, but for now it replicates prior code. + CS%Leith_Ah = .false. + call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & "If true, include the beta term in the Leith nonlinear eddy viscosity.", & - default=CS%Leith_Kh) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & - "If true, add a term to Leith viscosity which is \n"//& + default=CS%Leith_Kh, do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & + "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & - default=.false.) - endif - call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & + default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + + call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & "If true, the Laplacian coefficient is locally limited "//& - "to be stable.", default=.true.) - call get_param(param_file, mdl, "BETTER_BOUND_KH", CS%better_bound_Kh, & + "to be stable.", default=.true., do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "BETTER_BOUND_KH", CS%better_bound_Kh, & "If true, the Laplacian coefficient is locally limited "//& "to be stable with a better bounding than just BOUND_KH.", & - default=CS%bound_Kh) - call get_param(param_file, mdl, "ANISOTROPIC_VISCOSITY", CS%anisotropic, & + default=CS%bound_Kh, do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%bound_Kh = .false. + if (.not.CS%Laplacian) CS%better_bound_Kh = .false. + call get_param(param_file, mdl, "ANISOTROPIC_VISCOSITY", CS%anisotropic, & "If true, allow anistropic viscosity in the Laplacian "//& - "horizontal viscosity.", default=.false.) - call get_param(param_file, mdl, "ADD_LES_VISCOSITY", CS%add_LES_viscosity, & + "horizontal viscosity.", default=.false., & + do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%anisotropic = .false. ! This replicates the prior code, but is it intended? + call get_param(param_file, mdl, "ADD_LES_VISCOSITY", CS%add_LES_viscosity, & "If true, adds the viscosity from Smagorinsky and Leith to the "//& - "background viscosity instead of taking the maximum.", default=.false.) - endif - if (CS%anisotropic .or. get_all) then - call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & + "background viscosity instead of taking the maximum.", default=.false., & + do_not_log=.not.CS%Laplacian) + + call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & "The background Laplacian anisotropic horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%anisotropic) + call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & "Selects the mode for setting the direction of anistropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& "\t 1 - Points towards East.\n"//& "\t 2 - Points along the flow direction, U/|U|.", & - default=0) - select case (aniso_mode) - case (0) - call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for "//& - "horizont viscosity. n1,n2 are the i,j components relative "//& - "to the grid.", units = "nondim", fail_if_missing=.true.) - case (1) - call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for "//& - "horizont viscosity. n1,n2 are the i,j components relative "//& - "to the spherical coordinates.", units = "nondim", fail_if_missing=.true.) - end select + default=0, do_not_log=.not.CS%anisotropic) + if (aniso_mode == 0) then + call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & + "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "n1,n2 are the i,j components relative to the grid.", & + units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) + elseif (aniso_mode == 1) then + call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & + "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "n1,n2 are the i,j components relative to the spherical coordinates.", & + units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) + else + call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & + "The vector pointing in the direction of anistropy for horizontal viscosity.", & + units="nondim", fail_if_missing=.false., do_not_log=.true.) endif + call get_param(param_file, mdl, "BIHARMONIC", CS%biharmonic, & "If true, use a biharmonic horizontal viscosity. "//& "BIHARMONIC may be used with LAPLACIAN.", & default=.true.) - if (CS%biharmonic .or. get_all) then - call get_param(param_file, mdl, "AH", Ah, & + call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & - units = "m4 s-1", default=0.0, scale=US%m_to_L**4*US%T_to_s) - call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & + units="m4 s-1", default=0.0, scale=US%m_to_L**4*US%T_to_s, & + do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & "The velocity scale which is multiplied by the cube of "//& "the grid spacing to calculate the biharmonic viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.0, scale=US%m_s_to_L_T) - call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & + units="m s-1", default=0.0, scale=US%m_s_to_L_T, do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & "A time scale whose inverse is multiplied by the fourth "//& "power of the grid spacing to calculate biharmonic viscosity. "//& "The final viscosity is the largest of all viscosity "//& "formulations in use. 0.0 means that it's not used.", & - units="s", default=0.0, scale=US%s_to_T) - call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & + units="s", default=0.0, scale=US%s_to_T, do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy "//& - "viscosity.", default=.false.) - call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & + "viscosity.", default=.false., do_not_log=.not.CS%biharmonic) + if (.not.CS%biharmonic) CS%Smagorinsky_Ah = .false. + call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & "If true, use a biharmonic Leith nonlinear eddy "//& - "viscosity.", default=.false.) - call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & + "viscosity.", default=.false., do_not_log=.not.CS%biharmonic) + if (.not.CS%biharmonic) CS%Leith_Ah = .false. + call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& - "to be stable.", default=.true.) - call get_param(param_file, mdl, "BETTER_BOUND_AH", CS%better_bound_Ah, & + "to be stable.", default=.true., do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "BETTER_BOUND_AH", CS%better_bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& "to be stable with a better bounding than just BOUND_AH.", & - default=CS%bound_Ah) - call get_param(param_file, mdl, "RE_AH", CS%Re_Ah, & + default=CS%bound_Ah, do_not_log=.not.CS%biharmonic) + if (.not.CS%biharmonic) CS%bound_Ah = .false. + if (.not.CS%biharmonic) CS%better_bound_Ah = .false. + call get_param(param_file, mdl, "RE_AH", CS%Re_Ah, & "If nonzero, the biharmonic coefficient is scaled "//& "so that the biharmonic Reynolds number is equal to this.", & - units="nondim", default=0.0) + units="nondim", default=0.0, do_not_log=.not.CS%biharmonic) - if (CS%Smagorinsky_Ah .or. get_all) then - call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & + call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & "The nondimensional biharmonic Smagorinsky constant, "//& "typically 0.015 - 0.06.", units="nondim", default=0.0, & - fail_if_missing = CS%Smagorinsky_Ah) - call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) - call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & + fail_if_missing=CS%Smagorinsky_Ah, do_not_log=.not.CS%Smagorinsky_Ah) + + call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) + call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & "If true use a viscosity that increases with the square "//& "of the velocity shears, so that the resulting viscous "//& "drag is of comparable magnitude to the Coriolis terms "//& "when the velocity differences between adjacent grid "//& "points is 0.5*BOUND_CORIOLIS_VEL. The default is the "//& - "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def) - if (CS%bound_Coriolis .or. get_all) then - call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) - bound_Cor_vel = maxvel - call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & + "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def, & + do_not_log=.not.CS%Smagorinsky_Ah) + if (.not.CS%Smagorinsky_Ah) CS%bound_Coriolis = .false. + call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) + call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & "The velocity scale at which BOUND_CORIOLIS_BIHARM causes "//& "the biharmonic drag to have comparable magnitude to the "//& "Coriolis acceleration. The default is set by MAXVEL.", & - units="m s-1", default=maxvel, scale=US%m_s_to_L_T) - endif - endif - if (CS%Leith_Ah .or. get_all) & - call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & + units="m s-1", default=maxvel, scale=US%m_s_to_L_T, & + do_not_log=.not.(CS%Smagorinsky_Ah .and. CS%bound_Coriolis)) + + call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & "The nondimensional biharmonic Leith constant, "//& "typical values are thus far undetermined.", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Ah) - endif + fail_if_missing=CS%Leith_Ah, do_not_log=.not.CS%Leith_Ah) + call get_param(param_file, mdl, "USE_LAND_MASK_FOR_HVISC", CS%use_land_mask, & - "If true, use Use the land mask for the computation of thicknesses "//& + "If true, use the land mask for the computation of thicknesses "//& "at velocity locations. This eliminates the dependence on arbitrary "//& "values over land or outside of the domain.", default=.true.) - if (CS%better_bound_Ah .or. CS%better_bound_Kh .or. get_all) & - call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & + call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & "The nondimensional coefficient of the ratio of the "//& "viscosity bounds to the theoretical maximum for "//& "stability without considering other terms.", units="nondim", & - default=0.8) + default=0.8, do_not_log=.not.(CS%better_bound_Ah .or. CS%better_bound_Kh)) call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & "If true, no slip boundary conditions are used; otherwise "//& "free slip boundary conditions are assumed. The "//& @@ -2037,34 +1986,31 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call get_param(param_file, mdl, "USE_KH_BG_2D", CS%use_Kh_bg_2d, & "If true, read a file containing 2-d background harmonic "//& "viscosities. The final viscosity is the maximum of the other "//& - "terms and this background value.", default=.false.) - if (CS%use_Kh_bg_2d) then - call get_param(param_file, mdl, "KH_BG_2D_BUG", CS%Kh_bg_2d_bug, & + "terms and this background value.", default=.false.) ! ###do_not_log=.not.CS%Laplacian? + call get_param(param_file, mdl, "KH_BG_2D_BUG", CS%Kh_bg_2d_bug, & "If true, retain an answer-changing horizontal indexing bug in setting "//& "the corner-point viscosities when USE_KH_BG_2D=True. This is"//& - "not recommended.", default=.false.) - endif + "not recommended.", default=.false., do_not_log=.not.CS%use_Kh_bg_2d) call get_param(param_file, mdl, "USE_GME", CS%use_GME, & "If true, use the GM+E backscatter scheme in association \n"//& "with the Gent and McWilliams parameterization.", default=.false.) - if (CS%use_GME) then - call get_param(param_file, mdl, "SPLIT", split, & - "Use the split time stepping if true.", default=.true., & - do_not_log=.true.) - if (.not. split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & + call get_param(param_file, mdl, "SPLIT", split, & + "Use the split time stepping if true.", default=.true., do_not_log=.true.) + if (CS%use_GME .and. .not.split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & "cannot be used with SPLIT=False.") - call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & + call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & "The strength of GME tapers quadratically to zero when the bathymetric "//& - "depth is shallower than GME_H0.", units="m", scale=US%m_to_Z, & - default=1000.0) - call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & + "depth is shallower than GME_H0.", & + units="m", scale=US%m_to_Z, default=1000.0, do_not_log=.not.CS%use_GME) + call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & "The nondimensional prefactor multiplying the GME coefficient.", & - units="nondim", default=1.0) - call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & + units="nondim", default=1.0, do_not_log=.not.CS%use_GME) + call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & "The absolute maximum value the GME coefficient is allowed to take.", & - units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7) - endif + units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7, & + do_not_log=.not.CS%use_GME) + if (CS%Laplacian .or. CS%biharmonic) then call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, & @@ -2109,6 +2055,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) endif ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0 ALLOC_(CS%reduction_xy(IsdB:IedB,JsdB:JedB)) ; CS%reduction_xy(:,:) = 0.0 + + CS%dynamic_aniso = .false. if (CS%anisotropic) then ALLOC_(CS%n1n2_h(isd:ied,jsd:jed)) ; CS%n1n2_h(:,:) = 0.0 ALLOC_(CS%n1n1_m_n2n2_h(isd:ied,jsd:jed)) ; CS%n1n1_m_n2n2_h(:,:) = 0.0 @@ -2126,13 +2074,14 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) "Runtime parameter ANISOTROPIC_MODE is out of range.") end select endif - if (CS%use_Kh_bg_2d) then - ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 - call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & + + call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & 'The filename containing a 2d map of "Kh".', & - default='KH_background_2d.nc') + default='KH_background_2d.nc', do_not_log=.not.CS%use_Kh_bg_2d) + if (CS%use_Kh_bg_2d) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) + ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) @@ -2434,7 +2383,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! 'Fractional Thickness-weighted Zonal Acceleration from Horizontal Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if ((CS%id_hf_diffu > 0) .and. (present(ADp))) then - ! call safe_alloc_ptr(CS%hf_diffu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) + ! call safe_alloc_alloc(CS%hf_diffu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) ! call safe_alloc_ptr(ADp%diag_hfrac_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) !endif @@ -2442,7 +2391,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! 'Fractional Thickness-weighted Meridional Acceleration from Horizontal Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if ((CS%id_hf_diffv > 0) .and. (present(ADp))) then - ! call safe_alloc_ptr(CS%hf_diffv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) + ! call safe_alloc_alloc(CS%hf_diffv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) ! call safe_alloc_ptr(ADp%diag_hfrac_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) !endif @@ -2461,15 +2410,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) endif CS%id_h_diffu = register_diag_field('ocean_model', 'h_diffu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if ((CS%id_h_diffu > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%diag_hu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_h_diffv = register_diag_field('ocean_model', 'h_diffv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if ((CS%id_h_diffv > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%diag_hv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif @@ -2489,15 +2438,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) endif CS%id_diffu_visc_rem = register_diag_field('ocean_model', 'diffu_visc_rem', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_diffu_visc_rem > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%visc_rem_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_diffv_visc_rem = register_diag_field('ocean_model', 'diffv_visc_rem', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_diffv_visc_rem > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%visc_rem_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif @@ -2560,14 +2509,13 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) 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') - if (CS%Laplacian .or. get_all) then - endif + end subroutine hor_visc_init !> Calculates factors in the anisotropic orientation tensor to be align with the grid. !! With n1=1 and n2=0, this recovers the approach of Large et al, 2001. subroutine align_aniso_tensor_to_grid(CS, n1, n2) - type(hor_visc_CS), pointer :: CS !< Control structure for horizontal viscosity + type(hor_visc_CS), intent(inout) :: CS !< Control structure for horizontal viscosity real, intent(in) :: n1 !< i-component of direction vector [nondim] real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables @@ -2583,9 +2531,7 @@ end subroutine align_aniso_tensor_to_grid !> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any !! horizontal two-grid-point noise -subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) - ! Arguments - type(hor_visc_CS), pointer :: CS !< Control structure +subroutine smooth_GME(G, GME_flux_h, GME_flux_q) type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< GME diffusive flux !! at h points @@ -2599,8 +2545,9 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) do s=1,1 ! Update halos if (present(GME_flux_h)) then + !### Work on a wider halo to eliminate this blocking send! call pass_var(GME_flux_h, G%Domain) - GME_flux_h_original = GME_flux_h + GME_flux_h_original(:,:) = GME_flux_h(:,:) ! apply smoothing on GME do j = G%jsc, G%jec do i = G%isc, G%iec @@ -2612,6 +2559,7 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) ws = 0.125 * G%mask2dT(i,j-1) wn = 0.125 * G%mask2dT(i,j+1) wc = 1.0 - (ww+we+wn+ws) + !### Add parentheses to make this rotationally invariant. GME_flux_h(i,j) = wc * GME_flux_h_original(i,j) & + ww * GME_flux_h_original(i-1,j) & + we * GME_flux_h_original(i+1,j) & @@ -2622,8 +2570,9 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) endif ! Update halos if (present(GME_flux_q)) then + !### Work on a wider halo to eliminate this blocking send! call pass_var(GME_flux_q, G%Domain, position=CORNER, complete=.true.) - GME_flux_q_original = GME_flux_q + GME_flux_q_original(:,:) = GME_flux_q(:,:) ! apply smoothing on GME do J = G%JscB, G%JecB do I = G%IscB, G%IecB @@ -2635,6 +2584,7 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) ws = 0.125 * G%mask2dBu(I,J-1) wn = 0.125 * G%mask2dBu(I,J+1) wc = 1.0 - (ww+we+wn+ws) + !### Add parentheses to make this rotationally invariant. GME_flux_q(I,J) = wc * GME_flux_q_original(I,J) & + ww * GME_flux_q_original(I-1,J) & + we * GME_flux_q_original(I+1,J) & @@ -2648,8 +2598,7 @@ end subroutine smooth_GME !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) - type(hor_visc_CS), pointer :: CS !< The control structure returned by a - !! previous call to hor_visc_init. + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct if (CS%Laplacian .or. CS%biharmonic) then DEALLOC_(CS%dx2h) ; DEALLOC_(CS%dx2q) ; DEALLOC_(CS%dy2h) ; DEALLOC_(CS%dy2q) DEALLOC_(CS%dx_dyT) ; DEALLOC_(CS%dy_dxT) ; DEALLOC_(CS%dx_dyBu) ; DEALLOC_(CS%dy_dxBu) @@ -2692,7 +2641,6 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%n1n1_m_n2n2_h) DEALLOC_(CS%n1n1_m_n2n2_q) endif - deallocate(CS) end subroutine hor_visc_end !> \namespace mom_hor_visc !! @@ -2778,7 +2726,7 @@ end subroutine hor_visc_end !! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) !! & = & !! \partial_x \left( \frac{1}{2} \sigma_S \right) -!! + \partial_y \left( \frac{1}{2} \sigma_T \right) +!! + \partial_y \left( - \frac{1}{2} \sigma_T \right) !! \\\\ !! & = & !! \partial_x \left( \kappa_h \dot{e}_S \right) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 54370611ad..dfbb3e0d63 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -107,17 +107,16 @@ module MOM_internal_tides !< If true, apply scattering due to small-scale roughness as a sink. logical :: apply_Froude_drag !< If true, apply wave breaking as a sink. - real, dimension(:,:,:,:,:), pointer :: En => NULL() + real, allocatable :: En(:,:,:,:,:) !< 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() + real, allocatable :: En_restart(:,:,:) !< 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]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(wave_structure_CS), pointer :: wave_structure_CSp => NULL() - !< A pointer to the wave_structure module control structure + type(wave_structure_CS) :: wave_struct !< Wave structure control struct !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles @@ -169,8 +168,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Length of time over which to advance !! the internal tides [T ~> s]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct real, dimension(SZI_(G),SZJ_(G),CS%nMode), & intent(in) :: cn !< The internal wave speeds of each !! mode [L T-1 ~> m s-1]. @@ -210,7 +208,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(time_type) :: time_end logical:: avg_enabled - if (.not.associated(CS)) return 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 @@ -406,13 +403,13 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do m=1,CS%NMode ; do fr=1,CS%Nfreq ! Calculate modal structure for given mode and frequency call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, CS%frequency(fr), & - CS%wave_structure_CSp, tot_En_mode(:,:,fr,m), full_halos=.true.) + CS%wave_struct, tot_En_mode(:,:,fr,m), full_halos=.true.) ! Pick out near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging - nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + nzm = CS%wave_struct%num_intfaces(i,j) + Ub(i,j,fr,m) = CS%wave_struct%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = maxval(CS%wave_struct%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) @@ -450,7 +447,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) - nzm = CS%wave_structure_CSp%num_intfaces(i,j) + nzm = CS%wave_struct%num_intfaces(i,j) Fr2_max = (Umax(i,j,fr,m) / c_phase)**2 ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then @@ -611,8 +608,7 @@ end subroutine propagate_int_tide !> Checks for energy conservation on computational domain subroutine sum_En(G, CS, En, label) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), & intent(in) :: En !< The energy density of the internal tides [R Z3 T-2 ~> J m-2]. character(len=*), intent(in) :: label !< A label to use in error messages @@ -654,8 +650,7 @@ end subroutine sum_En subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & @@ -747,8 +742,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) integer, intent(in) :: i !< The i-index of the value to be reported. integer, intent(in) :: j !< The j-index of the value to be reported. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified !! mechanism [R Z3 T-3 ~> W m-2]. @@ -1011,8 +1005,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1137,8 +1131,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, intent(in) :: dt !< Time increment [T ~> s]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a previous - !! call to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables integer :: i, j, k, ish, ieh, jsh, jeh, m @@ -1405,19 +1398,18 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call - !! to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct 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 [R Z3 T-2 ~> J m-2]. real, dimension(SZIB_(G),SZJ_(G)) :: & - flux_x ! The internal wave energy flux [J T-1 ~> J s-1]. + flux_x ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(SZIB_(G)) :: & cg_p, cg_m, flux1, flux2 !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & - Fdt_m, Fdt_p! Left and right energy fluxes [J] + Fdt_m, Fdt_p! Left and right energy fluxes [R Z3 L2 T-2 ~> J] integer :: i, j, k, ish, ieh, jsh, jeh, a ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh @@ -1442,8 +1434,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx (J) - Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx (J) + Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx [R Z3 L2 T-2 ~> J] + Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] enddo ; enddo enddo ! a-loop @@ -1451,9 +1443,9 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected ! and will eventually propagate out of cell. (This code only reflects if En > 0.) call reflect(Fdt_m, Nangle, CS, G, LB) - call teleport(Fdt_m, Nangle, CS, G, LB) + !call teleport(Fdt_m, Nangle, CS, G, LB) call reflect(Fdt_p, Nangle, CS, G, LB) - call teleport(Fdt_p, Nangle, CS, G, LB) + !call teleport(Fdt_p, Nangle, CS, G, LB) ! Update reflected energy [R Z3 T-2 ~> J m-2] do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh @@ -1480,19 +1472,18 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call - !! to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct 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 [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & - flux_y ! The internal wave energy flux [J T-1 ~> J s-1]. + flux_y ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(SZI_(G)) :: & cg_p, cg_m, flux1, flux2 !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & - Fdt_m, Fdt_p! South and north energy fluxes [J] + Fdt_m, Fdt_p! South and north energy fluxes [R Z3 L2 T-2 ~> J] character(len=160) :: mesg ! The text of an error message integer :: i, j, k, ish, ieh, jsh, jeh, a @@ -1518,8 +1509,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) + Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx [R Z3 L2 T-2 ~> J] + Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> 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), & @@ -1533,9 +1524,9 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected ! and will eventually propagate out of cell. (This code only reflects if En > 0.) call reflect(Fdt_m, Nangle, CS, G, LB) - call teleport(Fdt_m, Nangle, CS, G, LB) + !call teleport(Fdt_m, Nangle, CS, G, LB) call reflect(Fdt_p, Nangle, CS, G, LB) - call teleport(Fdt_p, Nangle, CS, G, LB) + !call teleport(Fdt_p, Nangle, CS, G, LB) ! Update reflected energy [R Z3 T-2 ~> J m-2] do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh @@ -1641,8 +1632,7 @@ subroutine reflect(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c @@ -1706,13 +1696,13 @@ subroutine reflect(En, NAngle, CS, G, LB) if (ridge(i,j)) then ! if ray is not incident but in ridge cell, use complementary angle - if ((Nangle_d2 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle)) then + if ((Nangle_d2 < angle_to_wall) .and. (angle_to_wall < Nangle)) then angle_wall0 = mod(angle_wall0 + Nangle_d2 + Nangle, Nangle) endif endif ! do reflection - if ((0 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle_d2)) then + if ((0 < angle_to_wall) .and. (angle_to_wall < Nangle_d2)) then angle_r0 = mod(2*angle_wall0 - a0 + Nangle, Nangle) angle_r = angle_r0 + 1 !re-index to 1 -> Nangle if (a /= angle_r) then @@ -1748,8 +1738,7 @@ subroutine teleport(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c @@ -1905,7 +1894,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. - logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean + logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables @@ -1913,15 +1902,14 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) real, parameter :: oneSixth = 1./6. real :: h_ip1, h_im1 real :: dMx, dMn - logical :: use_CW84, use_2nd + logical :: use_CW84 character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil - use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd isl = LB%ish-1 ; iel = LB%ieh+1 ; jsl = LB%jsh ; jel = LB%jeh ! This is the stencil of the reconstruction, not the scheme overall. - stencil = 2 ; if (use_2nd) stencil = 1 + stencil = 2 ; if (simple_2nd) stencil = 1 if ((isl-stencil < G%isd) .or. (iel+stencil > G%ied)) then write(mesg,'("In MOM_internal_tides, PPM_reconstruction_x called with a ", & @@ -1936,7 +1924,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) call MOM_error(FATAL,mesg) endif - if (use_2nd) then + if (simple_2nd) then do j=jsl,jel ; do i=isl,iel h_im1 = G%mask2dT(i-1,j) * h_in(i-1,j) + (1.0-G%mask2dT(i-1,j)) * h_in(i,j) h_ip1 = G%mask2dT(i+1,j) * h_in(i+1,j) + (1.0-G%mask2dT(i+1,j)) * h_in(i,j) @@ -1981,7 +1969,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. - logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean + logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables @@ -1989,15 +1977,13 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) real, parameter :: oneSixth = 1./6. real :: h_jp1, h_jm1 real :: dMx, dMn - logical :: use_2nd character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil - use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd isl = LB%ish ; iel = LB%ieh ; jsl = LB%jsh-1 ; jel = LB%jeh+1 ! This is the stencil of the reconstruction, not the scheme overall. - stencil = 2 ; if (use_2nd) stencil = 1 + stencil = 2 ; if (simple_2nd) stencil = 1 if ((isl < G%isd) .or. (iel > G%ied)) then write(mesg,'("In MOM_internal_tides, PPM_reconstruction_y called with a ", & @@ -2012,7 +1998,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) call MOM_error(FATAL,mesg) endif - if (use_2nd) then + if (simple_2nd) then do j=jsl,jel ; do i=isl,iel h_jm1 = G%mask2dT(i,j-1) * h_in(i,j-1) + (1.0-G%mask2dT(i,j-1)) * h_in(i,j) h_jp1 = G%mask2dT(i,j+1) * h_in(i,j+1) + (1.0-G%mask2dT(i,j+1)) * h_in(i,j) @@ -2092,9 +2078,8 @@ end subroutine PPM_limit_pos ! subroutine register_int_tide_restarts(G, param_file, CS, restart_CS) ! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! type(int_tide_CS), pointer :: CS !< The control structure returned by a -! !! previous call to int_tide_init. -! type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. +! type(int_tide_CS), intent(in) :: CS !< Internal tide control struct +! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! ! This subroutine is not currently in use!! @@ -2140,8 +2125,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(int_tide_CS),pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + ! Local variables real :: Angle_size ! size of wedges, rad real, allocatable :: angles(:) ! orientations of wedge centers, rad @@ -2171,14 +2156,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "internal_tides_init called "//& - "with an associated control structure.") - return - else - allocate(CS) - endif - use_int_tides = .false. call read_param(param_file, "INTERNAL_TIDES", use_int_tides) CS%do_int_tides = use_int_tides @@ -2580,24 +2557,19 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo ! Initialize wave_structure (not sure if this should be here - BDM) - call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_structure_CSp) + call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_struct) end subroutine internal_tides_init !> This subroutine deallocates the memory associated with the internal tides control structure subroutine internal_tides_end(CS) - type(int_tide_CS), pointer :: CS !< A pointer to the control structure returned by a previous - !! call to internal_tides_init, it will be deallocated here. - - if (associated(CS)) then - if (associated(CS%En)) deallocate(CS%En) - if (allocated(CS%frequency)) deallocate(CS%frequency) - if (allocated(CS%id_En_mode)) deallocate(CS%id_En_mode) - if (allocated(CS%id_Ub_mode)) deallocate(CS%id_Ub_mode) - if (allocated(CS%id_cp_mode)) deallocate(CS%id_cp_mode) - deallocate(CS) - endif - CS => NULL() + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + + if (allocated(CS%En)) deallocate(CS%En) + if (allocated(CS%frequency)) deallocate(CS%frequency) + if (allocated(CS%id_En_mode)) deallocate(CS%id_En_mode) + if (allocated(CS%id_Ub_mode)) deallocate(CS%id_Ub_mode) + if (allocated(CS%id_cp_mode)) deallocate(CS%id_cp_mode) end subroutine internal_tides_end end module MOM_internal_tides diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2d1f7103e6..da8e936642 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -25,7 +25,11 @@ module MOM_lateral_mixing_coeffs !> Variable mixing coefficients type, public :: VarMix_CS + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: use_variable_mixing !< If true, use the variable mixing. + logical :: Resoln_scaling_used !< If true, a resolution function is used somewhere to scale + !! away one of the viscosities or diffusivities when the + !! deformation radius is well resolved. logical :: Resoln_scaled_Kh !< If true, scale away the Laplacian viscosity !! when the deformation radius is well resolved. logical :: Resoln_scaled_KhTh !< If true, scale away the thickness diffusivity @@ -60,46 +64,46 @@ module MOM_lateral_mixing_coeffs !! This parameter is set depending on other parameters. real :: cropping_distance !< Distance from surface or bottom to filter out outcropped or !! incropped interfaces for the Eady growth rate calc [Z ~> m] - real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [T-1 ~> s-1] - SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] - L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] - L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. - Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at h points [nondim]. - Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at q points [nondim]. - Res_fn_u => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at u points [nondim]. - Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at v points [nondim]. - Depth_fn_u => NULL(), & !< Non-dimensional function of the ratio of the depth to - !! a reference depth (maximum 1) at u points [nondim] - Depth_fn_v => NULL(), & !< Non-dimensional function of the ratio of the depth to - !! a reference depth (maximum 1) at v points [nondim] - beta_dx2_h => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at h points [L T-1 ~> m s-1]. - beta_dx2_q => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at q points [L T-1 ~> m s-1]. - beta_dx2_u => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at u points [L T-1 ~> m s-1]. - beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at v points [L T-1 ~> m s-1]. - f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [L2 T-2 ~> m2 s-2]. - f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [L2 T-2 ~> m2 s-2]. - f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [L2 T-2 ~> m2 s-2]. - f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [L2 T-2 ~> m2 s-2]. - Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] - - real, dimension(:,:,:), pointer :: & - slope_x => NULL(), & !< Zonal isopycnal slope [nondim] - slope_y => NULL(), & !< Meridional isopycnal slope [nondim] - ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] + + real, allocatable :: SN_u(:,:) !< S*N at u-points [T-1 ~> s-1] + real, allocatable :: SN_v(:,:) !< S*N at v-points [T-1 ~> s-1] + real, allocatable :: L2u(:,:) !< Length scale^2 at u-points [L2 ~> m2] + real, allocatable :: L2v(:,:) !< Length scale^2 at v-points [L2 ~> m2] + real, allocatable :: cg1(:,:) !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. + real, allocatable :: Res_fn_h(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at h points [nondim]. + real, allocatable :: Res_fn_q(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at q points [nondim]. + real, allocatable :: Res_fn_u(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at u points [nondim]. + real, allocatable :: Res_fn_v(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at v points [nondim]. + real, allocatable :: Depth_fn_u(:,:) !< Non-dimensional function of the ratio of the depth to + !! a reference depth (maximum 1) at u points [nondim] + real, allocatable :: Depth_fn_v(:,:) !< Non-dimensional function of the ratio of the depth to + !! a reference depth (maximum 1) at v points [nondim] + real, allocatable :: beta_dx2_h(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at h points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_q(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at q points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_u(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at u points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_v(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at v points [L T-1 ~> m s-1]. + real, allocatable :: f2_dx2_h(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at h [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_q(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at q [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_u(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at u [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_v(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at v [L2 T-2 ~> m2 s-2]. + real, allocatable :: Rd_dx_h(:,:) !< Deformation radius over grid spacing [nondim] + + real, allocatable :: slope_x(:,:,:) !< Zonal isopycnal slope [nondim] + real, allocatable :: slope_y(:,:,:) !< Meridional isopycnal slope [nondim] + real, allocatable :: ebt_struct(:,:,:) !< Vertical structure function to scale diffusivities with [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] @@ -149,7 +153,7 @@ module MOM_lateral_mixing_coeffs !! timing of diagnostic output. !>@} - type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() !< Wave speed control structure + type(wave_speed_CS) :: wave_speed !< Wave speed control structure type(group_pass_type) :: pass_cg1 !< For group halo pass logical :: debug !< If true, write out checksums of data for debugging end type VarMix_CS @@ -161,8 +165,8 @@ module MOM_lateral_mixing_coeffs !> Calculates the non-dimensional depth functions. subroutine calc_depth_function(G, CS) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct ! Local variables integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -172,12 +176,13 @@ subroutine calc_depth_function(G, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not. associated(CS)) call MOM_error(FATAL, "calc_depth_function:"// & + if (.not. CS%initialized) call MOM_error(FATAL, "calc_depth_function: "// & "Module must be initialized before it is used.") + if (.not. CS%calculate_depth_fns) return - if (.not. associated(CS%Depth_fn_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%Depth_fn_u)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_u is not associated with Depth_scaled_KhTh.") - if (.not. associated(CS%Depth_fn_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%Depth_fn_v)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_v is not associated with Depth_scaled_KhTh.") H0 = CS%depth_scaled_khth_h0 @@ -200,7 +205,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some @@ -215,26 +220,27 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not. associated(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & + if (.not. CS%initialized) call MOM_error(FATAL, "calc_resoln_function: "// & "Module must be initialized before it is used.") + if (CS%calculate_cg1) then - if (.not. associated(CS%cg1)) call MOM_error(FATAL, & + if (.not. allocated(CS%cg1)) call MOM_error(FATAL, & "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") if (CS%khth_use_ebt_struct) then - if (.not. associated(CS%ebt_struct)) call MOM_error(FATAL, & + if (.not. allocated(CS%ebt_struct)) call MOM_error(FATAL, & "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then ! Both resolution fn and vertical structure are using EBT - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, modal_structure=CS%ebt_struct) else ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, modal_structure=CS%ebt_struct, & use_ebt_mode=.true.) - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) endif call pass_var(CS%ebt_struct, G%Domain) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) endif call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) @@ -244,7 +250,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) ! Calculate and store the ratio between deformation radius and grid-spacing ! at h-points [nondim]. if (CS%calculate_rd_dx) then - if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -258,29 +264,29 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (.not. CS%calculate_res_fns) return - if (.not. associated(CS%Res_fn_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_h)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_q)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_u)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_v)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_v is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_v is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_v is not associated with Resoln_scaled_Kh.") ! Do this calculation on the extent used in MOM_hor_visc.F90, and @@ -447,8 +453,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment [T ~> s] - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. @@ -459,7 +465,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: dzSxN ! |Sx| N times dz at u-points [Z T-1 ~> m s-1] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: dzSyN ! |Sy| N times dz at v-points [Z T-1 ~> m s-1] - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions: "//& "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then @@ -474,10 +480,10 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC=OBC) + call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true., OBC=OBC) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true., OBC) endif endif endif @@ -511,8 +517,8 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real :: S2 ! Interface slope squared [nondim] @@ -528,22 +534,23 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C real :: S2_v(SZI_(G), SZJB_(G)) logical :: local_open_u_BC, local_open_v_BC - if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. CS%initialized) call MOM_error(FATAL, "calc_Visbeck_coeffs_old: "// & "Module must be initialized before it is used.") + if (.not. CS%calculate_Eady_growth_rate) return - if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke local_open_u_BC = .false. local_open_v_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_u_BC = OBC%open_u_BCs_exist_globally local_open_v_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif S2max = CS%Visbeck_S_max**2 @@ -666,12 +673,12 @@ end subroutine calc_Visbeck_coeffs_old !> Calculates the Eady growth rate (2D fields) for use in MEKE and the Visbeck schemes subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, SN_u, SN_v) - type(VarMix_CS), intent(in) :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), pointer, intent(in) :: OBC !< Open boundaries control structure. -real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface height [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzu !< dz at u-points [Z ~> m] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: dzv !< dz at v-points [Z ~> m] @@ -688,7 +695,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d real :: vint_SN(SZIB_(G)) ! Cumulative integral of SN [Z T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G)) :: SN_cpy !< SN at u-points [T-1 ~> s-1] real :: dz_neglect ! An incy wincy distance to avoid division by zero [Z ~> m] - real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~. m-1] + real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~> m-1] real :: dB, dT ! Elevation variables used when cropping [Z ~> m] integer :: i, j, k, l_seg logical :: local_open_u_BC, local_open_v_BC, crop @@ -852,11 +859,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes !! internally otherwise use slopes stored in CS - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) @@ -875,22 +882,23 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) logical :: local_open_u_BC, local_open_v_BC - if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. CS%initialized) call MOM_error(FATAL, "calc_slope_functions_using_just_e: "// & "Module must be initialized before it is used.") + if (.not. CS%calculate_Eady_growth_rate) return - if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke local_open_u_BC = .false. local_open_v_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_u_BC = OBC%open_u_BCs_exist_globally local_open_v_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff @@ -1011,7 +1019,7 @@ end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1146,7 +1154,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when @@ -1162,6 +1170,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] real :: wave_speed_min ! A floor in the first mode speed below which 0 is returned [L T-1 ~> m s-1] real :: wave_speed_tol ! The fractional tolerance for finding the wave speeds [nondim] + logical :: Resoln_scaled_MEKE_visc ! If true, the viscosity contribution from MEKE is + ! scaled by the resolution function. logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. ! This include declares and sets the variable "version". @@ -1174,13 +1184,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "VarMix_init called with an associated "// & - "control structure.") - return - endif - - allocate(CS) + CS%initialized = .true. in_use = .false. ! Set to true to avoid deallocating CS%diag => diag ! Diagnostics pointer CS%calculate_cg1 = .false. @@ -1217,6 +1221,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, the epipycnal tracer diffusivity is scaled "//& "away when the first baroclinic deformation radius is "//& "well resolved.", default=.false.) + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", Resoln_scaled_MEKE_visc, & + "If true, the viscosity contribution from MEKE is scaled by "//& + "the resolution function.", default=.false., do_not_log=.true.) ! Logged elsewhere. + if (.not.use_MEKE) Resoln_scaled_MEKE_visc = .false. call get_param(param_file, mdl, "RESOLN_USE_EBT", CS%Resoln_use_ebt, & "If true, uses the equivalent barotropic wave speed instead "//& "of first baroclinic wave for calculating the resolution fn.",& @@ -1245,13 +1255,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn - call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & - default=.false., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE ! Indicate whether to calculate the Eady growth rate - CS%calculate_Eady_growth_rate = use_MEKE & - .or. (KhTr_Slope_Cff>0.) & - .or. (KhTh_Slope_Cff>0.) + CS%calculate_Eady_growth_rate = use_MEKE .or. (KhTr_Slope_Cff>0.) .or. (KhTh_Slope_Cff>0.) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (KhTr_passivity_coeff>0.) @@ -1383,7 +1389,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif oneOrTwo = 1.0 - if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then + CS%Resoln_scaling_used = CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. & + CS%Resoln_scaled_KhTr .or. Resoln_scaled_MEKE_visc + if (CS%Resoln_scaling_used) then CS%calculate_Rd_dx = .true. CS%calculate_res_fns = .true. allocate(CS%Res_fn_h(isd:ied,jsd:jed), source=0.0) @@ -1535,8 +1543,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& - "starting point for iterations.", default=.false.) !### Change the default. - call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, & + "starting point for iterations.", default=.true.) + call wave_speed_init(CS%wave_speed, use_ebt_mode=CS%Resoln_use_ebt, & mono_N2_depth=N2_filter_depth, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) @@ -1585,14 +1593,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "USE_STORED_SLOPES must be True when using QG Leith.") endif - ! If nothing is being stored in this class then deallocate - if (in_use) then - CS%use_variable_mixing = .true. - else - deallocate(CS) - return - endif - + ! Re-enable variable mixing if one of the schemes was enabled + CS%use_variable_mixing = in_use .or. CS%use_variable_mixing end subroutine VarMix_init !> Destructor for VarMix control structure @@ -1612,10 +1614,10 @@ subroutine VarMix_end(CS) deallocate(CS%SN_v) endif - if (associated(CS%L2u)) deallocate(CS%L2u) - if (associated(CS%L2v)) deallocate(CS%L2v) + if (allocated(CS%L2u)) deallocate(CS%L2u) + if (allocated(CS%L2v)) deallocate(CS%L2v) - if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then + if (CS%Resoln_scaling_used) then deallocate(CS%Res_fn_h) deallocate(CS%Res_fn_q) deallocate(CS%Res_fn_u) @@ -1649,9 +1651,6 @@ subroutine VarMix_end(CS) DEALLOC_(CS%KH_u_QG) DEALLOC_(CS%KH_v_QG) endif - - if (CS%calculate_cg1) deallocate(CS%wave_speed_CSp) - end subroutine VarMix_end !> \namespace mom_lateral_mixing_coeffs diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0d2062441e..04982d7171 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -36,6 +36,7 @@ module MOM_mixed_layer_restrat !> Control structure for mom_mixed_layer_restrat type, public :: mixedlayer_restrat_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: ml_restrat_coef !< A non-dimensional factor by which the instability is enhanced !! over what would be predicted based on the resolved gradients !! [nondim]. This increases with grid spacing^2, up to something @@ -60,9 +61,9 @@ module MOM_mixed_layer_restrat type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - real, dimension(:,:), pointer :: & - MLD_filtered => NULL(), & !< Time-filtered MLD [H ~> m or kg m-2] - MLD_filtered_slow => NULL() !< Slower time-filtered MLD [H ~> m or kg m-2] + real, dimension(:,:), allocatable :: & + MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] + MLD_filtered_slow !< Slower time-filtered MLD [H ~> m or kg m-2] !>@{ !! Diagnostic identifier @@ -101,10 +102,10 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] - type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "Module must be initialized before it is used.") if (GV%nkml>0) then @@ -131,8 +132,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] (not H) - type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -199,7 +200,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") - if (.not.associated(VarMix) .and. CS%front_length>0.) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & + call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "The resolution argument, Rd/dx, was not associated.") if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. @@ -236,8 +238,6 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo enddo ! j-loop elseif (CS%MLE_use_PBL_MLD) then - if (.not. associated(MLD_in)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Argument MLD_in was not associated!") do j = js-1, je+1 ; do i = is-1, ie+1 MLD_fast(i,j) = (CS%MLE_MLD_stretch * GV%Z_to_H) * MLD_in(i,j) enddo ; enddo @@ -571,7 +571,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) 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 [T ~> s] - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -614,8 +614,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nkml = GV%nkml - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "Module must be initialized before it is used.") + if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 @@ -800,8 +801,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! Local variables real :: H_rescale ! A rescaling factor for thicknesses from the representation in @@ -822,9 +823,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "BULKMIXEDLAYER is true.", default=.false.) if (.not. mixedlayer_restrat_init) return - if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") - endif + CS%initialized = .true. ! Nonsense values to cause problems when these parameters are not used CS%MLE_MLD_decay_time = -9.e9*US%s_to_T @@ -940,7 +939,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, endif ! If MLD_filtered is being used, we need to update halo regions after a restart - if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) + if (allocated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) end function mixedlayer_restrat_init @@ -949,8 +948,8 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd logical :: mixedlayer_restrat_init @@ -960,11 +959,6 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) default=.false., do_not_log=.true.) if (.not. mixedlayer_restrat_init) return - ! Allocate the control structure. CS will be later populated by mixedlayer_restrat_init() - if (associated(CS)) call MOM_error(FATAL, & - "mixedlayer_restrat_register_restarts called with an associated control structure.") - allocate(CS) - call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & default=0., do_not_log=.true.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index daeb64fab9..8303d30621 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -35,6 +35,7 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [nondim] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion @@ -82,13 +83,12 @@ module MOM_thickness_diffuse !! Negative values disable the scheme." [nondim] type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] - real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] + real, allocatable :: diagSlopeX(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, allocatable :: diagSlopeY(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] - KH_v_GME => NULL() !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_u_GME(:,:,:) !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_v_GME(:,:,:) !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -116,10 +116,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure 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(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(VarMix_CS), target, intent(in) :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G),SZK_(GV)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. @@ -161,26 +161,24 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& "Module must be initialized before it is used.") - if ((.not.CS%thickness_diffuse) .or. & - .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return + if ((.not.CS%thickness_diffuse) & + .or. .not. (CS%Khth > 0.0 .or. VarMix%use_variable_mixing)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff - if (associated(MEKE)) then - if (associated(MEKE%GM_src)) then - do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo - endif + if (allocated(MEKE%GM_src)) then + do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo endif use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. khth_use_ebt_struct = .false. ; use_Visbeck = .false. ; use_QG_Leith = .false. Depth_scaled = .false. - if (associated(VarMix)) then + if (VarMix%use_variable_mixing) then use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) Resoln_scaled = VarMix%Resoln_scaled_KhTh Depth_scaled = VarMix%Depth_scaled_KhTh @@ -188,7 +186,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp khth_use_ebt_struct = VarMix%khth_use_ebt_struct use_Visbeck = VarMix%use_Visbeck use_QG_Leith = VarMix%use_QG_Leith_GM - if (associated(VarMix%cg1)) cg1 => VarMix%cg1 + if (allocated(VarMix%cg1)) cg1 => VarMix%cg1 else cg1 => null() endif @@ -229,7 +227,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then !$OMP do do j=js,je ; do I=is-1,ie @@ -242,7 +240,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp Khth_loc_u(I,j) = Khth_loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif - endif ; endif + endif if (Resoln_scaled) then !$OMP do @@ -315,7 +313,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo endif endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then !$OMP do do J=js-1,je ; do i=is,ie @@ -328,7 +326,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp Khth_loc_v(i,J) = Khth_loc_v(i,J) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif - endif ; endif + endif if (Resoln_scaled) then !$OMP do @@ -391,7 +389,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ; enddo endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then if (CS%MEKE_GEOM_answers_2018) then !$OMP do @@ -413,7 +411,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo endif endif - endif ; endif + endif !$OMP do @@ -452,8 +450,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp int_slope_u, int_slope_v) endif - if (associated(MEKE) .AND. associated(VarMix)) then - if (associated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then + if (VarMix%use_variable_mixing) then + if (allocated(MEKE%Rd_dx_h) .and. allocated(VarMix%Rd_dx_h)) then !$OMP parallel do default(none) shared(is,ie,js,je,MEKE,VarMix) do j=js,je ; do i=is,ie MEKE%Rd_dx_h(i,j) = VarMix%Rd_dx_h(i,j) @@ -578,13 +576,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! [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 !< 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_(GV)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of !! density gradients [nondim]. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), 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 [nondim]. @@ -694,7 +692,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics - logical :: present_int_slope_u, present_int_slope_v logical :: present_slope_x, present_slope_y, calc_derivatives integer, dimension(2) :: EOSdom_u ! The shifted i-computational domain to use for equation of ! state calculations at u-points. @@ -715,8 +712,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV N2_floor = CS%N2_floor*US%Z_to_L**2 use_EOS = associated(tv%eqn_of_state) - present_int_slope_u = PRESENT(int_slope_u) - present_int_slope_v = PRESENT(int_slope_v) present_slope_x = PRESENT(slope_x) present_slope_y = PRESENT(slope_y) use_Stanley = CS%Stanley_det_coeff >= 0. @@ -728,9 +723,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV hN2_x_PE(:,:,:) = 0.0 hN2_y_PE(:,:,:) = 0.0 - find_work = .false. - if (associated(MEKE)) find_work = associated(MEKE%GM_src) - find_work = (associated(CS%GMwork) .or. find_work) + find_work = allocated(MEKE%GM_src) + find_work = (allocated(CS%GMwork) .or. find_work) if (use_EOS) then halo = 1 ! Default halo to fill is 1 @@ -818,12 +812,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & -!$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 diag_sfn_x, diag_sfn_unlim_x,N2_floor,EOSdom_u, & -!$OMP use_stanley, Tsgs2, & +!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & +!$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & +!$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, & +!$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,use_stanley, Tsgs2, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & @@ -941,11 +933,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Adjust real slope by weights that bias towards slope of interfaces ! that ignore density gradients along layers. - if (present_int_slope_u) then - Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) - slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) - endif + Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & + int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) hN2_x_PE(I,j,k) = hN2_u(I,K) @@ -1090,12 +1080,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Calculate the meridional fluxes and gradients. EOSdom_v(:) = EOS_domain(G%HI) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & -!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP I_slope_max2,h_neglect2,present_int_slope_v, & -!$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & -!$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1, & -!$OMP diag_sfn_y,diag_sfn_unlim_y,N2_floor,EOSdom_v,& -!$OMP use_stanley, Tsgs2, & +!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & +!$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & +!$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1,diag_sfn_y, & +!$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,Tsgs2, & !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & @@ -1211,11 +1199,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Adjust real slope by weights that bias towards slope of interfaces ! that ignore density gradients along layers. - if (present_int_slope_v) then - Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) - slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) - endif + Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & + int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) hN2_y_PE(i,J,k) = hN2_v(i,K) @@ -1422,13 +1408,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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 + if (allocated(CS%GMwork)) CS%GMwork(i,j) = Work_h + if (.not. CS%GM_src_alt) then ; if (allocated(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 + if (find_work .and. CS%GM_src_alt) then ; if (allocated(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) + & @@ -1498,7 +1484,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration @@ -1904,7 +1890,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation diagnostics - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1915,12 +1901,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! rotation [nondim]. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. - if (associated(CS)) then - call MOM_error(WARNING, & - "Thickness_diffuse_init called with an associated control structure.") - return - else ; allocate(CS) ; endif - + CS%initialized = .true. CS%diag => diag ! Read all relevant parameters and write them to the model log. @@ -2038,8 +2019,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) default=.false.) if (CS%use_GME_thickness_diffuse) then - call safe_alloc_ptr(CS%KH_u_GME,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) - call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) + allocate(CS%KH_u_GME(G%IsdB:G%IedB, G%jsd:G%jed, GV%ke+1), source=0.) + allocate(CS%KH_v_GME(G%isd:G%ied, G%JsdB:G%JedB, GV%ke+1), source=0.) endif CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & @@ -2058,7 +2039,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**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') - if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) + if (CS%id_GMwork > 0) & + allocate(CS%GMwork(G%isd:G%ied,G%jsd:G%jed), source=0.) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & 'Parameterized mesoscale eddy advection diffusivity at U-point', & @@ -2085,10 +2067,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim', conversion=US%Z_to_L) - if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) + if (CS%id_slope_x > 0) & + allocate(CS%diagSlopeX(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke+1), source=0.) + CS%id_slope_y = register_diag_field('ocean_model', 'neutral_slope_y', diag%axesCvi, Time, & 'Meridional slope of neutral surface', 'nondim', conversion=US%Z_to_L) - if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) + if (CS%id_slope_y > 0) & + allocate(CS%diagSlopeY(G%isd:G%ied,G%JsdB:G%JedB,GV%ke+1), source=0.) + CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction', & 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -2106,7 +2092,7 @@ end subroutine thickness_diffuse_init !> Copies ubtav and vbtav from private type into arrays subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) - type(thickness_diffuse_CS), pointer :: CS !< Control structure for this module + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for this module type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< interface height diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 862b622d56..f1d6e6bb57 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -11,6 +11,7 @@ module MOM_tidal_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : field_exists, file_exists, MOM_read_data use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -47,12 +48,12 @@ module MOM_tidal_forcing !! astronomical/equilibrium argument. real :: sal_scalar !< The constant of proportionality between sea surface !! height (really it should be bottom pressure) anomalies - !! and bottom geopotential anomalies. + !! and bottom geopotential anomalies [nondim]. integer :: nc !< The number of tidal constituents in use. real, dimension(MAX_CONSTITUENTS) :: & - freq, & !< The frequency of a tidal constituent [s-1]. - phase0, & !< The phase of a tidal constituent at time 0, in radians. - amp, & !< The amplitude of a tidal constituent at time 0 [m]. + freq, & !< The frequency of a tidal constituent [T-1 ~> s-1]. + phase0, & !< The phase of a tidal constituent at time 0 [rad]. + amp, & !< The amplitude of a tidal constituent at time 0 [Z ~> m]. love_no !< The Love number of a tidal constituent at time 0 [nondim]. integer :: struct(MAX_CONSTITUENTS) !< An encoded spatial structure for each constituent character (len=16) :: const_name(MAX_CONSTITUENTS) !< The name of each constituent @@ -60,15 +61,15 @@ module MOM_tidal_forcing type(time_type) :: time_ref !< Reference time (t = 0) used to calculate tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Astronomical longitudes used to calculate !! tidal phases at t = 0. - real, pointer, dimension(:,:,:) :: & - sin_struct => NULL(), & !< The sine and cosine based structures that can - cos_struct => NULL(), & !< be associated with the astronomical forcing. - cosphasesal => NULL(), & !< The cosine and sine of the phase of the - sinphasesal => NULL(), & !< self-attraction and loading amphidromes. - ampsal => NULL(), & !< The amplitude of the SAL [m]. - cosphase_prev => NULL(), & !< The cosine and sine of the phase of the - sinphase_prev => NULL(), & !< amphidromes in the previous tidal solutions. - amp_prev => NULL() !< The amplitude of the previous tidal solution [m]. + real, allocatable :: & + sin_struct(:,:,:), & !< The sine and cosine based structures that can + cos_struct(:,:,:), & !< be associated with the astronomical forcing [nondim]. + cosphasesal(:,:,:), & !< The cosine and sine of the phase of the + sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. + ampsal(:,:,:), & !< The amplitude of the SAL [Z ~> m]. + cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the + sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. + amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -87,8 +88,9 @@ module MOM_tidal_forcing subroutine astro_longitudes_init(time_ref, longitudes) type(time_type), intent(in) :: time_ref !> Time to calculate longitudes for. type(astro_longitudes), intent(out) :: longitudes !> Lunar and solar longitudes at time_ref. - real :: D, T !> Date offsets - real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... + real :: D !> Time since the reference date [days] + real :: T !> Time in Julian centuries [centuries] + real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] ! Find date at time_ref in days since 1900-01-01 D = time_type_to_real(time_ref - set_date(1900, 1, 1)) / (24.0 * 3600.0) ! Time since 1900-01-01 in Julian centuries @@ -176,44 +178,45 @@ end function tidal_frequency !> Find amplitude (f) and phase (u) modulation of tidal constituents by the 18.6 !! year nodal cycle. Values here follow Table I.6 in Kowalik and Luick, !! "Modern Theory and Practice of Tide Analysis and Tidal Power", 2019. -subroutine nodal_fu(constit, N, fn, un) - character (len=2), intent(in) :: constit !> Tidal constituent to find modulation for. - real, intent(in) :: N !> Longitude of ascending node [rad]. - !! Calculate using astro_longitudes_init. - real, parameter :: RADIANS = 4.0 * atan(1.0) / 180.0 !> Converts degrees to radians. - real, intent(out) :: & - fn, & !> Amplitude modulation [nondim] - un !> Phase modulation [rad] +subroutine nodal_fu(constit, nodelon, fn, un) + character (len=2), intent(in) :: constit !> Tidal constituent to find modulation for. + real, intent(in) :: nodelon !> Longitude of ascending node [rad], which + !! can be calculated using astro_longitudes_init. + real, intent(out) :: fn !> Amplitude modulation [nondim] + real, intent(out) :: un !> Phase modulation [rad] + + real, parameter :: RADIANS = 4.0 * atan(1.0) / 180.0 !> Converts degrees to radians [nondim] + select case (constit) case ("M2") - fn = 1.0 - 0.037 * cos(N) - un = -2.1 * RADIANS * sin(N) + fn = 1.0 - 0.037 * cos(nodelon) + un = -2.1 * RADIANS * sin(nodelon) case ("S2") fn = 1.0 ! Solar S2 has no amplitude modulation. un = 0.0 ! S2 has no phase modulation. case ("N2") - fn = 1.0 - 0.037 * cos(N) - un = -2.1 * RADIANS * sin(N) + fn = 1.0 - 0.037 * cos(nodelon) + un = -2.1 * RADIANS * sin(nodelon) case ("K2") - fn = 1.024 + 0.286 * cos(N) - un = -17.7 * RADIANS * sin(N) + fn = 1.024 + 0.286 * cos(nodelon) + un = -17.7 * RADIANS * sin(nodelon) case ("K1") - fn = 1.006 + 0.115 * cos(N) - un = -8.9 * RADIANS * sin(N) + fn = 1.006 + 0.115 * cos(nodelon) + un = -8.9 * RADIANS * sin(nodelon) case ("O1") - fn = 1.009 + 0.187 * cos(N) - un = 10.8 * RADIANS * sin(N) + fn = 1.009 + 0.187 * cos(nodelon) + un = 10.8 * RADIANS * sin(nodelon) case ("P1") fn = 1.0 ! P1 has no amplitude modulation. un = 0.0 ! P1 has no phase modulation. case ("Q1") - fn = 1.009 + 0.187 * cos(N) - un = 10.8 * RADIANS * sin(N) + fn = 1.009 + 0.187 * cos(nodelon) + un = 10.8 * RADIANS * sin(nodelon) case ("MF") - fn = 1.043 + 0.414 * cos(N) - un = -23.7 * RADIANS * sin(N) + fn = 1.043 + 0.414 * cos(nodelon) + un = -23.7 * RADIANS * sin(nodelon) case ("MM") - fn = 1.0 - 0.130 * cos(N) + fn = 1.0 - 0.130 * cos(nodelon) un = 0.0 ! MM has no phase modulation. case default call MOM_error(FATAL, "nodal_fu: unrecognized constituent") @@ -226,26 +229,30 @@ end subroutine nodal_fu !! while fields like the background viscosities are 2-D arrays. !! ALLOC is a macro defined in MOM_memory.h for allocate or nothing with !! static memory. -subroutine tidal_forcing_init(Time, G, param_file, CS) - type(time_type), intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(tidal_forcing_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. +subroutine tidal_forcing_init(Time, G, US, param_file, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & phase, & ! The phase of some tidal constituent. lat_rad, lon_rad ! Latitudes and longitudes of h-points in radians. real :: deg_to_rad - real, dimension(MAX_CONSTITUENTS) :: freq_def, phase0_def, amp_def, love_def + real, dimension(MAX_CONSTITUENTS) :: freq_def ! Default frequency for each tidal constituent [s-1] + real, dimension(MAX_CONSTITUENTS) :: phase0_def ! Default reference phase for each tidal constituent [rad] + real, dimension(MAX_CONSTITUENTS) :: amp_def ! Default amplitude for each tidal constituent [m] + real, dimension(MAX_CONSTITUENTS) :: love_def ! Default love number for each constituent [nondim] integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing. logical :: use_const ! True if a constituent is being used. logical :: use_M2, use_S2, use_N2, use_K2, use_K1, use_O1, use_P1, use_Q1 logical :: use_MF, use_MM logical :: tides ! True if a tidal forcing is to be used. logical :: FAIL_IF_MISSING = .true. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_tidal_forcing" ! This module's name. character(len=128) :: mesg character(len=200) :: tidal_input_files(4*MAX_CONSTITUENTS) @@ -253,12 +260,6 @@ subroutine tidal_forcing_init(Time, G, param_file, 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 - if (associated(CS)) then - call MOM_error(WARNING, "tidal_forcing_init called with an associated "// & - "control structure.") - return - endif - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "TIDES", tides, & @@ -266,8 +267,6 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) if (.not.tides) return - allocate(CS) - ! Set up the spatial structure functions for the diurnal, semidiurnal, and ! low-frequency tidal components. allocate(CS%sin_struct(isd:ied,jsd:jed,3), source=0.0) @@ -389,7 +388,7 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) if (sum(tide_ref_date) == 0) then ! tide_ref_date defaults to 0. CS%time_ref = set_date(1, 1, 1) else - if(.not. CS%use_eq_phase) then + if (.not. CS%use_eq_phase) then ! Using a reference date but not using phase relative to equilibrium. ! This makes sense as long as either phases are overridden, or ! correctly simulating tidal phases is not desired. @@ -397,68 +396,68 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) endif CS%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3)) endif - ! Set the parameters for all components that are in use. - ! Initialize reference time for tides and - ! find relevant lunar and solar longitudes at the reference time. + + ! Initialize reference time for tides and find relevant lunar and solar + ! longitudes at the reference time. if (CS%use_eq_phase) call astro_longitudes_init(CS%time_ref, CS%tidal_longitudes) + + ! Set the parameters for all components that are in use. c=0 if (use_M2) then c=c+1 ; CS%const_name(c) = "M2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.242334 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.242334 ! Default amplitude in m. endif if (use_S2) then c=c+1 ; CS%const_name(c) = "S2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.112743 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.112743 ! Default amplitude in m. endif if (use_N2) then c=c+1 ; CS%const_name(c) = "N2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.046397 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.046397 ! Default amplitude in m. endif if (use_K2) then c=c+1 ; CS%const_name(c) = "K2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.030684 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.030684 ! Default amplitude in m. endif if (use_K1) then c=c+1 ; CS%const_name(c) = "K1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.736 ; CS%amp(c) = 0.141565 + CS%love_no(c) = 0.736 ; amp_def(c) = 0.141565 ! Default amplitude in m. endif if (use_O1) then c=c+1 ; CS%const_name(c) = "O1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.695 ; CS%amp(c) = 0.100661 + CS%love_no(c) = 0.695 ; amp_def(c) = 0.100661 ! Default amplitude in m. endif if (use_P1) then c=c+1 ; CS%const_name(c) = "P1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.706 ; CS%amp(c) = 0.046848 + CS%love_no(c) = 0.706 ; amp_def(c) = 0.046848 ! Default amplitude in m. endif if (use_Q1) then c=c+1 ; CS%const_name(c) = "Q1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.695 ; CS%amp(c) = 0.019273 + CS%love_no(c) = 0.695 ; amp_def(c) = 0.019273 ! Default amplitude in m. endif if (use_MF) then c=c+1 ; CS%const_name(c) = "MF" ; CS%struct(c) = 3 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.042041 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.042041 ! Default amplitude in m. endif if (use_MM) then c=c+1 ; CS%const_name(c) = "MM" ; CS%struct(c) = 3 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.022191 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.022191 ! Default amplitude in m. endif ! Set defaults for all included constituents ! and things that can be set by functions do c=1,nc - CS%freq(c) = tidal_frequency(CS%const_name(c)) - freq_def(c) = CS%freq(c) + freq_def(c) = tidal_frequency(CS%const_name(c)) love_def(c) = CS%love_no(c) - amp_def(c) = CS%amp(c) CS%phase0(c) = 0.0 if (CS%use_eq_phase) then phase0_def(c) = eq_phase(CS%const_name(c), CS%tidal_longitudes) @@ -475,11 +474,11 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) "Frequency of the "//trim(CS%const_name(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(CS%const_name(c))// & - " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=freq_def(c)) + " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=freq_def(c), scale=US%T_to_s) call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_AMP", CS%amp(c), & "Amplitude of the "//trim(CS%const_name(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & - " are true.", units="m", default=amp_def(c)) + " are true.", units="m", default=amp_def(c), scale=US%m_to_Z) call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_PHASE_T0", CS%phase0(c), & "Phase of the "//trim(CS%const_name(c))//" tidal constituent at time 0. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & @@ -492,8 +491,9 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) allocate(CS%ampsal(isd:ied,jsd:jed,nc)) do c=1,nc ! Read variables with names like PHASE_SAL_M2 and AMP_SAL_M2. - call find_in_files(tidal_input_files,"PHASE_SAL_"//trim(CS%const_name(c)),phase,G) - call find_in_files(tidal_input_files,"AMP_SAL_"//trim(CS%const_name(c)),CS%ampsal(:,:,c),G) + call find_in_files(tidal_input_files, "PHASE_SAL_"//trim(CS%const_name(c)), phase, G) + call find_in_files(tidal_input_files, "AMP_SAL_"//trim(CS%const_name(c)), CS%ampsal(:,:,c), & + G, scale=US%m_to_Z) call pass_var(phase, G%domain,complete=.false.) call pass_var(CS%ampsal(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -509,8 +509,9 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) allocate(CS%amp_prev(isd:ied,jsd:jed,nc)) do c=1,nc ! Read variables with names like PHASE_PREV_M2 and AMP_PREV_M2. - call find_in_files(tidal_input_files,"PHASE_PREV_"//trim(CS%const_name(c)),phase,G) - call find_in_files(tidal_input_files,"AMP_PREV_"//trim(CS%const_name(c)),CS%amp_prev(:,:,c),G) + call find_in_files(tidal_input_files, "PHASE_PREV_"//trim(CS%const_name(c)), phase, G) + call find_in_files(tidal_input_files, "AMP_PREV_"//trim(CS%const_name(c)), CS%amp_prev(:,:,c), & + G, scale=US%m_to_Z) call pass_var(phase, G%domain,complete=.false.) call pass_var(CS%amp_prev(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -526,18 +527,19 @@ end subroutine tidal_forcing_init !> This subroutine finds a named variable in a list of files and reads its !! values into a domain-decomposed 2-d array -subroutine find_in_files(filenames, varname, array, G) +subroutine find_in_files(filenames, varname, array, G, scale) character(len=*), dimension(:), intent(in) :: filenames !< The names of the files to search for the named variable character(len=*), intent(in) :: varname !< The name of the variable to read type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data + real, optional, intent(in) :: scale !< A factor by which to rescale the array. ! Local variables integer :: nf do nf=1,size(filenames) if (LEN_TRIM(filenames(nf)) == 0) cycle if (field_exists(filenames(nf), varname, MOM_domain=G%Domain)) then - call MOM_read_data(filenames(nf), varname, array, G%Domain) + call MOM_read_data(filenames(nf), varname, array, G%Domain, scale=scale) return endif enddo @@ -560,7 +562,7 @@ end subroutine find_in_files !! and loading. subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to tidal_forcing_init. + type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a previous call to tidal_forcing_init. real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with !! the local value of eta [nondim]. @@ -579,32 +581,26 @@ end subroutine tidal_forcing_sensitivity !! height. For now, eta and eta_tidal are both geopotential heights in depth !! units, but probably the input for eta should really be replaced with the !! column mass anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to_Z) +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height !! anomalies [Z ~> m]. - type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. - real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of - !! eta_tidal with the local value of - !! eta [nondim]. - real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. ! Local variables - real :: now ! The relative time in seconds. - real :: amp_cosomegat, amp_sinomegat - real :: cosomegat, sinomegat - real :: m_Z ! A scaling factor from m to depth units. - real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. + real :: now ! The relative time compared with the tidal reference [T ~> s] + real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m] + real :: cosomegat, sinomegat ! The components of the phase [nondim] + real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal [nondim] integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not.associated(CS)) return - call cpu_clock_begin(id_clock_tides) if (CS%nc == 0) then @@ -612,7 +608,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to return endif - now = time_type_to_real(Time - cs%time_ref) + now = US%s_to_T * time_type_to_real(Time - cs%time_ref) if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then eta_prop = 2.0*CS%SAL_SCALAR @@ -622,21 +618,14 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to eta_prop = 0.0 endif - if (present(deta_tidal_deta)) then - deta_tidal_deta = eta_prop - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; eta_tidal(i,j) = 0.0 ; enddo ; enddo - else - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_prop*eta(i,j) - enddo ; enddo - endif - - m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + eta_tidal(i,j) = eta_prop*eta(i,j) + enddo ; enddo do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = m_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = m_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -647,7 +636,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + m_Z*CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -656,7 +645,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - m_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif @@ -670,16 +659,16 @@ subroutine tidal_forcing_end(CS) type(tidal_forcing_CS), intent(inout) :: CS !< The control structure returned by a previous call !! to tidal_forcing_init; it is deallocated here. - if (associated(CS%sin_struct)) deallocate(CS%sin_struct) - if (associated(CS%cos_struct)) deallocate(CS%cos_struct) + if (allocated(CS%sin_struct)) deallocate(CS%sin_struct) + if (allocated(CS%cos_struct)) deallocate(CS%cos_struct) - if (associated(CS%cosphasesal)) deallocate(CS%cosphasesal) - if (associated(CS%sinphasesal)) deallocate(CS%sinphasesal) - if (associated(CS%ampsal)) deallocate(CS%ampsal) + if (allocated(CS%cosphasesal)) deallocate(CS%cosphasesal) + if (allocated(CS%sinphasesal)) deallocate(CS%sinphasesal) + if (allocated(CS%ampsal)) deallocate(CS%ampsal) - if (associated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) - if (associated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) - if (associated(CS%amp_prev)) deallocate(CS%amp_prev) + if (allocated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) + if (allocated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) + if (allocated(CS%amp_prev)) deallocate(CS%amp_prev) end subroutine tidal_forcing_end !> \namespace tidal_forcing diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 1225487eaf..472ee21e36 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -69,7 +69,6 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field. integer :: num_tlevs !< The number of time records contained in the file - real, dimension(:,:,:), pointer :: mask_in => NULL() !< pointer to the data mask. real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data. real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid. end type p3d @@ -79,7 +78,6 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file - real, dimension(:,:), pointer :: mask_in => NULL()!< pointer to the data mask. real, dimension(:,:), pointer :: p => NULL() !< pointer the data. real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. end type p2d @@ -94,16 +92,16 @@ module MOM_ALE_sponge integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field logical :: sponge_uv !< Control whether u and v are included in sponge - integer, pointer :: col_i(:) => NULL() !< Array of the i-indices of each tracer column being damped. - integer, pointer :: col_j(:) => NULL() !< Array of the j-indices of each tracer column being damped. - integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indices of each u-column being damped. - integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indices of each u-column being damped. - integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indices of each v-column being damped. - integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indices of each v-column being damped. + integer, allocatable :: col_i(:) !< Array of the i-indices of each tracer column being damped + integer, allocatable :: col_j(:) !< Array of the j-indices of each tracer column being damped + integer, allocatable :: col_i_u(:) !< Array of the i-indices of each u-column being damped + integer, allocatable :: col_j_u(:) !< Array of the j-indices of each u-column being damped + integer, allocatable :: col_i_v(:) !< Array of the i-indices of each v-column being damped + integer, allocatable :: col_j_v(:) !< Array of the j-indices of each v-column being damped - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [T-1 ~> s-1]. - real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [T-1 ~> s-1]. - real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column [T-1 ~> s-1]. + real, allocatable :: Iresttime_col(:) !< The inverse restoring time of each tracer column [T-1 ~> s-1] + real, allocatable :: Iresttime_col_u(:) !< The inverse restoring time of each u-column [T-1 ~> s-1] + real, allocatable :: Iresttime_col_v(:) !< 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. @@ -366,15 +364,10 @@ end subroutine initialize_ALE_sponge_fixed !> Return the number of layers in the data with a fixed ALE sponge, or 0 if there are !! no sponge columns on this PE. function get_ALE_sponge_nz_data(CS) - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for the ALE_sponge module. + type(ALE_sponge_CS), intent(in) :: CS !< ALE sponge control struct integer :: get_ALE_sponge_nz_data !< The number of layers in the fixed sponge data. - if (associated(CS)) then - get_ALE_sponge_nz_data = CS%nz_data - else - get_ALE_sponge_nz_data = 0 - endif + get_ALE_sponge_nz_data = CS%nz_data end function get_ALE_sponge_nz_data !> Return the thicknesses used for the data with a fixed ALE sponge @@ -600,11 +593,9 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS, US) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure + type(ALE_sponge_CS), intent(inout) :: CS !< ALE sponge control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - if (.not.associated(CS)) return - CS%diag => diag CS%id_sp_tendency(1) = -1 @@ -840,7 +831,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) 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_ALE_sponge (in). - type(time_type), optional, intent(in) :: Time !< The current model date + type(time_type), 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]. @@ -885,8 +876,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) endif if (CS%time_varying_sponges) then - if (.not. present(Time)) & - call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, 1.0, G, sp_val, mask_z, z_in, & @@ -971,9 +960,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%sponge_uv) then if (CS%time_varying_sponges) then - if (.not. present(Time)) & - call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") - nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, 1.0, G, sp_val, mask_z, z_in, & @@ -1282,8 +1268,7 @@ end subroutine rotate_ALE_sponge ! after rotation. This function is part of a temporary solution until ! something more robust is developed. subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) - type(ALE_sponge_CS), pointer :: sponge !< A pointer to the control structure for this module - !! that is set by a previous call to initialize_ALE_sponge. + type(ALE_sponge_CS), intent(inout) :: sponge !< ALE sponge control struct real, dimension(:,:,:), & target, intent(in) :: p_old !< The previous array of target values type(ocean_grid_type), intent(in) :: G !< The updated ocean grid structure @@ -1296,7 +1281,6 @@ subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) do n=1,sponge%fldno if (associated(sponge%var(n)%p, p_old)) sponge%var(n)%p => p_new enddo - end subroutine update_ALE_sponge_field @@ -1311,16 +1295,16 @@ subroutine ALE_sponge_end(CS) if (.not.associated(CS)) return - if (associated(CS%col_i)) deallocate(CS%col_i) - if (associated(CS%col_i_u)) deallocate(CS%col_i_u) - if (associated(CS%col_i_v)) deallocate(CS%col_i_v) - if (associated(CS%col_j)) deallocate(CS%col_j) - if (associated(CS%col_j_u)) deallocate(CS%col_j_u) - if (associated(CS%col_j_v)) deallocate(CS%col_j_v) + if (allocated(CS%col_i)) deallocate(CS%col_i) + if (allocated(CS%col_i_u)) deallocate(CS%col_i_u) + if (allocated(CS%col_i_v)) deallocate(CS%col_i_v) + if (allocated(CS%col_j)) deallocate(CS%col_j) + if (allocated(CS%col_j_u)) deallocate(CS%col_j_u) + if (allocated(CS%col_j_v)) deallocate(CS%col_j_v) - if (associated(CS%Iresttime_col)) deallocate(CS%Iresttime_col) - if (associated(CS%Iresttime_col_u)) deallocate(CS%Iresttime_col_u) - if (associated(CS%Iresttime_col_v)) deallocate(CS%Iresttime_col_v) + if (allocated(CS%Iresttime_col)) deallocate(CS%Iresttime_col) + if (allocated(CS%Iresttime_col_u)) deallocate(CS%Iresttime_col_u) + if (allocated(CS%Iresttime_col_v)) deallocate(CS%Iresttime_col_v) do m=1,CS%fldno if (associated(CS%Ref_val(m)%p)) deallocate(CS%Ref_val(m)%p) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 0711d2291d..d12d850a73 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -181,18 +181,17 @@ module MOM_CVMix_KPP !> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. -logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) +logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) ! Arguments type(param_file_type), intent(in) :: paramFile !< File parser type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Model time type(KPP_CS), pointer :: CS !< Control structure logical, optional, intent(out) :: passive !< Copy of %passiveMode - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables # include "version_variable.h" @@ -394,7 +393,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) call get_param(paramFile, mdl, "USE_KPP_LT_K", CS%LT_K_Enhancement, & 'Flag for Langmuir turbulence enhancement of turbulent'//& 'mixing coefficient.', units="", Default=.false.) - call get_param(paramFile, mdl, "STOKES_MIXING", CS%STOKES_MIXING, & + call get_param(paramFile, mdl, "STOKES_MIXING", CS%Stokes_Mixing, & 'Flag for Langmuir turbulence enhancement of turbulent'//& 'mixing coefficient.', units="", Default=.false.) if (CS%LT_K_Enhancement) then @@ -539,9 +538,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & - 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s') + 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s', conversion=GV%H_to_m*US%s_to_T) CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & - 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s') + 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s', conversion=GV%H_to_m*US%s_to_T) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & @@ -555,13 +554,17 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, & - 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', 'K/s') + 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', & + 'K/s', conversion=US%s_to_T) CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, & - 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', 'ppt/s') + 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', & + 'ppt/s', conversion=US%s_to_T) CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, & - 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', 'W/m^2') + 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', & + 'W/m^2', conversion=US%QRZ_T_to_W_m2) CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, & - 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', 'kg/(sec*m^2)') + 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', & + 'kg/(sec*m^2)', conversion=US%RZ_T_to_kg_m2s) CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C') CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & @@ -607,9 +610,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) end function KPP_init !> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, US, h, uStar, & - buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& - nonLocalTransScalar, waves, lamult) +subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & + nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -630,8 +632,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [m s-1] - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier + type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier ! Local variables integer :: i, j, k ! Loop indices @@ -643,13 +645,15 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & real :: surfFricVel, surfBuoyFlux real :: sigma, sigmaRatio - real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] ! For Langmuir Calculations real :: LangEnhK ! Langmuir enhancement for mixing coefficient + if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & + "KPP_calculate: The Waves control structure must be associated if STOKES_MIXING is True.") if (CS%debug) then call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) @@ -671,7 +675,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !$OMP surfBuoyFlux, Kdiffusivity, Kviscosity, LangEnhK, sigma, & !$OMP sigmaRatio) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, Kt, & - !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, waves, lamult) + !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec @@ -920,7 +924,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS + type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult!< Langmuir enhancement factor ! Local variables @@ -948,7 +952,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average [m] - real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] real :: delH ! Thickness of a layer [m] real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer @@ -968,6 +972,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl integer :: B real :: WST + if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & + "KPP_compute_BLD: The Waves control structure must be associated if STOKES_MIXING is True.") if (CS%debug) then call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) @@ -1061,8 +1067,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then - surfHus = surfHus + 0.5*US%L_T_to_m_s*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH - surfHvs = surfHvs + 0.5*US%L_T_to_m_s*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH + surfHus = surfHus + 0.5*US%L_T_to_m_s*(Waves%US_x(i,j,ktmp)+Waves%US_x(i-1,j,ktmp)) * delH + surfHvs = surfHvs + 0.5*US%L_T_to_m_s*(Waves%US_y(i,j,ktmp)+Waves%US_y(i,j-1,ktmp)) * delH endif enddo @@ -1177,7 +1183,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & zt_cntr = cellHeight(1:GV%ke), & ! Depth of cell center [m] - delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] + delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [m s-2] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] N_iface=CS%N(i,j,:), & ! Buoyancy frequency [s-1] @@ -1207,7 +1213,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) @@ -1283,12 +1289,12 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local - real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [m] real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] ! (negative in the ocean) real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] ! (negative in the ocean) - real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] integer :: i, j, k, s @@ -1387,14 +1393,15 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar - !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] - real, intent(in) :: dt !< Time-step [s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature - real, intent(in) :: C_p !< Seawater specific heat capacity [J kg-1 degC-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, intent(in) :: dt !< Time-step [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC] + real, intent(in) :: C_p !< Seawater specific heat capacity + !! [Q degC-1 ~> J kg-1 degC-1] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1] dtracer(:,:,:) = 0.0 @@ -1429,8 +1436,9 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec + ! Here dtracer has units of [Q R Z T-1 ~> W m-2]. dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * C_p * GV%H_to_kg_m2 + surfFlux(i,j) * C_p * GV%H_to_RZ enddo enddo enddo @@ -1444,18 +1452,18 @@ end subroutine KPP_NonLocalTransport_temp !> This routine is a useful prototype for other material tracers. subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, scalar) - type(KPP_CS), intent(in) :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + type(KPP_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar - !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] - real, intent(in) :: dt !< Time-step [s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + real, intent(in) :: dt !< Time-step [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [ppt T-1 ~> ppt s-1] dtracer(:,:,:) = 0.0 @@ -1490,8 +1498,9 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec + ! Here dtracer has units of [ppt R Z T-1 ~> ppt kg m-2 s-1] dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * GV%H_to_kg_m2 + surfFlux(i,j) * GV%H_to_RZ enddo enddo enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index a615c9f40b..7371ba7009 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -21,7 +21,7 @@ module MOM_CVMix_conv #include -public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_end, CVMix_conv_is_used +public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_is_used !> Control structure including parameters for CVMix convection. type, public :: CVMix_conv_cs ; private @@ -55,20 +55,14 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_conv_cs), pointer :: CS !< This module's control structure. - ! Local variables + type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convetction control struct + real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. logical :: useEPBL !< If True, use the ePBL boundary layer scheme. ! This include declares and sets the variable "version". #include "version_variable.h" - if (associated(CS)) then - call MOM_error(WARNING, "CVMix_conv_init called with an associated "// & - "control structure.") - return - endif - ! Read parameters call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & @@ -82,7 +76,6 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) default=.false.) if (.not. CVMix_conv_init) return - allocate(CS) call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, default=.false., & do_not_log=.true.) @@ -108,7 +101,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & "Diffusivity used in convective regime. Corresponding viscosity "//& - "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & + "(KV_CONV) will be set to KD_CONV * PRANDTL_CONV.", & units='m2/s', default=1.00) call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & @@ -146,14 +139,13 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - type(CVMix_conv_cs), pointer :: CS !< The control structure returned - !! by a previous call to CVMix_conv_init. + type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control struct real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd !< Diapycnal diffusivity at each interface that + intent(inout) :: Kd !< Diapycnal diffusivity at each interface that !! will be incremented here [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(inout) :: KV !< Viscosity at each interface that will be + intent(inout) :: KV !< Viscosity at each interface that will be !! incremented here [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_aux !< A second diapycnal diffusivity at each @@ -174,7 +166,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & kd_conv, & !< Diffusivity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] kv_conv, & !< Viscosity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] - N2_3d !< Squared buoyancy frequency for diagnostics [N-2 ~> s-2] + N2_3d !< Squared buoyancy frequency for diagnostics [T-2 ~> s-2] integer :: kOBL !< level of OBL extent real :: g_o_rho0 ! Gravitational acceleration divided by density times unit convserion factors ! [Z s-2 R-1 ~> m4 s-2 kg-1] @@ -243,12 +235,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) max_nlev=GV%ke, & OBL_ind=kOBL) - if (present(Kd)) then - ! Increment the diffusivity outside of the boundary layer. - do K=max(1,kOBL+1),GV%ke+1 - Kd(i,j,K) = Kd(i,j,K) + US%m2_s_to_Z2_T * kd_col(K) - enddo - endif + ! Increment the diffusivity outside of the boundary layer. + do K=max(1,kOBL+1),GV%ke+1 + Kd(i,j,K) = Kd(i,j,K) + US%m2_s_to_Z2_T * kd_col(K) + enddo if (present(Kd_aux)) then ! Increment the other diffusivity outside of the boundary layer. do K=max(1,kOBL+1),GV%ke+1 @@ -256,12 +246,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) enddo endif - if (present(Kv)) then - ! Increment the viscosity outside of the boundary layer. - do K=max(1,kOBL+1),GV%ke+1 - Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * kv_col(K) - enddo - endif + ! Increment the viscosity outside of the boundary layer. + do K=max(1,kOBL+1),GV%ke+1 + Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * kv_col(K) + enddo ! Store 3-d arrays for diagnostics. if (CS%id_kv_conv > 0) then @@ -287,9 +275,9 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) ! if (CS%id_kd_conv > 0) & ! call hchksum(Kd_conv, "MOM_CVMix_conv: Kd_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) ! if (CS%id_kv_conv > 0) & - ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%m2_s_to_Z2_T) - if (present(Kd)) call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - if (present(Kv)) call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif ! send diagnostics to post_data @@ -309,11 +297,4 @@ logical function CVMix_conv_is_used(param_file) end function CVMix_conv_is_used -!> Clear pointers and dealocate memory -! NOTE: Placeholder destructor -subroutine CVMix_conv_end(CS) - type(CVMix_conv_cs), pointer :: CS !< Control structure for this module that - !! will be deallocated in this subroutine -end subroutine CVMix_conv_end - end module MOM_CVMix_conv diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 87e5107acd..eed99ceb3f 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -73,7 +73,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-2] + real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-1] real :: pref ! Interface pressures [R L2 T-2 ~> Pa] real :: DU, DV ! Velocity differences [L T-1 ~> m s-1] real :: DZ ! Grid spacing around an interface [Z ~> m] diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 4a9d428807..11df20f5ea 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -30,6 +30,7 @@ module MOM_bulk_mixed_layer !> The control structure with parameters for the MOM_bulk_mixed_layer module type, public :: bulkmixedlayer_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. integer :: nkml !< The number of layers in the mixed layer. integer :: nkbl !< The number of buffer layers. integer :: nsw !< The number of bands of penetrating shortwave radiation. @@ -135,8 +136,6 @@ module MOM_bulk_mixed_layer !! detrainment [R Z L2 T-3 ~> W m-2]. diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only !! 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 !>@{ Diagnostic IDs @@ -149,42 +148,13 @@ module MOM_bulk_mixed_layer end type bulkmixedlayer_CS !>@{ CPU clock IDs -integer :: id_clock_detrain=0, id_clock_mech=0, id_clock_conv=0, id_clock_adjustment=0 -integer :: id_clock_EOS=0, id_clock_resort=0, id_clock_pass=0 +integer :: id_clock_pass=0 !>@} contains -!> This subroutine partially steps the bulk mixed layer model. -!! The following processes are executed, in the order listed. -!! 1. Undergo convective adjustment into mixed layer. -!! 2. Apply surface heating and cooling. -!! 3. Starting from the top, entrain whatever fluid the TKE budget -!! permits. Penetrating shortwave radiation is also applied at -!! this point. -!! 4. If there is any unentrained fluid that was formerly in the -!! mixed layer, detrain this fluid into the buffer layer. This -!! is equivalent to the mixed layer detraining to the Monin- -!! Obukhov depth. -!! 5. Divide the fluid in the mixed layer evenly into CS%nkml pieces. -!! 6. Split the buffer layer if appropriate. -!! Layers 1 to nkml are the mixed layer, nkml+1 to nkml+nkbl are the -!! buffer layers. The results of this subroutine are mathematically -!! identical if there are multiple pieces of the mixed layer with -!! the same density or if there is just a single layer. There is no -!! stability limit on the time step. -!! -!! The key parameters for the mixed layer are found in the control structure. -!! These include mstar, nstar, nstar2, pen_SW_frac, pen_SW_scale, and TKE_decay. -!! For the Oberhuber (1993) mixed layer, the values of these are: -!! pen_SW_frac = 0.42, pen_SW_scale = 15.0 m, mstar = 1.25, -!! nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 -!! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. -!! Conv_decay has been eliminated in favor of the well-calibrated form for the -!! efficiency of penetrating convection from Wang (2003). -!! 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 +!> This subroutine partially steps the bulk mixed layer model. +!! See \ref BML for more details. 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. @@ -213,11 +183,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C intent(inout) :: eb !< The amount of fluid moved upward into a !! layer; this should be increased due to !! mixed layer entrainment [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. - type(optics_type), pointer :: optics !< The structure containing the inverse of the - !! vertical absorption decay scale for - !! penetrating shortwave radiation [m-1]. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(optics_type), pointer :: optics !< The structure that can be queried for the + !! inverse of the vertical absorption decay + !! scale for penetrating shortwave radiation. real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are @@ -357,7 +326,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_bulk_mixed_layer: "//& "Module must be initialized before it is used.") if (GV%nkml < 1) return @@ -455,13 +424,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) enddo ; enddo - if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_m) + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_Z) do k=1,nz ; do i=is,ie d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 enddo ; enddo - if (id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) ! Calculate an estimate of the mid-mixed layer pressure [R L2 T-2 ~> Pa] if (associated(tv%p_surf)) then do i=is,ie ; p_ref(i) = tv%p_surf(i,j) ; enddo @@ -477,27 +445,22 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, EOSdom) call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo - if (id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) if (CS%ML_resort) then - if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, & US, CS, CS%ML_presort_nz_conv_adj) call sort_ML(h, R0, eps, G, GV, CS, ksort) - if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) else do k=1,nz ; do i=is,ie ; ksort(i,k) = k ; enddo ; enddo - if (id_clock_adjustment>0) call cpu_clock_begin(id_clock_adjustment) ! Undergo instantaneous entrainment into the buffer layers and mixed layers ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo - if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) endif if (associated(fluxes%lrunoff) .and. CS%do_rivermix) then @@ -505,9 +468,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! 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*Irho0*drho_ds* + ! TKE_river[Z L2 T-3 ~> m3 s-3] = 0.5*rivermix_depth * g * Irho0**2 * drho_ds * ! River*(Samb - Sriver) = CS%mstar*U_star^3 - ! where River is in units of [m s-1]. + ! where River is in units of [R Z T-1 ~> kg m-2 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. @@ -521,15 +484,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do i=is,ie ; TKE_river(i) = 0.0 ; enddo endif - - if (id_clock_conv>0) call cpu_clock_begin(id_clock_conv) - ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes ! netMassOut = water [H ~> m or kg m-2] removed via evaporating surface fluxes ! 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] + ! net_salt = salt via surface fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -543,16 +503,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C nsw, Pen_SW_bnd, opacity_band, Conv_En, 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) - ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the ! surface is becoming lighter, and is effecti1336vely detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. - if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) - call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) @@ -570,7 +526,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (CS%TKE_diagnostics) then ; do i=is,ie CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag * TKE(i) enddo ; endif - if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) ! Calculate the homogeneous mixed layer properties and store them in layer 0. do i=is,ie ; if (htot(i) > 0.0) then @@ -600,10 +555,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! these unused layers (but not currently in the code). 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, & 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 if (CS%limit_det .or. (CS%id_Hsfc_max > 0) .or. (CS%id_Hsfc_min > 0)) then @@ -634,7 +587,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Move water left in the former mixed layer into the buffer layer and ! from the buffer layer into the interior. These steps might best be ! treated in conjuction. - if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & @@ -647,8 +599,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! This code only works with 1 or 2 buffer layers. call MOM_error(FATAL, "MOM_mixed_layer: CS%nkbl must be 1 or 2 for now.") endif - if (id_clock_detrain>0) call cpu_clock_end(id_clock_detrain) - if (CS%id_Hsfc_used > 0) then do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo @@ -826,7 +776,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment !! (perhaps CS%nkml). @@ -845,8 +795,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. - KE_orig, & ! The total mean kinetic energy in the mixed layer before - ! convection, [H L2 T-2 ~> H m2 s-2]. + KE_orig, & ! The total mean kinetic energy per unit area in the mixed layer before + ! convection, [H L2 T-2 ~> m3 s-2 or kg s-2]. h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. @@ -1003,7 +953,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -1328,7 +1278,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! kinetic energy due to convective !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step [Z m2 T-2 ~> m3 s-2]. + !! mixing over a time step [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The source of turbulent kinetic energy @@ -1343,7 +1293,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. @@ -1548,12 +1498,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step [Z m2 T-2 ~> m3 s-2]. + !! step [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct ! This subroutine calculates mechanically driven entrainment. @@ -1577,9 +1527,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & 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 - ! across the mixed layer [L2 T-2 ~> L2 s-2]. + ! across the mixed layer [L2 T-2 ~> m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [L2 T2 ~> m2 s-2]. + ! TKE, divided by layer thickness in m [L2 T-2 ~> m2 s-2]. real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean ! kinetic energy [H Z L2 T-2 ~> m4 s-2 or kg m s-2] @@ -1836,8 +1786,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) !! the layers [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. ! Local variables @@ -1906,8 +1855,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! below [H ~> m or kg m-2]. Positive values go !! with mass gain by a layer. integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this - !! module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential @@ -2222,8 +2170,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, @@ -2338,15 +2285,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: s1en ! A work variable [H2 L2 kg m-1 T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [R Z L2 T-3 ~> W m-2] real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. - real :: I_ya, b1 ! Nondimensional work variables. + real :: I_ya, b1 ! Nondimensional work variables [nondim] real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables, real :: Ihk0, Ihk1, Ih12 ! all in [H-1 ~> m-1 or m2 kg-1]. real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, real :: dR0, dR21, dRcv ! all in [R ~> kg m-3]. - real :: dRcv_stays, dRcv_det, dRcv_lim + real :: dRcv_stays, dRcv_det, dRcv_lim ! Assorted densities [R ~> kg m-3] real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. real :: h2_to_k1_lim, T_new, S_new, T_max, T_min, S_max, S_min @@ -3118,8 +3065,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! a layer. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature @@ -3386,16 +3332,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(bulkmixedlayer_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. @@ -3405,12 +3343,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - + CS%initialized = .true. CS%diag => diag CS%Time => Time @@ -3571,12 +3504,6 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "If true, use code with a bug that causes a loss of momentum conservation "//& "during mixedlayer convection.", default=.false.) - call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", & - CS%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.", & - default=.true.) - CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & @@ -3655,24 +3582,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) if (CS%id_PE_detrain2 > 0) call safe_alloc_alloc(CS%diag_PE_detrain2, isd, ied, jsd, jed) if (CS%id_ML_depth > 0) call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - if (CS%allow_clocks_in_omp_loops) then - id_clock_detrain = cpu_clock_id('(Ocean mixed layer detrain)', grain=CLOCK_ROUTINE) - id_clock_mech = cpu_clock_id('(Ocean mixed layer mechanical entrainment)', grain=CLOCK_ROUTINE) - id_clock_conv = cpu_clock_id('(Ocean mixed layer convection)', grain=CLOCK_ROUTINE) - if (CS%ML_resort) then - id_clock_resort = cpu_clock_id('(Ocean mixed layer resorting)', grain=CLOCK_ROUTINE) - else - id_clock_adjustment = cpu_clock_id('(Ocean mixed layer convective adjustment)', grain=CLOCK_ROUTINE) - endif - id_clock_EOS = cpu_clock_id('(Ocean mixed layer EOS)', grain=CLOCK_ROUTINE) - endif - if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) & - id_clock_pass = cpu_clock_id('(Ocean mixed layer halo updates)', grain=CLOCK_ROUTINE) - - -! if (CS%limit_det) then -! endif + id_clock_pass = cpu_clock_id('(Ocean mixed layer halo updates)', grain=CLOCK_ROUTINE) end subroutine bulkmixedlayer_init @@ -3708,16 +3619,15 @@ end function EF4 !! !! This file contains the subroutine (bulkmixedlayer) that !! implements a Kraus-Turner-like bulk mixed layer, based on the work -!! of various people, as described in the review paper by Niiler and -!! Kraus (1979), with particular attention to the form proposed by -!! Oberhuber (JPO, 1993, 808-829), with an extension to a refied bulk -!! mixed layer as described in Hallberg (Aha Huliko'a, 2003). The -!! physical processes portrayed in this subroutine include convective -!! adjustment and mixed layer entrainment and detrainment. -!! Penetrating shortwave radiation and an exponential decay of TKE -!! fluxes are also supported by this subroutine. Several constants +!! of various people, as described in the review paper by \cite Niiler1977, +!! with particular attention to the form proposed by \cite Oberhuber1993, +!! with an extension to a refined bulk mixed layer as described in +!! Hallberg (\cite muller2003). The physical processes portrayed in +!! this subroutine include convective adjustment and mixed layer entrainment +!! and detrainment. Penetrating shortwave radiation and an exponential decay +!! of TKE fluxes are also supported by this subroutine. Several constants !! can alternately be set to give a traditional Kraus-Turner mixed !! layer scheme, although that is not the preferred option. The -!! physical processes and arguments are described in detail below. +!! physical processes and arguments are described in detail in \ref BML. end module MOM_bulk_mixed_layer diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 8d53594ebb..13d25f06f5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -318,7 +318,7 @@ end subroutine differential_diffuse_T_S !> This subroutine keeps salinity from falling below a small but positive threshold. !! This usually occurs when the ice model attempts to extract more salt then !! is actually available to it from the ocean. -subroutine adjust_salt(h, tv, G, GV, CS, halo) +subroutine adjust_salt(h, tv, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -327,7 +327,6 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. - 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 [ppt R Z ~> gSalt m-2] @@ -336,9 +335,6 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - endif ! call cpu_clock_begin(id_clock_adjust_salt) @@ -394,7 +390,7 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. ! Local variables - real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-2 or m2 kg-1]. + real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: d1(SZIB_(G)) ! A variable used by the tridiagonal solver [nondim]. real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: h_tr, b_denom_1 ! Two temporary thicknesses [H ~> m or kg m-2]. @@ -442,7 +438,7 @@ subroutine triDiagTS_Eulerian(G, GV, is, ie, js, je, hold, ent, T, S) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. ! Local variables - real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-2 or m2 kg-1]. + real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: d1(SZIB_(G)) ! A variable used by the tridiagonal solver [nondim]. real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: h_tr, b_denom_1 ! Two temporary thicknesses [H ~> m or kg m-2]. @@ -594,7 +590,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) end subroutine find_uv_at_h -subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_flow_CSp) +subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity, tracer_flow_CSp) type(optics_type), pointer :: optics !< An optics structure that has will contain !! information about shortwave fluxes and absorption. type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -603,7 +599,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ 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(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux - type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + type(opacity_CS) :: opacity !< The control structure for the opacity module. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure !! organizing the tracer modules. @@ -633,7 +629,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_2d=chl_2d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity, chl_2d=chl_2d) else if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & "The tracer flow control structure must be associated when the model sets "//& @@ -643,11 +639,11 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_3d=chl_3d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity, chl_3d=chl_3d) endif else call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity) endif end subroutine set_pen_shortwave @@ -1024,7 +1020,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! 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]. + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 @@ -1109,7 +1105,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, 1.0e-30*GV%m_to_H) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. @@ -1164,7 +1160,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Nothing more is done on this j-slice if there is no buoyancy forcing. if (.not.associated(fluxes%sw)) cycle - if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%m_to_H)) + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%Z_to_H)) ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: @@ -1175,7 +1171,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! netMassOut < 0 means mass leaves ocean. ! netHeat = heat via surface fluxes [degC H ~> degC m or degC kg m-2], excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. - ! netSalt = surface salt fluxes [ppt H ~> dppt m or gSalt m-2] + ! netSalt = surface salt fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation split according to bands. ! This field provides that portion of SW from atmosphere that in fact ! enters to the ocean and participates in pentrative SW heating. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c9df559583..7b180f1d65 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -15,6 +15,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h, diagnoseMLDbyDensityDifference use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, diagnoseMLDbyEnergy, set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_sum_u, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids 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 @@ -23,14 +24,14 @@ module MOM_diabatic_driver use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs -use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv +use MOM_CVMix_conv, only : calculate_CVMix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init -use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS +use MOM_entrain_diffusive, only : entrain_diffusive_CS use MOM_EOS, only : calculate_density, calculate_TFreeze, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -88,12 +89,13 @@ module MOM_diabatic_driver ! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for this module -type, public:: diabatic_CS; private +type, public :: diabatic_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. - logical :: use_legacy_diabatic !< If true (default), use the a legacy version of the diabatic + logical :: use_legacy_diabatic !< If true (default), use a legacy version of the diabatic !! algorithm. This is temporary and is needed to avoid change !! in answers. - logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + logical :: use_bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary !! boundary layer scheme to determine the diffusivity @@ -220,34 +222,37 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module - type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module - type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module - type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module - type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module type(optics_type), pointer :: optics => NULL() !< Control structure for a child module type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module - type(CVMix_conv_cs), pointer :: CVMix_conv_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module + type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct + type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control struct + type(energetic_PBL_CS) :: ePBL !< Energetic PBL control struct + type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct + type(geothermal_CS) :: geothermal !< Geothermal control struct + type(int_tide_CS) :: int_tide !< Internal tide control struct + type(opacity_CS) :: opacity !< Opacity control struct + type(regularize_layers_CS) :: regularize_layers !< Regularize layer control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm ! Data arrays for communicating between components - real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] + !### Why are these arrays in this control structure, and not local variables in the various routines? + real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [nondim] + real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [nondim] real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] - real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] + real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -275,8 +280,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -285,12 +291,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & - eta ! Interface heights before diapycnal mixing [m]. + eta ! Interface heights before diapycnal mixing [Z ~> m] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn_IGW ! baroclinic internal gravity wave speeds [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: temp_diag ! Previous temperature for diagnostics [degC] @@ -325,6 +331,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "diabatic was called with a zero length timestep.") if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & @@ -340,7 +350,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -396,7 +406,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide) if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -517,8 +527,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -526,7 +537,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -597,7 +608,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_in_place(h, tv, dt, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal, 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) @@ -611,7 +622,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -630,11 +641,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, CS%set_diff_CSp, & - Kd_int=Kd_int, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) else - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_int=Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp) endif call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -643,7 +654,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -720,20 +731,20 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) + 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) + 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) @@ -741,7 +752,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -771,7 +782,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_int, Kv=visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) endif ! This block sets ent_t and ent_s from h and Kd_int. @@ -789,7 +800,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ent_s, "after calc_entrain ent_s", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -827,16 +838,15 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -885,7 +895,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G, US) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") @@ -894,7 +904,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) + call MOM_thermovar_chksum("after negative check ", tv, G, US) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) @@ -951,7 +961,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) endif ! Whenever thickness changes let the diag manager know, as the @@ -1063,7 +1073,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -1075,7 +1085,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -1103,8 +1113,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1112,7 +1123,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1183,7 +1194,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_in_place(h, tv, dt, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal, 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) @@ -1197,7 +1208,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -1216,11 +1227,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, CS%set_diff_CSp, & - Kd_int=Kd_heat, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_heat, G, GV, US, & + CS%set_diff_CSp, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) else - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_int=Kd_heat) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_heat, G, GV, US, & + CS%set_diff_CSp) endif call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1228,7 +1239,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1296,20 +1307,20 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) + 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) + 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) @@ -1317,7 +1328,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -1325,9 +1336,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection if (CS%useKPP) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_heat, Kv=visc%Kv_shear, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) else - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_heat, Kv=visc%Kv_slow, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) endif endif @@ -1364,16 +1375,15 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -1416,7 +1426,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G, US) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") @@ -1483,7 +1493,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) endif ! Whenever thickness changes let the diag manager know, as the @@ -1570,7 +1580,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -1582,7 +1592,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -1614,15 +1624,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations real, intent(in) :: dt !< time increment [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 + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & ea, & ! amount of fluid entrained from the layer above within @@ -1735,7 +1746,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_entraining(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_entraining(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal, 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) @@ -1749,9 +1760,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) if (CS%ML_mix_first > 0.0) then @@ -1768,11 +1779,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & - eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + eaml, ebml, G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & - G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) endif @@ -1820,11 +1831,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, CS%set_diff_CSp, & - Kd_lay=Kd_lay, Kd_int=Kd_int, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp, Kd_lay=Kd_lay, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) else - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_lay=Kd_lay, Kd_int=Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp, Kd_lay=Kd_lay) endif call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1832,7 +1843,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1906,7 +1917,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1915,23 +1926,23 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_int, Kv=visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) endif if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) + 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) + 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) @@ -1939,7 +1950,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -1970,14 +1981,14 @@ 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, G, GV, US, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) @@ -2028,7 +2039,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) + call MOM_thermovar_chksum("after negative check ", tv, G, US) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) @@ -2037,7 +2048,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! If using the bulk mixed layer, T and S are also updated ! by surface fluxes (in fluxes%*). ! This is a very long block. - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (associated(tv%T)) then call cpu_clock_begin(id_clock_tridiag) @@ -2156,7 +2167,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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, & + G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) ! Keep salinity from falling below a small but positive threshold. @@ -2226,13 +2237,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers_CSp) + call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers) 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) @@ -2359,7 +2370,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + if (CS%use_bulkmixedlayer .and. associated(tv%eqn_of_state)) then do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo EOSdom(:) = EOS_domain(G%HI) !$OMP parallel do default(shared) @@ -2374,7 +2385,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -2385,7 +2396,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -2408,7 +2419,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! For momentum, it is only the net flux that homogenizes within ! the mixed layer. Vertical viscosity that is proportional to the ! mixed layer turbulence is applied elsewhere. - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (CS%debug) then call hchksum(ea, "before net flux rearrangement ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "before net flux rearrangement eb", G%HI, scale=GV%H_to_m) @@ -2543,24 +2554,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - !! Diagnostics for terms multiplied by fractional thicknesses - if (CS%id_hf_dudt_dia_2d > 0) then - allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_dudt_dia_2d(I,j) = hf_dudt_dia_2d(I,j) + ADp%du_dt_dia(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dudt_dia_2d, hf_dudt_dia_2d, CS%diag) - deallocate(hf_dudt_dia_2d) - endif - - if (CS%id_hf_dvdt_dia_2d > 0) then - allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dvdt_dia_2d(i,J) = hf_dvdt_dia_2d(i,J) + ADp%dv_dt_dia(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dvdt_dia_2d, hf_dvdt_dia_2d, CS%diag) - deallocate(hf_dvdt_dia_2d) - endif + ! Diagnostics for thickness-weighted vertically averaged diapycnal accelerations + if (CS%id_hf_dudt_dia_2d > 0) & + call post_product_sum_u(CS%id_hf_dudt_dia_2d, ADp%du_dt_dia, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dvdt_dia_2d > 0) & + call post_product_sum_v(CS%id_hf_dvdt_dia_2d, ADp%dv_dt_dia, ADp%diag_hfrac_v, G, nz, CS%diag) call disable_averaging(CS%diag) @@ -2572,7 +2570,7 @@ end subroutine layered_diabatic !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth, & KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo) - type(diabatic_CS), intent(in ) :: CS !< module control structure + type(diabatic_CS), target, intent(in) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure type(optics_type), optional, pointer :: optics_CSp !< A pointer to be set to the optics control structure @@ -2588,16 +2586,16 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, !! assume thermodynamics properties are valid. ! Pointers to control structures - if (present(opacity_CSp)) opacity_CSp => CS%opacity_CSp + if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp - if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL_CSp + if (present(energetic_PBL_CSp) .and. CS%use_energetic_PBL) energetic_PBL_CSp => CS%ePBL + if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff - end subroutine extract_diabatic_member !> Routine called for adiabatic physics @@ -2957,6 +2955,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di allocate(CS) endif + CS%initialized = .true. + CS%diag => diag CS%Time => Time @@ -2966,7 +2966,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (associated(oda_incupd_CSp)) CS%oda_incupd_CSp => oda_incupd_CSp CS%useALEalgorithm = useALEalgorithm - CS%bulkmixedlayer = (GV%nkml > 0) + CS%use_bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters call log_version(param_file, mdl, version, & @@ -3007,7 +3007,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied "//& "before interior diapycnal mixing. 0 by default.", & @@ -3229,7 +3229,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Layer Thickness before diabatic forcing', & trim(thickness_units), conversion=GV%H_to_MKS, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & - 'Interface Heights before diabatic forcing', 'm') + 'Interface Heights before diabatic forcing', 'm', conversion=US%Z_to_m) if (use_temperature) then CS%id_T_predia = register_diag_field('ocean_model', 'temp_predia', diag%axesTL, Time, & 'Potential Temperature', 'degC') @@ -3250,7 +3250,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') @@ -3261,8 +3261,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%useKPP) then allocate(CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1), source=0.0) allocate(CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1), source=0.0) - endif - if (CS%useKPP) then allocate(CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1), source=0.0) allocate(CS%KPP_temp_flux(isd:ied,jsd:jed), source=0.0) allocate(CS%KPP_salt_flux(isd:ied,jsd:jed), source=0.0) @@ -3437,24 +3435,24 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise it is False. - CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv_CSp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv) - call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive_CSp, & + call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive, & just_read_params=CS%useALEalgorithm) ! initialize the geothermal heating module if (CS%use_geothermal) & - call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal_CSp, useALEalgorithm) + call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal, useALEalgorithm) ! initialize module for internal tide induced mixing if (CS%use_int_tides) then call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) - call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide_CSp) + call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide_CSp, & + call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide, & halo_TS=CS%halo_TS_diff, double_diffuse=CS%double_diffuse) if (CS%useKPP .and. (CS%double_diffuse .and. .not.CS%use_CVMix_ddiff)) & @@ -3463,7 +3461,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! set up the clocks for this module id_clock_entrain = cpu_clock_id('(Ocean diabatic entrain)', grain=CLOCK_MODULE) - if (CS%bulkmixedlayer) & + if (CS%use_bulkmixedlayer) & id_clock_mixedlayer = cpu_clock_id('(Ocean mixed layer)', grain=CLOCK_MODULE) id_clock_remap = cpu_clock_id('(Ocean vert remap)', grain=CLOCK_MODULE) if (CS%use_geothermal) & @@ -3485,12 +3483,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%useALEalgorithm, CS%use_energetic_PBL) ! initialize the boundary layer modules - if (CS%bulkmixedlayer) & - call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer_CSp) + if (CS%use_bulkmixedlayer) & + call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & - call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL_CSp) + call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%ePBL) - call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) + call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers) if (CS%debug_energy_req) & call diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS%diapyc_en_rec_CSp) @@ -3500,7 +3498,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity, CS%optics) endif endif @@ -3515,17 +3513,15 @@ subroutine diabatic_driver_end(CS) type(diabatic_CS), intent(inout) :: CS !< module control structure if (associated(CS%optics)) then - call opacity_end(CS%opacity_CSp, CS%optics) + call opacity_end(CS%opacity, CS%optics) deallocate(CS%optics) endif if (CS%debug_energy_req) & call diapyc_energy_req_end(CS%diapyc_en_rec_CSp) - deallocate(CS%regularize_layers_CSp) - if (CS%use_energetic_PBL) & - call energetic_PBL_end(CS%energetic_PBL_CSp) + call energetic_PBL_end(CS%ePBL) call diabatic_aux_end(CS%diabatic_aux_CSp) @@ -3533,14 +3529,8 @@ subroutine diabatic_driver_end(CS) deallocate(CS%set_diff_CSp) - if (CS%use_geothermal) then - call geothermal_end(CS%geothermal_CSp) - deallocate(CS%geothermal_CSp) - endif - - call entrain_diffusive_end(CS%entrain_diffusive_CSp) - - if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) + if (CS%use_geothermal) & + call geothermal_end(CS%geothermal) if (CS%useKPP) then deallocate( CS%KPP_buoy_flux ) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 23a73cb43e..379275196e 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -68,7 +68,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot - real :: energy_Kd ! The energy used by diapycnal mixing [W m-2]. + real :: energy_Kd ! The energy used by diapycnal mixing [R Z L2 T-3 ~> W m-2]. real :: tmp1 ! A temporary array. integer :: i, j, k, is, ie, js, je, nz, itt logical :: may_print @@ -77,6 +77,9 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) if (.not. associated(CS)) call MOM_error(FATAL, "diapyc_energy_req_test: "// & "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "diapyc_energy_req_test: "// & + "Module must be initialized before it is used.") + !$OMP do do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then @@ -196,8 +199,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! ensure positive definiteness [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & pres, & ! Interface pressures [R L2 T-2 ~> Pa]. - pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [R L2 T-2 m Z-1 ~> J m-3]. + pres_Z, & ! The hydrostatic interface pressure, which is used to relate + ! the changes in column thickness to the energy that is radiated + ! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. N2, & ! An estimate of the buoyancy frequency [T-2 ~> s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the @@ -1011,7 +1015,7 @@ 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 [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing [R L2 T-2 m Z-1 ~> J m-3]. + !! as gravity waves and unavailable to drive mixing [R L2 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 @@ -1192,13 +1196,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. - real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-1]. - real :: dT_k, dT_km1 ! Temporary arrays [degC]. - real :: dS_k, dS_km1 ! Temporary arrays [ppt]. - real :: I_Kr_denom ! Temporary arrays [H-2 ~> m-2 or m4 kg-2]. - real :: dKr_dKd ! Nondimensional temporary array [nondim]. - real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1]. - real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1]. + real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1] + real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] + real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] + real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] + real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2] + real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes + ! per unit change in Kddt_h [degC H-1 ~> degC m-1 or degC m2 kg-1] + real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes + ! per unit change in Kddt_h [ppt H-1 ~> ppt m-1 or ppt m2 kg-1] b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 351f55984f..99dd38135d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -33,6 +33,7 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. !/ Constants real :: VonKar = 0.41 !< The von Karman coefficient. This should be a runtime parameter, @@ -235,8 +236,6 @@ module MOM_energetic_PBL real :: LAmod !< The modified Langmuir number by convection [nondim] real :: mstar !< The value of mstar used in ePBL [nondim] real :: mstar_LT !< The portion of mstar due to Langmuir turbulence [nondim] - real, allocatable, dimension(:) :: dT_expect !< Expected temperature changes [degC] - real, allocatable, dimension(:) :: dS_expect !< Expected salinity changes [ppt] end type ePBL_column_diags contains @@ -245,9 +244,8 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, & - last_call, dT_expected, dS_expected, Waves) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & + stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -279,27 +277,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 s-1 ~> m2 s-1]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to mixedlayer_init. + !! [Z2 T-1 ~> m2 s-1]. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - logical, optional, intent(in) :: last_call !< If true, this is the last call to - !! mixedlayer in the current time step, so - !! diagnostics will be written. The default - !! is .true. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dT_expected !< The values of temperature change that - !! should be expected when the returned - !! diffusivities are applied [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dS_expected !< The values of salinity change that - !! should be expected when the returned - !! diffusivities are applied [ppt]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous ! This subroutine determines the diffusivities from the integrated energetics @@ -358,58 +340,41 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]. -! The following are only used for diagnostics. - real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s]. - logical :: write_diags ! If true, write out diagnostics with this step. - logical :: reset_diags ! If true, zero out the accumulated diagnostics. - - logical :: debug=.false. ! Change this hard-coded value for debugging. type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") - if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & "energetic_PBL: Temperature, salinity and an equation of state "//& "must now be used.") if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & - "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!") - debug = .false. ; if (present(dT_expected) .or. present(dS_expected)) debug = .true. + "energetic_PBL: No surface TKE fluxes (ustar) defined in fluxes type!") + if (CS%use_LT .and. .not.associated(Waves)) call MOM_error(FATAL, & + "energetic_PBL: The Waves control structure must be associated if CS%use_LT "//& + "(i.e., USE_LA_LI2016 or EPBL_LT) is True.") - if (debug) allocate(eCD%dT_expect(nz), eCD%dS_expect(nz)) h_neglect = GV%H_subroundoff - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - write_diags = .true. ; if (present(last_call)) write_diags = last_call - - - ! Determine whether to zero out diagnostics before accumulation. - reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & - reset_diags = .false. ! This is the second call to mixedlayer. - - if (reset_diags) then - if (CS%TKE_diagnostics) then + ! Zero out diagnostics before accumulation. + if (CS%TKE_diagnostics) then !!OMP parallel do default(none) shared(is,ie,js,je,CS) - do j=js,je ; do i=is,ie - CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 - CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 - CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 - CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 - enddo ; enddo - endif + do j=js,je ; do i=is,ie + CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 + CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 + CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 + CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 + enddo ; enddo endif ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0 ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0 !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,debug, & -!!OMP TKE_forced,dSV_dT,dSV_dS,Kd_int) +!!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie @@ -457,16 +422,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) + if (stoch_CS%pert_epbl) then ! stochastics are active call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j), & - i=i, j=j) + US, CS, eCD, Waves, G, i, j, & + epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j)) else call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + US, CS, eCD, Waves, G, i, j) endif ! Copy the diffusivities to a 2-d array. @@ -475,13 +440,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo CS%ML_depth(i,j) = MLD_io - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = eCD%dT_expect(k) ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = eCD%dS_expect(k) ; enddo - endif - if (CS%TKE_diagnostics) then CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + eCD%dTKE_MKE CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + eCD%dTKE_conv @@ -507,47 +465,33 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! For masked points, Kd_int must still be set (to 0) because it has intent out. do K=1,nz+1 ; Kd_2d(i,K) = 0. ; enddo CS%ML_depth(i,j) = 0.0 - - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo - endif endif ; enddo ! Close of i-loop - Note unusual loop order! do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo enddo ! j-loop - if (write_diags) then - if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) - ! only write random patterns if running with stochastic physics, otherwise the - ! array is unallocated and will give an error - if (stoch_CS%pert_epbl) then - if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) - if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) - endif + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + if (stoch_CS%pert_epbl) then + if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) + if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) endif - - if (debug) deallocate(eCD%dT_expect, eCD%dS_expect) - end subroutine energetic_PBL @@ -556,7 +500,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, epbl1_wt, epbl2_wt, i, j) + Waves, G, i, j, epbl1_wt, epbl2_wt) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -591,19 +535,14 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !! [Z T-1 ~> m s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to mixedlayer_init. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS for Langmuir turbulence - type(ocean_grid_type), & - optional, intent(inout) :: G !< The ocean's grid structure. + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, optional, intent(in) :: epbl1_wt !< random number to perturb KE generation real, optional, intent(in) :: epbl2_wt !< random number to perturb KE dissipation - integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) - integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + integer, intent(in) :: i !< The i-index to work on (used for Waves) + integer, intent(in) :: j !< The i-index to work on (used for Waves) ! This subroutine determines the diffusivities in a single column from the integrated energetics ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes @@ -692,7 +631,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor [H T m-2 ~> s m-1 or kg s m-4]. + ! a layer, times a thickness conversion factor [H T Z-2 ~> s m-1 or kg s m-4]. real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. real :: h_rsum ! The running sum of h from the top [Z ~> m]. real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. @@ -712,7 +651,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: LA ! The value of the Langmuir number [nondim] real :: LAmod ! The modified Langmuir number by convection [nondim] real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. + ! conversion factor from H to Z [Z H-1 ~> nondim or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing [nondim]. between 0 and 1. @@ -761,8 +700,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 ~> s]. - real :: I_dtdiag ! = 1.0 / dt__diag [T-1 ~> s-1]. + real :: I_dtdiag ! = 1.0 / dt [T-1 ~> s-1]. !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth @@ -788,31 +726,28 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs integer :: OBL_it ! Iteration counter real :: Surface_Scale ! Surface decay scale for vstar - logical :: calc_dT_expect ! If true calculate the expected changes in temperature and salinity. - logical :: calc_Te ! If true calculate the expected final temperature and salinity values. - logical :: debug=.false. ! Change this hard-coded value for debugging. + logical :: calc_Te ! If true calculate the expected final temperature and salinity values. + logical :: debug ! This is used as a hard-coded value for debugging. ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k + real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [degC] + real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [ppt] integer, dimension(SZK_(GV)) :: num_itts integer :: k, nz, itt, max_itt nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& - "Module must be initialized before it is used.") - - calc_dT_expect = debug ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) calc_dT_expect = .true. - calc_Te = (calc_dT_expect .or. (.not.CS%orig_PE_calc)) + debug = .false. ! Change this hard-coded value for debugging. + calc_Te = (debug .or. (.not.CS%orig_PE_calc)) h_neglect = GV%H_subroundoff C1_3 = 1.0 / 3.0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - I_dtdiag = 1.0 / dt__diag + I_dtdiag = 1.0 / dt max_itt = 20 h_tt_min = 0.0 @@ -881,8 +816,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=h, U_H=u, V_H=v, Waves=Waves) + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, h, Waves, & + U_H=u, V_H=v) call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& mstar_LT=mstar_LT) @@ -981,11 +916,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) else - mech_TKE = mech_TKE * exp_kh + mech_TKE = mech_TKE * exp_kh endif - !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. @@ -1052,7 +986,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) ! This tests whether the layers above and below this interface are in - ! a convetively stable configuration, without considering any effects of + ! a convectively stable configuration, without considering any effects of ! mixing at higher interfaces. It is an approximation to the more ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of ! mixing across interface K-1. The dT_to_dColHt here are effectively @@ -1418,16 +1352,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs enddo Kd(nz+1) = 0.0 - if (calc_dT_expect) then + if (debug) then ! Complete the tridiagonal solve for Te. b1 = 1.0 / hp_a Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) + dT_expect(nz) = Te(nz) - T0(nz) ; dS_expect(nz) = Se(nz) - S0(nz) do k=nz-1,1,-1 Te(k) = Te(k) + c1(K+1)*Te(k+1) Se(k) = Se(k) + c1(K+1)*Se(k+1) - eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) + dT_expect(k) = Te(k) - T0(k) ; dS_expect(k) = Se(k) - S0(k) enddo endif @@ -1560,8 +1494,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! height, including all implicit diffusive changes !! 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 [R Z3 T-2 ~> J m-2]. + real, intent(out) :: PE_chg !< The change in column potential energy from applying + !! 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 !! [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 @@ -1572,6 +1506,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: 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]. + ! Local variables 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]. @@ -1601,18 +1536,14 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & ColHt_core = hp_b * (dT_to_dColHt_a * dT_c + dS_to_dColHt_a * dS_c) - & hp_a * (dT_to_dColHt_b * dT_c + dS_to_dColHt_b * dS_c) - if (present(PE_chg)) then - ! Find the change in column potential energy due to the change in the - ! diffusivity at this interface by dKddt_h. - y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_chg = PEc_core * y1_3 - ColHt_chg = ColHt_core * y1_3 - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg - if (present(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)) - PE_ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) - endif + ! Find the change in column potential energy due to the change in the + ! diffusivity at this interface by dKddt_h. + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + PE_chg = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg + + if (present(PE_ColHt_cor)) PE_ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) if (present(dPEc_dKd)) then ! Find the derivative of the potential energy change with dKddt_h. @@ -1646,8 +1577,8 @@ end subroutine find_PE_chg subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, & dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, & - dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, & - PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) + dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, PE_chg, & + dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The 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]. @@ -1700,8 +1631,8 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! height, including all implicit diffusive changes !! 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 [R Z3 T-2 ~> J m-2]. + real, intent(out) :: PE_chg !< The change in column potential energy from applying + !! 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 !! [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 @@ -1719,17 +1650,20 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! this routine can also be used for an upward pass with the sense of direction ! reversed. + ! Local variables real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. - real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-2]. - real :: dT_k, dT_km1 ! Temporary arrays [degC]. - real :: dS_k, dS_km1 ! Temporary arrays [ppt]. + real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1] + real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] + real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] - real :: dKr_dKd ! Nondimensional temporary array. - real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1]. - real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1]. + real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2] + real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes + ! per unit change in Kddt_h [degC H-1 ~> degC m-1 or degC m2 kg-1] + real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes + ! per unit change in Kddt_h [ppt H-1 ~> ppt m-1 or ppt m2 kg-1] b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 @@ -1744,17 +1678,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dT_k = (Kddt_h*I_Kr_denom) * dTe_term dS_k = (Kddt_h*I_Kr_denom) * dSe_term - if (present(PE_chg)) then - ! Find the change in energy due to diffusion with strength Kddt_h at this interface. - ! Increment the temperature changes in layer k-1 due the changes in layer k. - dT_km1 = b1Kd * ( dT_k + dT_km1_t2 ) - dS_km1 = b1Kd * ( dS_k + dS_km1_t2 ) - PE_chg = (dT_to_dPE_k * dT_k + dT_to_dPEa * dT_km1) + & - (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1) - ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + & - (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1) - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg - endif + ! Find the change in energy due to diffusion with strength Kddt_h at this interface. + ! Increment the temperature changes in layer k-1 due the changes in layer k. + dT_km1 = b1Kd * ( dT_k + dT_km1_t2 ) + dS_km1 = b1Kd * ( dS_k + dS_km1_t2 ) + PE_chg = (dT_to_dPE_k * dT_k + dT_to_dPEa * dT_km1) + & + (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1) + ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + & + (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1) + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg if (present(dPEc_dKd)) then ! Find the derivatives of the temperature and salinity changes with Kddt_h. @@ -1799,7 +1731,7 @@ end subroutine find_PE_chg_orig subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& MStar_LT, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1] real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1] @@ -1885,7 +1817,7 @@ end subroutine Find_Mstar !> This subroutine modifies the Mstar value if the Langmuir number is present subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, & Mstar, MStar_LT, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1] real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] @@ -1971,7 +1903,7 @@ end subroutine Mstar_Langmuir !> Copies the ePBL active mixed layer depth into MLD, in units of [Z ~> m] unless other units are specified. subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) - type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control struct type(ocean_grid_type), intent(in) :: G !< Grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m] or other units @@ -1998,8 +1930,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output - type(energetic_PBL_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct + ! Local variables ! This include declares and sets the variable "version". # include "version_variable.h" @@ -2013,12 +1945,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"//& - "associated control structure.") - return - else ; allocate(CS) ; endif - + CS%initialized = .true. CS%diag => diag CS%Time => Time @@ -2101,7 +2028,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& - "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the stabilizing limit, as in OM4 \n"//& "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & default=CONSTANT_STRING) tmpstr = uppercase(tmpstr) @@ -2203,7 +2130,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "If true, use bisection with the iterative determination of the self-consistent "//& "mixed layer depth. Otherwise use the false position after a maximum and minimum "//& "bound have been evaluated and the returned value or bisection before this.", & - default=.true., do_not_log=.not.CS%Use_MLD_iteration) !### The default should become false. + default=.false., do_not_log=.not.CS%Use_MLD_iteration) call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", CS%max_MLD_its, & "The maximum number of iterations that can be used to find a self-consistent "//& "mixed layer depth. If EPBL_MLD_BISECTION is true, the maximum number "//& @@ -2277,13 +2204,13 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "determine the Langmuir number.", units="nondim", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. if (use_LA_windsea) then - CS%USE_LT = .true. + CS%use_LT = .true. else - call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & + call get_param(param_file, mdl, "EPBL_LT", CS%use_LT, & "A logical to use a LT parameterization.", & units="nondim", default=.false.) endif - if (CS%USE_LT) then + if (CS%use_LT) then call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& "Valid values are: \n"//& @@ -2440,14 +2367,11 @@ end subroutine energetic_PBL_init !> Clean up and deallocate memory associated with the energetic_PBL module. subroutine energetic_PBL_end(CS) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure that - !! will be deallocated in this subroutine. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic_PBL control struct character(len=256) :: mesg real :: avg_its - if (.not.associated(CS)) return - if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) if (allocated(CS%LA)) deallocate(CS%LA) if (allocated(CS%LA_MOD)) deallocate(CS%LA_MOD) @@ -2470,9 +2394,6 @@ subroutine energetic_PBL_end(CS) write (mesg,*) "Average ePBL iterations = ", avg_its call MOM_mesg(mesg) endif - - deallocate(CS) - end subroutine energetic_PBL_end !> \namespace MOM_energetic_PBL @@ -2489,10 +2410,10 @@ end subroutine energetic_PBL_end !! simple enough that it requires only a single vertical pass to !! determine the diffusivity. The development of bulk mixed layer !! models stems from the work of various people, as described in the -!! review paper by Niiler and Kraus (1979). The work here draws in -!! with particular on the form for TKE decay proposed by Oberhuber -!! (JPO, 1993, 808-829), with an extension to a refined bulk mixed -!! layer as described in Hallberg (Aha Huliko'a, 2003). The physical +!! review paper by \cite niiler1977. The work here draws in +!! with particular on the form for TKE decay proposed by +!! \cite oberhuber1993, with an extension to a refined bulk mixed +!! layer as described in Hallberg (\cite muller2003). The physical !! processes portrayed in this subroutine include convectively driven !! mixing and mechanically driven mixing. Unlike boundary-layer !! mixing, stratified shear mixing is not a one-directional turbulent diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 32cdce4d2a..fdc38ebf1e 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -18,7 +18,7 @@ module MOM_entrain_diffusive #include -public entrainment_diffusive, entrain_diffusive_init, entrain_diffusive_end +public entrainment_diffusive, entrain_diffusive_init ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -27,6 +27,7 @@ module MOM_entrain_diffusive !> The control structure holding parametes for the MOM_entrain_diffusive module type, public :: entrain_diffusive_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! GV%nk_rho_varies variable density mixed & buffer layers. integer :: max_ent_it !< The maximum number of iterations that may be used to @@ -60,7 +61,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. real, intent(in) :: dt !< The time increment [T ~> s]. - type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous + type(entrain_diffusive_CS), intent(in) :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: ea !< The amount of fluid entrained from the layer @@ -170,7 +171,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface [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]. + ! [Z3 H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -184,7 +185,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: F_cor ! A correction to the amount of F that is used to ! entrain from the layer above [H ~> m or kg m-2]. - real :: Kd_here ! The effective diapycnal diffusivity [H2 s-1 ~> m2 s-1 or kg2 m-4 s-1]. + real :: Kd_here ! The effective diapycnal diffusivity times the timestep [H2 ~> m2 or kg2 m-4]. real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. real :: Rho_cor ! The depth-integrated potential density anomaly that @@ -207,7 +208,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff - if (.not. associated(CS)) call MOM_error(FATAL, & + if (.not. CS%initialized) call MOM_error(FATAL, & "MOM_entrain_diffusive: Module must be initialized before it is used.") if (.not.(present(Kd_Lay) .or. present(Kd_int))) call MOM_error(FATAL, & @@ -1022,7 +1023,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which !! i-points to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< The meridional index upon which to work. real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Ent_bl !< The average entrainment upward and @@ -1440,7 +1441,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & !! uppermost interior layer [H ~> m or kg m-2] integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: i !< The i-index to work on - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: ea_kb !< The entrainment from above by the layer below !! the buffer layer (i.e. layer kb) [H ~> m or kg m-2]. real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination @@ -1582,7 +1583,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & integer, intent(in) :: ie !< The end of the i-index range to work on. logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which !! i-points to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost !! interior layer [H ~> m or kg m-2]. !! The input value is the first guess. @@ -1786,7 +1787,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F !! = ent*ds_kb*I_dSkbp1 found in the range !! min_ent < ent < max_ent [H ~> m or kg m-2]. @@ -2067,8 +2068,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(entrain_diffusive_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure. + type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control struct logical, intent(in) :: just_read_params !< If true, this call will only read !! and log parameters without registering !! any diagnostics @@ -2080,13 +2080,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re # include "version_variable.h" character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - + CS%initialized = .true. CS%diag => diag CS%bulkmixedlayer = (GV%nkml > 0) @@ -2115,20 +2109,8 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re 'Work actually done by diapycnal diffusion across each interface', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) endif - - if (just_read_params) deallocate(CS) - end subroutine entrain_diffusive_init -!> This subroutine cleans up and deallocates any memory associated with the -!! entrain_diffusive module. -subroutine entrain_diffusive_end(CS) - type(entrain_diffusive_CS), pointer :: CS !< A pointer to the control structure for this - !! module that will be deallocated. - if (associated(CS)) deallocate(CS) - -end subroutine entrain_diffusive_end - !> \namespace mom_entrain_diffusive !! !! By Robert Hallberg, September 1997 - July 2000 diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index ceb77b52b8..8ddd256ac7 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -18,8 +18,7 @@ module MOM_full_convection contains !> Calculate new temperatures and salinities that have been subject to full convective mixing. -subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & - Kddt_convect, halo) +subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, halo) 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 @@ -34,9 +33,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. - real, optional, intent(in) :: Kddt_convect !< A large convecting vertical - !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. - integer, optional, intent(in) :: halo !< Halo width over which to compute + integer, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -46,61 +43,53 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, ! in roundoff and can be neglected [H ~> m or kg m-2]. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & - Te_a, & ! A partially updated temperature estimate including the influnce from + Te_a, & ! A partially updated temperature estimate including the influence from ! mixing with layers above rescaled by a factor of d_a [degC]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. - Se_a ! A partially updated salinity estimate including the influnce from + Se_a ! A partially updated salinity estimate including the influence from ! mixing with layers above rescaled by a factor of d_a [ppt]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. real, dimension(SZI_(G),SZK_(GV)+1) :: & - Te_b, & ! A partially updated temperature estimate including the influnce from + Te_b, & ! A partially updated temperature estimate including the influence from ! mixing with layers below rescaled by a factor of d_b [degC]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. - Se_b ! A partially updated salinity estimate including the influnce from + Se_b ! A partially updated salinity estimate including the influence from ! mixing with layers below rescaled by a factor of d_b [ppt]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. real, dimension(SZI_(G),SZK_(GV)+1) :: & c_a, & ! The fractional influence of the properties of the layer below - ! in the final properies with a downward-first solver, nondim. + ! in the final properties with a downward-first solver [nondim] d_a, & ! The fractional influence of the properties of the layer in question - ! and layers above in the final properies with a downward-first solver, nondim. + ! and layers above in the final properties with a downward-first solver [nondim] ! d_a = 1.0 - c_a c_b, & ! The fractional influence of the properties of the layer above - ! in the final properies with a upward-first solver, nondim. + ! in the final properties with a upward-first solver [nondim] d_b ! The fractional influence of the properties of the layer in question - ! and layers below in the final properies with a upward-first solver, nondim. + ! and layers below in the final properties with a upward-first solver [nondim] ! d_b = 1.0 - c_b real, dimension(SZI_(G),SZK_(GV)+1) :: & mix !< The amount of mixing across the interface between layers [H ~> m or kg m-2]. real :: mix_len ! The length-scale of mixing, when it is active [H ~> m or kg m-2] - real :: h_b, h_a ! The thicknessses of the layers above and below an interface [H ~> m or kg m-2] + real :: h_b, h_a ! The thicknesses of the layers above and below an interface [H ~> m or kg m-2] real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. - logical, dimension(SZI_(G)) :: do_i ! Do more work on this column. logical, dimension(SZI_(G)) :: last_down ! The last setup pass was downward. integer, dimension(SZI_(G)) :: change_ct ! The number of interfaces where the ! mixing has changed this iteration. - integer :: changed_col ! The number of colums whose mixing changed. + integer :: changed_col ! The number of columns whose mixing changed. integer :: i, j, k, is, ie, js, je, nz, itt - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - else - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - endif + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = GV%ke if (.not.associated(tv%eqn_of_state)) return h_neglect = GV%H_subroundoff - kap_dt_x2 = 0.0 - if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect @@ -135,7 +124,6 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, Te_a(i,k-2), Te_b(i,k+1), Se_a(i,k-2), Se_b(i,k+1), & d_a(i,K-1), d_b(i,K+1))) then mix(i,K) = mix_len - if (kap_dt_x2 > 0.0) mix(i,K) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0) change_ct(i) = change_ct(i) + 1 endif endif @@ -178,7 +166,6 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, Te_a(i,k-2), Te_b(i,k+1), Se_a(i,k-2), Se_b(i,k+1), & d_a(i,K-1), d_b(i,K+1))) then mix(i,K) = mix_len - if (kap_dt_x2 > 0.0) mix(i,K) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0) change_ct(i) = change_ct(i) + 1 endif endif @@ -260,7 +247,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, k = 1 ! A hook for debugging. - ! The following set of expressions for the final values are derived from the the partial + ! The following set of expressions for the final values are derived from the partial ! updates for the estimated temperatures and salinities around an interface, then directly ! solving for the final temperatures and salinities. They are here for later reference ! and to document an intermediate step in the stability calculation. @@ -332,17 +319,18 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h !! potential density with temperature [R degC-1 ~> kg m-3 degC-1] real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dR_dS !< Derivative of locally referenced - !! potential density with salinity [R degC-1 ~> kg m-3 ppt-1] + !! potential density with salinity [R ppt-1 ~> kg m-3 ppt-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-point to work on. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa]. - integer, optional, intent(in) :: halo !< Halo width over which to compute + integer, intent(in) :: halo !< Halo width over which to compute ! Local variables real :: mix(SZI_(G),SZK_(GV)+1) ! The diffusive mixing length (kappa*dt)/dz ! between layers within in a timestep [H ~> m or kg m-2]. - real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. + real :: b1(SZI_(G)) ! A tridiagonal solver variable [H-1 ~> m-1 or m2 kg-1] + real :: d1(SZI_(G)) ! A tridiagonal solver variable [nondim] + real :: c1(SZI_(G),SZK_(GV)) ! A tridiagonal solver variable [nondim] real :: T_f(SZI_(G),SZK_(GV)) ! Filtered temperatures [degC] real :: S_f(SZI_(G),SZK_(GV)) ! Filtered salinities [ppt] real :: pres(SZI_(G)) ! Interface pressures [R L2 T-2 ~> Pa]. @@ -352,14 +340,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, ! [H ~> m or kg m-2]. real :: h_tr ! The thickness at tracer points, plus h_neglect [H ~> m or kg m-2]. - integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo - else - is = G%isc ; ie = G%iec - endif + is = G%isc-halo ; ie = G%iec+halo nz = GV%ke h_neglect = GV%H_subroundoff diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 7944d4b89f..9884eec7a2 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -23,10 +23,11 @@ module MOM_geothermal !> Control structure for geothermal heating type, public :: geothermal_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is negative) the !! water is heated in place instead of moving upward between !! layers in non-ALE layered mode [R degC-1 ~> kg m-3 degC-1] - real, allocatable, dimension(:,:) :: geo_heat !< The geothermal heat flux [J m-2 T-1 ~> W m-2] + real, allocatable, dimension(:,:) :: geo_heat !< The geothermal heat flux [Q R Z T-1 ~> W m-2] real :: geothermal_thick !< The thickness over which geothermal heating is !! applied [H ~> m or kg m-2] logical :: apply_geothermal !< If true, geothermal heating will be applied. This is false if @@ -65,7 +66,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) !! 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 + type(geothermal_CS), intent(in) :: CS !< The control structure returned by !! a previous call to !! geothermal_init. integer, optional, intent(in) :: halo !< Halo width over which to work @@ -119,7 +120,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") if (.not.CS%apply_geothermal) return @@ -367,8 +368,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) !! to any available thermodynamic fields. real, intent(in) :: dt !< Time increment [T ~> s]. 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. + type(geothermal_CS), intent(in) :: CS !< Geothermal heating control struct integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables @@ -395,7 +395,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") if (.not.CS%apply_geothermal) return @@ -497,8 +497,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. - type(geothermal_CS), pointer :: CS !< Pointer pointing to the module control - !! structure. + type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control struct logical, optional, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping ! This include declares and sets the variable "version". @@ -508,16 +507,11 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith ! Local variables character(len=200) :: inputdir, geo_file, filename, geotherm_var real :: geo_scale ! A constant heat flux or dimensionally rescaled geothermal flux scaling factor - ! [Q R Z T-1 ~> W m-2] or [Q R Z m2 s J-1 T-1 ~> 1] + ! [Q R Z T-1 ~> W m-2] or [Q R Z m2 s J-1 T-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed, id isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "geothermal_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - + CS%initialized = .true. CS%diag => diag CS%Time => Time @@ -587,20 +581,19 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & 'degC s-1', conversion=US%s_to_T, v_extensive=.true.) - if (present(useALEalgorithm)) then ; if (.not.useALEalgorithm) then + if (.not.useALEalgorithm) then ! Do not offer this diagnostic if heating will be in place. CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & trim(thickness_units)//' s-1', conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) - endif ; endif + endif end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. subroutine geothermal_end(CS) - type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control structure that - !! will be deallocated in this subroutine. + type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control struct if (allocated(CS%geo_heat)) deallocate(CS%geo_heat) end subroutine geothermal_end diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index df24d3f4e9..300cdcbe1e 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -34,6 +34,7 @@ module MOM_int_tide_input !> This control structure holds parameters that regulate internal tide energy inputs. type, public :: int_tide_input_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: debug !< If true, write verbose checksums for debugging. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -111,6 +112,9 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"set_diffusivity: "//& + "Module must be initialized before it is used.") + use_EOS = associated(tv%eqn_of_state) ! Smooth the properties through massless layers. @@ -330,6 +334,8 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) allocate(CS) allocate(itide) + CS%initialized = .true. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 033f717091..a44a7aee95 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -107,7 +107,7 @@ module MOM_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in tracer columns subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, US, CS, initialize_all) + kv_io, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -137,8 +137,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. - logical, optional, intent(in) :: initialize_all !< If present and false, the previous - !! value of kappa is used to start the iterations ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & @@ -168,8 +166,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real :: dz_massless ! A layer thickness that is considered massless [Z ~> m]. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. - logical :: new_kappa = .true. ! If true, ignore the value of kappa from the - ! last call to this subroutine. integer, dimension(SZK_(GV)+1) :: kc ! The index map between the original ! interfaces and the interfaces with massless layers @@ -180,14 +176,13 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke - use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. - new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all + use_temperature = associated(tv%T) k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) - !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, & - !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) + !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,tv,G,GV,US, & + !$OMP CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie h_2d(i,k) = h(i,j,k)*GV%H_to_Z @@ -198,9 +193,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ; enddo ; else ; do k=1,nz ; do i=is,ie rho_2d(i,k) = GV%Rlay(k) ! Could be tv%Rho(i,j,k) ? enddo ; enddo ; endif - if (.not.new_kappa) then ; do K=1,nz+1 ; do i=is,ie - kappa_2d(i,K) = kappa_io(i,j,K) - enddo ; enddo ; endif !--------------------------------------- ! Work on each column. @@ -278,11 +270,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo - else - do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo - endif + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -340,7 +328,7 @@ end subroutine Calculate_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in corner columns subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, US, CS, initialize_all) + kv_io, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -373,8 +361,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. - logical, optional, intent(in) :: initialize_all !< If present and false, the previous - !! value of kappa is used to start the iterations ! Local variables real, dimension(SZIB_(G),SZK_(GV)) :: & @@ -397,7 +383,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. + real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [R L2 T-2 ~> Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -407,8 +393,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real :: I_Prandtl ! The inverse of the turbulent Prandtl number [nondim]. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. - logical :: new_kappa = .true. ! If true, ignore the value of kappa from the - ! last call to this subroutine. logical :: do_i ! If true, work on this column. integer, dimension(SZK_(GV)+1) :: kc ! The index map between the original @@ -421,15 +405,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Diagnostics that should be deleted? isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke - use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. - new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all + use_temperature = associated(tv%T) k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb - !$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,new_kappa, & - !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io,I_Prandtl) + !$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,tv,G,GV, & + !$OMP US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io,I_Prandtl) do J=JsB,JeB J2 = mod(J,2)+1 ; J2m1 = 3-J2 ! = mod(J-1,2)+1 @@ -467,9 +450,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif - if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl - enddo ; enddo ; endif !--------------------------------------- ! Work on each column. @@ -558,11 +538,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo - else - do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo - endif + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -621,9 +597,8 @@ end subroutine Calc_kappa_shear_vertex !> This subroutine calculates shear-driven diffusivity and TKE in a single column -subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & - dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & + u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, tke_avg, tv, CS, GV, US) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZK_(GV)+1), & intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. @@ -654,11 +629,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZK_(GV)+1), & - optional, intent(out) :: I_Ld2_1d !< The inverse of the squared mixing length [Z-2 ~> m-2]. - real, dimension(SZK_(GV)+1), & - optional, intent(out) :: dz_Int_1d !< The extent of a finite-volume space surrounding an interface, - !! as used in calculating kappa and TKE [Z ~> m]. ! Local variables real, dimension(nzc) :: & @@ -858,9 +828,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! enddo ! This call just calculates N2 and S2. - call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u, v, T, Sal, GV, US, & - N2=N2, S2=S2, vel_underflow=CS%vel_underflow) + call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, & + CS%vel_underflow, u, v, T, Sal, N2, S2, GV, US) ! ---------------------------------------------------- ! Iterate ! ---------------------------------------------------- @@ -923,9 +892,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! value of max_KS_it may be unimportant, especially if it is large ! enough. call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & - vel_underflow=CS%vel_underflow) + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, & + T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) valid_dt = .true. Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -956,9 +924,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if ((dt_test < dt_rem) .and. valid_dt) then dt_inc = 0.5*dt_test do itt_dt=1,dt_refinements - call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), & - nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) + call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), nzc, dz, & + I_dz_int, dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, T_test, S_test, & + N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -1006,9 +974,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & else ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & - vel_underflow=CS%vel_underflow) + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, & + T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) @@ -1026,9 +993,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & - vel_underflow=CS%vel_underflow) + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, & + T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) @@ -1050,9 +1016,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (dt_rem > 0.0) then ! Update the values of u, v, T, Sal, N2, and S2 for the next iteration. ! call cpu_clock_begin(id_clock_project) - call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, u, v, T, Sal, & - GV, US, N2, S2, vel_underflow=CS%vel_underflow) + call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u, v, T, Sal, N2, S2, & + GV, US) ! call cpu_clock_end(id_clock_project) endif @@ -1060,25 +1026,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo ! end itt loop - if (present(I_Ld2_1d)) then - do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo - do K=2,nzc ; if (TKE(K) > 0.0) & - I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) / TKE(K) - enddo - endif - if (present(dz_Int_1d)) then - do K=1,nzc+1 ; dz_Int_1d(K) = dz_Int(K) ; enddo - do K=nzc+2,GV%ke ; dz_Int_1d(K) = 0.0 ; enddo - endif - end subroutine kappa_shear_column !> This subroutine calculates the velocities, temperature and salinity that !! the water column will have after mixing for dt with diffusivities kappa. It !! may also calculate the projected buoyancy frequency and shear. -subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, GV, US, N2, S2, ks_int, ke_int, vel_underflow) +subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int, dbuoy_dT, dbuoy_dS, & + vel_under, u, v, T, Sal, N2, S2, GV, US, ks_int, ke_int) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, @@ -1087,6 +1041,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & 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, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. @@ -1094,36 +1049,30 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! temperature [Z T-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. - real, intent(in) :: dt !< The time step [T ~> s]. + real, intent(in) :: vel_under !< Any velocities that are smaller in magnitude + !! than this value are set to 0 [L T-1 ~> 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]. + real, dimension(nz+1), intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. + real, dimension(nz+1), intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> 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 - real, dimension(nz+1), optional, & - intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. - real, dimension(nz+1), optional, & - intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. - real, optional, intent(in) :: vel_underflow !< If present and true, any velocities that - !! are smaller in magnitude than this value are - !! 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 [L T-1 ~> m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke ks = 1 ; ke = nz if (present(ks_int)) ks = max(ks_int-1,1) if (present(ke_int)) ke = min(ke_int,nz) - underflow_vel = 0.0 ; if (present(vel_underflow)) underflow_vel = vel_underflow if (ks > ke) return @@ -1166,51 +1115,49 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif u(ke) = b1nz_0 * (dz(ke)*u0(ke) + a_a*u(ke-1)) v(ke) = b1nz_0 * (dz(ke)*v0(ke) + a_a*v(ke-1)) - if (abs(u(ke)) < underflow_vel) u(ke) = 0.0 - if (abs(v(ke)) < underflow_vel) v(ke) = 0.0 + if (abs(u(ke)) < vel_under) u(ke) = 0.0 + if (abs(v(ke)) < vel_under) v(ke) = 0.0 do k=ke-1,ks,-1 u(k) = u(k) + c1(k+1)*u(k+1) v(k) = v(k) + c1(k+1)*v(k+1) - if (abs(u(k)) < underflow_vel) u(k) = 0.0 - if (abs(v(k)) < underflow_vel) v(k) = 0.0 + if (abs(u(k)) < vel_under) u(k) = 0.0 + if (abs(v(k)) < vel_under) v(k) = 0.0 T(k) = T(k) + c1(k+1)*T(k+1) Sal(k) = Sal(k) + c1(k+1)*Sal(k+1) enddo else ! dt <= 0.0 do k=1,nz u(k) = u0(k) ; v(k) = v0(k) ; T(k) = T0(k) ; Sal(k) = S0(k) - if (abs(u(k)) < underflow_vel) u(k) = 0.0 - if (abs(v(k)) < underflow_vel) v(k) = 0.0 + if (abs(u(k)) < vel_under) u(k) = 0.0 + if (abs(v(k)) < vel_under) v(k) = 0.0 enddo endif - if (present(S2)) then - ! L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 - L2_to_Z2 = US%L_to_Z**2 - S2(1) = 0.0 ; S2(nz+1) = 0.0 - if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) - do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) - enddo - if (ke 1) & - N2(ks) = max(0.0, I_dz_int(ks) * & - (dbuoy_dT(ks) * (T0(ks-1)-T(ks)) + dbuoy_dS(ks) * (S0(ks-1)-Sal(ks)))) - do K=ks+1,ke - N2(K) = max(0.0, I_dz_int(K) * & - (dbuoy_dT(K) * (T(k-1)-T(k)) + dbuoy_dS(K) * (Sal(k-1)-Sal(k)))) - enddo - if (ke 1) & + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) + do K=ks+1,ke + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) + enddo + if (ke 1) & + N2(ks) = max(0.0, I_dz_int(ks) * & + (dbuoy_dT(ks) * (T0(ks-1)-T(ks)) + dbuoy_dS(ks) * (S0(ks-1)-Sal(ks)))) + do K=ks+1,ke + N2(K) = max(0.0, I_dz_int(K) * & + (dbuoy_dT(K) * (T(k-1)-T(k)) + dbuoy_dS(K) * (Sal(k-1)-Sal(k)))) + enddo + if (ke NULL() !< SW optical depth per unit thickness [m-1] + real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [Z-1 ~> m-1] !! The number of radiation bands is most rapidly varying (first) index. - real, pointer, dimension(:,:,:) :: sw_pen_band => NULL() !< shortwave radiation [Q R Z T-1 ~> W m-2] + real, allocatable :: sw_pen_band(:,:,:) !< shortwave radiation [Q R Z T-1 ~> W m-2] !! at the surface in each of the nbands bands that penetrates beyond the surface. !! The most rapidly varying dimension is the band. - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + real, allocatable :: min_wavelength_band(:) + !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + real, allocatable :: max_wavelength_band(:) + !< The maximum wavelength in each band of penetrating shortwave radiation [nm] real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. @@ -46,7 +47,7 @@ module MOM_opacity end type optics_type -!> The control structure with paramters for the MOM_opacity module +!> The control structure with parameters for the MOM_opacity module type, public :: opacity_CS ; private logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified by OPACITY_SCHEME) to !! determine the e-folding depth of incoming shortwave radiation. @@ -54,22 +55,23 @@ module MOM_opacity !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. real :: pen_sw_scale !< The vertical absorption e-folding depth of the - !! penetrating shortwave radiation [m]. + !! penetrating shortwave radiation [Z ~> m]. real :: pen_sw_scale_2nd !< The vertical absorption e-folding depth of the - !! (2nd) penetrating shortwave radiation [m]. - real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity + !! (2nd) penetrating shortwave radiation [Z ~> m]. + real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity [nondim] real :: pen_sw_frac !< The fraction of shortwave radiation that is - !! penetrating with a constant e-folding approach. + !! penetrating with a constant e-folding approach [nondim] real :: blue_frac !< The fraction of the penetrating shortwave !! radiation that is in the blue band [nondim]. - real :: opacity_land_value !< The value to use for opacity over land [m-1]. + real :: opacity_land_value !< The value to use for opacity over land [Z-1 ~> m-1]. !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. + logical :: warning_issued !< A flag that is used to avoid repetative warnings. !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 - integer, pointer :: id_opacity(:) => NULL() + integer, allocatable :: id_opacity(:) !>@} end type opacity_CS @@ -82,9 +84,6 @@ module MOM_opacity character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme -real, parameter :: op_diag_len = 1e-10 !< Lengthscale L used to remap opacity - !! from op to 1/L * tanh(op * L) - contains !> This sets the opacity of sea water based based on one of several different schemes. @@ -100,29 +99,28 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ 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(opacity_CS), pointer :: CS !< The control structure earlier set up by opacity_init. + type(opacity_CS) :: CS !< The control structure earlier set up by opacity_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + optional, intent(in) :: chl_3d !< The chlorophyll-A concentrations of each layer [mg m-3] ! Local variables integer :: i, j, k, n, is, ie, js, je, nz - real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. + real :: inv_sw_pen_scale ! The inverse of the e-folding scale [Z-1 ~> m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating - ! shortwave radiation. + ! shortwave radiation [nondim] logical :: call_for_surface ! if horizontal slice is the surface layer - real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array for diagnosing opacity [Z-1 ~> m-1] real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [Q R Z T-1 ~> W m-2]. + real :: op_diag_len ! A tiny lengthscale [Z ~> m] used to remap diagnostics of opacity + ! from op to 1/op_diag_len * tanh(op * op_diag_len) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & - "Module must be initialized via opacity_init before it is used.") - if (present(chl_2d) .or. present(chl_3d)) then - ! The optical properties are based on cholophyll concentrations. + ! The optical properties are based on chlorophyll concentrations. call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & G, GV, US, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input @@ -130,14 +128,14 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif ! Make sure there is no division by 0. - inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, & - GV%H_to_m*GV%H_subroundoff) + inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_Z, & + GV%H_to_Z*GV%H_subroundoff) if ( CS%Opacity_scheme == DOUBLE_EXP ) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & - 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) + 0.1*GV%Angstrom_Z, GV%H_to_Z*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) @@ -201,11 +199,12 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then + op_diag_len = 1.0e-10*US%m_to_Z ! A minimal extinction depth to constrain the range of opacity [Z ~> m] !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. ! This gives a nearly identical value when op << 1/L but allows one to - ! store the values when opacity is divergent (i.e. opaque). + ! record the values even at reduced precision when opacity is huge (i.e. opaque). tmp(i,j,k) = tanh(op_diag_len * optics%opacity_band(n,i,j,k)) / op_diag_len enddo ; enddo ; enddo call post_data(CS%id_opacity(n), tmp, CS%diag) @@ -215,12 +214,12 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ end subroutine set_opacity -!> This sets the "blue" band opacity based on chloophyll A concencentrations +!> This sets the "blue" band opacity based on chlorophyll A concentrations !! The red portion is lumped into the net heating at the surface. subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & G, GV, US, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values - !! set based on the opacities. + !! set based on the opacities. real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [Q R Z T-1 ~> W m-2] real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] @@ -229,17 +228,17 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir 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(opacity_CS), pointer :: CS !< The control structure. + type(opacity_CS) :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentrations [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating - ! shortwave radiation. + ! shortwave radiation [nondim] real :: Inv_nbands_nir ! The inverse of the number of bands of penetrating - ! near-infrafed radiation. + ! near-infrared radiation [nondim] real :: SW_pen_tot ! The sum across the bands of the penetrating ! shortwave radiation [Q R Z T-1 ~> W m-2]. real :: SW_vis_tot ! The sum across the visible bands of shortwave @@ -249,7 +248,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(time_type) :: day character(len=128) :: mesg integer :: i, j, k, n, is, ie, js, je, nz, nbands - logical :: multiband_vis_input, multiband_nir_input + logical :: multiband_vis_input, multiband_nir_input, total_sw_input is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -259,9 +258,9 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir ! into the net heating at the surface. ! ! Morel, A., Optical modeling of the upper ocean in relation to its biogenous -! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. +! matter content (case-i waters)., J. Geo. Res., {93}, 10,749--10,768, 1988. ! -! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical +! Manizza, M., C. L. Quere, A. Watson, and E. T. Buitenhuis, Bio-optical ! feedbacks among phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. @@ -273,10 +272,19 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir if (nbands <= 2) then ; Inv_nbands_nir = 0.0 else ; Inv_nbands_nir = 1.0 / real(nbands - 2.0) ; endif - multiband_vis_input = (associated(sw_vis_dir) .and. & - associated(sw_vis_dif)) - multiband_nir_input = (associated(sw_nir_dir) .and. & - associated(sw_nir_dif)) + if (.not.(associated(sw_total) .or. (associated(sw_vis_dir) .and. associated(sw_vis_dif) .and. & + associated(sw_nir_dir) .and. associated(sw_nir_dif)) )) then + if (.not.CS%warning_issued) then + call MOM_error(WARNING, & + "opacity_from_chl called without any shortwave flux arrays allocated.\n"//& + "Consider setting PEN_SW_NBANDS = 0 if no shortwave fluxes are being used.") + endif + CS%warning_issued = .true. + endif + + multiband_vis_input = (associated(sw_vis_dir) .and. associated(sw_vis_dif)) + multiband_nir_input = (associated(sw_nir_dir) .and. associated(sw_nir_dif)) + total_sw_input = associated(sw_total) chl_data(:,:) = 0.0 if (present(chl_3d)) then @@ -300,7 +308,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir endif enddo ; enddo else - call MOM_error(FATAL, "Either chl_2d or chl_3d must be preesnt in a call to opacity_form_chl.") + call MOM_error(FATAL, "Either chl_2d or chl_3d must be present in a call to opacity_form_chl.") endif select case (CS%opacity_scheme) @@ -311,12 +319,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir if (G%mask2dT(i,j) > 0.5) then if (multiband_vis_input) then SW_vis_tot = sw_vis_dir(i,j) + sw_vis_dif(i,j) - else ! Follow Manizza 05 in assuming that 42% of SW is visible. + elseif (total_sw_input) then + ! Follow Manizza 05 in assuming that 42% of SW is visible. SW_vis_tot = 0.42 * sw_total(i,j) endif if (multiband_nir_input) then SW_nir_tot = sw_nir_dir(i,j) + sw_nir_dif(i,j) - else + elseif (total_sw_input) then SW_nir_tot = sw_total(i,j) - SW_vis_tot endif endif @@ -335,11 +344,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir !$OMP parallel do default(shared) private(SW_pen_tot) do j=js,je ; do i=is,ie SW_pen_tot = 0.0 - if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then + if (G%mask2dT(i,j) > 0.5) then + if (multiband_vis_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * (sw_vis_dir(i,j) + sw_vis_dif(i,j)) - else + elseif (total_sw_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * 0.5*sw_total(i,j) - endif ; endif + endif + endif do n=1,nbands optics%sw_pen_band(n,i,j) = Inv_nbands*sw_pen_tot @@ -364,18 +375,18 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir enddo else ! Band 1 is Manizza blue. - optics%opacity_band(1,i,j,k) = 0.0232 + 0.074*chl_data(i,j)**0.674 + optics%opacity_band(1,i,j,k) = (0.0232 + 0.074*chl_data(i,j)**0.674) * US%Z_to_m if (nbands >= 2) & ! Band 2 is Manizza red. - optics%opacity_band(2,i,j,k) = 0.225 + 0.037*chl_data(i,j)**0.629 + optics%opacity_band(2,i,j,k) = (0.225 + 0.037*chl_data(i,j)**0.629) * US%Z_to_m ! All remaining bands are NIR, for lack of something better to do. - do n=3,nbands ; optics%opacity_band(n,i,j,k) = 2.86 ; enddo + do n=3,nbands ; optics%opacity_band(n,i,j,k) = 2.86*US%Z_to_m ; enddo endif enddo ; enddo case (MOREL_88) do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = CS%opacity_land_value if (G%mask2dT(i,j) > 0.5) & - optics%opacity_band(1,i,j,k) = opacity_morel(chl_data(i,j)) + optics%opacity_band(1,i,j,k) = US%Z_to_m * opacity_morel(chl_data(i,j)) do n=2,optics%nbands optics%opacity_band(n,i,j,k) = optics%opacity_band(1,i,j,k) @@ -397,7 +408,7 @@ function opacity_morel(chl_data) real :: opacity_morel !< The returned opacity [m-1] ! The following are coefficients for the optical model taken from Morel and - ! Antoine (1994). These coeficients represent a non uniform distribution of + ! Antoine (1994). These coefficients represent a non uniform distribution of ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. @@ -417,7 +428,7 @@ function SW_pen_frac_morel(chl_data) real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim] ! The following are coefficients for the optical model taken from Morel and - ! Antoine (1994). These coeficients represent a non uniform distribution of + ! Antoine (1994). These coefficients represent a non uniform distribution of ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. @@ -449,7 +460,8 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), & - optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer [Z-1 ~> m-1], + !! but with units that can be altered by opacity_scale. real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. real, dimension(max(optics%nbands,1),SZI_(G)), & optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2] @@ -491,14 +503,18 @@ end subroutine extract_optics_fields !> Return the number of bands of penetrating shortwave radiation. function optics_nbands(optics) - type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + type(optics_type), pointer :: optics !< An optics structure that has values of opacities !! and shortwave fluxes. integer :: optics_nbands !< The number of penetrating bands of SW radiation - optics_nbands = optics%nbands + if (associated(optics)) then + optics_nbands = optics%nbands + else + optics_nbands = 0 + endif end function optics_nbands -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inherited !! from GOLD) or throughout the water column. !! !! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total @@ -517,7 +533,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(max(1,nsw),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< Opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. + !! The indices are band, i, k. type(optics_type), intent(in) :: optics !< An optics structure that has values of !! opacities and shortwave fluxes. integer, intent(in) :: j !< j-index to work on. @@ -550,12 +566,12 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indices. real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [R-1 degC-1]. + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific volume + !! with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating !! throughout a layer [R Z3 T-2 ~> J m-2]. @@ -605,8 +621,10 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! TKE budget of the shortwave heating. real :: C1_6, C1_60 integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. + if (nsw < 1) return + + SW_Remains = .false. min_SW_heat = optics%PenSW_flux_absorb * dt I_Habs = optics%PenSW_absorb_Invlen @@ -775,7 +793,7 @@ end subroutine absorbRemainingSW !> This subroutine calculates the total shortwave heat flux integrated over !! bands as a function of depth. This routine is only called for computing -!! buoyancy fluxes for use in KPP. This routine does not updat e the state. +!! buoyancy fluxes for use in KPP. This routine does not update the state. subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -795,9 +813,8 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave !! radiation is absorbed in the ocean water column. real, dimension(max(nsw,1),SZI_(G)), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave - !! heating in each band that hits the bottom and - !! will be redistributed through the water column - !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). + !! in each band at the sea surface; size nsw x SZI_(G) + !! [degC H ~> degC m or degC kg m-2]. real, dimension(SZI_(G),SZK_(GV)+1), & intent(inout) :: netPen !< Net penetrating shortwave heat flux at each !! interface, summed across all bands @@ -831,12 +848,16 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H I_Habs = 1e3*GV%H_to_m ! optics%PenSW_absorb_Invlen h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke + if (nsw < 1) then + netPen(:,:) = 0.0 + return + endif + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) do i=is,ie ; h_heat(i) = 0.0 ; enddo do i=is,ie @@ -848,6 +869,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & ! Apply penetrating SW radiation to remaining parts of layers. ! Excessively thin layers are not heated to avoid runaway temps. + min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H do k=1,nz do i=is,ie @@ -856,7 +878,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & if (h(i,k) > 0.0) then do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * optics%opacity_band(n,i,j,k) + opt_depth = h(i,k)*GV%H_to_Z * optics%opacity_band(n,i,j,k) exp_OD = exp(-opt_depth) SW_trans = exp_OD @@ -915,7 +937,7 @@ end subroutine sumSWoverBands -!> This routine initalizes the opacity module, including an optics_type. +!> This routine initializes the opacity module, including an optics_type. subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -925,9 +947,8 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. - type(optics_type), pointer :: optics !< An optics structure that has parameters + type(opacity_CS) :: CS !< Opacity control structure + type(optics_type) :: optics !< An optics structure that has parameters !! set and arrays allocated here. ! Local variables character(len=200) :: tmpstr @@ -938,19 +959,13 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) ! This include declares and sets the variable "version". # include "version_variable.h" real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat - ! flux when that flux drops below PEN_SW_FLUX_ABSORB [m]. + ! flux when that flux drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2] real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] logical :: default_2018_answers logical :: use_scheme integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - if (associated(CS)) then - call MOM_error(WARNING, "opacity_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ! Read all relevant parameters and write them to the model log. @@ -1012,19 +1027,18 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) call MOM_mesg('opacity_init: opacity scheme set to "'//trim(tmpstr)//'".', 5) endif call get_param(param_file, mdl, "PEN_SW_SCALE", CS%pen_sw_scale, & - "The vertical absorption e-folding depth of the "//& - "penetrating shortwave radiation.", units="m", default=0.0) + "The vertical absorption e-folding depth of the penetrating shortwave radiation.", & + units="m", default=0.0, scale=US%m_to_Z) !BGR/ Added for opacity_scheme==double_exp read in 2nd exp-decay and fraction if (CS%Opacity_scheme == DOUBLE_EXP ) then call get_param(param_file, mdl, "PEN_SW_SCALE_2ND", CS%pen_sw_scale_2nd, & "The (2nd) vertical absorption e-folding depth of the "//& - "penetrating shortwave radiation "//& - "(use if SW_EXP_MODE==double.)",& - units="m", default=0.0) + "penetrating shortwave radiation (use if SW_EXP_MODE==double.)", & + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "SW_1ST_EXP_RATIO", CS%sw_1st_exp_ratio, & "The fraction of 1st vertical absorption e-folding depth "//& "penetrating shortwave radiation if SW_EXP_MODE==double.",& - units="m", default=0.0) + units="nondim", default=0.0) elseif (CS%OPACITY_SCHEME == Single_Exp) then !/Else disable 2nd_exp scheme CS%pen_sw_scale_2nd = 0.0 @@ -1069,9 +1083,9 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) default=PenSW_minthick_dflt, units="m", scale=GV%m_to_H) optics%PenSW_absorb_Invlen = 1.0 / (PenSW_absorb_minthick + GV%H_subroundoff) - if (.not.associated(optics%min_wavelength_band)) & + if (.not.allocated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) - if (.not.associated(optics%max_wavelength_band)) & + if (.not.allocated(optics%max_wavelength_band)) & allocate(optics%max_wavelength_band(optics%nbands)) if (CS%opacity_scheme == MANIZZA_05) then @@ -1091,11 +1105,13 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) call get_param(param_file, mdl, "OPACITY_LAND_VALUE", CS%opacity_land_value, & "The value to use for opacity over land. The default is "//& - "10 m-1 - a value for muddy water.", units="m-1", default=10.0) + "10 m-1 - a value for muddy water.", units="m-1", default=10.0, scale=US%Z_to_m) + + CS%warning_issued = .false. - if (.not.associated(optics%opacity_band)) & - allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) - if (.not.associated(optics%sw_pen_band)) & + if (.not.allocated(optics%opacity_band)) & + allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz), source=0.0) + if (.not.allocated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) allocate(CS%id_opacity(optics%nbands), source=-1) @@ -1109,35 +1125,33 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) & // ', saved as L^-1 tanh(Opacity * L) for L = 10^-10 m' CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & - longname, 'm-1') + longname, 'm-1', conversion=US%m_to_Z) enddo end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. - type(optics_type), optional, pointer :: optics !< An optics type structure that should be deallocated. - - if (associated(CS%id_opacity)) deallocate(CS%id_opacity) - if (associated(CS)) deallocate(CS) - - if (present(optics)) then ; if (associated(optics)) then - if (associated(optics%sw_pen_band)) deallocate(optics%sw_pen_band) - if (associated(optics%opacity_band)) deallocate(optics%opacity_band) - if (associated(optics%max_wavelength_band)) & - deallocate(optics%max_wavelength_band) - if (associated(optics%min_wavelength_band)) & - deallocate(optics%min_wavelength_band) - endif ; endif - + type(opacity_CS) :: CS !< Opacity control structure + type(optics_type) :: optics !< An optics type structure that should be deallocated. + + if (allocated(CS%id_opacity)) & + deallocate(CS%id_opacity) + if (allocated(optics%sw_pen_band)) & + deallocate(optics%sw_pen_band) + if (allocated(optics%opacity_band)) & + deallocate(optics%opacity_band) + if (allocated(optics%max_wavelength_band)) & + deallocate(optics%max_wavelength_band) + if (allocated(optics%min_wavelength_band)) & + deallocate(optics%min_wavelength_band) end subroutine opacity_end !> \namespace mom_opacity !! !! opacity_from_chl: !! In this routine, the Morel (modified) or Manizza (modified) -!! schemes use the "blue" band in the paramterizations to determine +!! schemes use the "blue" band in the parameterizations to determine !! the e-folding depth of the incoming shortwave attenuation. The red !! portion is lumped into the net heating at the surface. !! diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index f67fb48fc7..1f141ffd0f 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -23,6 +23,7 @@ module MOM_regularize_layers !> This control structure holds parameters used by the MOM_regularize_layers module type, public :: regularize_layers_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: regularize_surface_layers !< If true, vertically restructure the !! near-surface layers when they have too much !! lateral variations to allow for sensible lateral @@ -55,13 +56,11 @@ module MOM_regularize_layers logical :: debug !< If true, do more thorough checks for debugging purposes. integer :: id_def_rat = -1 !< A diagnostic ID - 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. end type regularize_layers_CS !>@{ Clock IDs !! \todo Should these be global? -integer :: id_clock_pass, id_clock_EOS +integer :: id_clock_pass !>@} contains @@ -86,14 +85,14 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous - !! call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + ! Local variables integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") if (CS%regularize_surface_layers) then @@ -123,8 +122,8 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous - !! call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & def_rat_u ! The ratio of the thickness deficit to the minimum depth [nondim]. @@ -194,7 +193,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") if (GV%nkml<1) return @@ -219,7 +218,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) e(i,j,K+1) = e(i,j,K) - h(i,j,k) enddo ; enddo ; enddo - call find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h=h) + call find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) ! Determine which columns are problematic do j=js,je ; do_j(j) = .false. ; enddo @@ -232,12 +231,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) ! Now restructure the layers. !$OMP parallel do default(private) 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,EOSdom) + !$OMP eb,nkml,EOSdom) do j=js,je ; if (do_j(j)) then -! call cpu_clock_begin(id_clock_EOS) ! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom) -! call cpu_clock_end(id_clock_EOS) do k=1,nz ; do i=is,ie ; d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 ; enddo ; enddo kmax_d_ea = 0 @@ -366,11 +363,9 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) enddo endif if (det_any) then - 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), tv%eqn_of_state, EOSdom) enddo - call cpu_clock_end(id_clock_EOS) do i=is,ie ; if (det_i(i)) then k1 = nkmb ; k2 = nz @@ -612,8 +607,7 @@ end subroutine regularize_surface !! thickness at velocity points differ from the arithmetic means, relative to !! the the arithmetic means, after eliminating thickness variations that are !! solely due to topography and aggregating all interior layers into one. -subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & - def_rat_u_2lay, def_rat_v_2lay, halo, h) +subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -624,32 +618,19 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & real, dimension(SZI_(G),SZJB_(G)), & intent(out) :: def_rat_v !< The thickness deficit ratio at v points, !! [nondim]. - type(regularize_layers_CS), pointer :: CS !< The control structure returned by a - !! previous call to regularize_layers_init. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: def_rat_u_2lay !< The thickness deficit ratio at u - !! points when the mixed and buffer layers - !! are aggregated into 1 layer [nondim]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: def_rat_v_2lay !< The thickness deficit ratio at v - !! pointswhen the mixed and buffer layers - !! are aggregated into 1 layer [nondim]. - integer, optional, intent(in) :: halo !< An extra-wide halo size, 0 by default. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - !! If h is not present, vertical differences - !! in interface heights are used instead. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & h_def_u, & ! The vertically summed thickness deficits at u-points [H ~> m or kg m-2]. - h_norm_u, & ! The vertically summed arithmetic mean thickness by which + h_norm_u ! The vertically summed arithmetic mean thickness by which ! h_def_u is normalized [H ~> m or kg m-2]. - h_def2_u real, dimension(SZI_(G),SZJB_(G)) :: & h_def_v, & ! The vertically summed thickness deficits at v-points [H ~> m or kg m-2]. - h_norm_v, & ! The vertically summed arithmetic mean thickness by which + h_norm_v ! The vertically summed arithmetic mean thickness by which ! h_def_v is normalized [H ~> m or kg m-2]. - h_def2_v 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 :: Hmix_min ! A local copy of CS%Hmix_min [H ~> m or kg m-2]. @@ -657,9 +638,6 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & integer :: i, j, k, is, ie, js, je, nz, nkmb is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - endif nkmb = GV%nk_rho_varies h_neglect = GV%H_subroundoff Hmix_min = CS%Hmix_min @@ -677,22 +655,8 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_u(I,j) = 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_u(I,j) = 0.5*(h1+h2) enddo ; enddo - if (present(def_rat_u_2lay)) then ; do j=js,je ; do I=is-1,ie - ! This is a particular metric of the aggregation into two layers. - h1 = e(i,j,1)-e(i,j,nkmb+1) ; h2 = e(i+1,j,1)-e(i+1,j,nkmb+1) - if (e(i,j,nkmb+1) < e(i+1,j,nz+1)) then - if (h1 > h2) h1 = max(e(i,j,1)-e(i+1,j,nz+1), h2) - elseif (e(i+1,j,nkmb+1) < e(i,j,nz+1)) then - if (h2 > h1) h2 = max(e(i+1,j,1)-e(i,j,nz+1), h1) - endif - h_def2_u(I,j) = h_def_u(I,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) - enddo ; enddo ; endif do k=1,nkmb ; do j=js,je ; do I=is-1,ie - if (present(h)) then - h1 = h(i,j,k) ; h2 = h(i+1,j,k) - else - h1 = e(i,j,K)-e(i,j,K+1) ; h2 = e(i+1,j,K)-e(i+1,j,K+1) - endif + h1 = h(i,j,k) ; h2 = h(i+1,j,k) ! Thickness deficits can not arise simply because a layer's bottom is bounded ! by the bathymetry. if (e(i,j,K+1) < e(i+1,j,nz+1)) then @@ -703,15 +667,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_u(I,j) = h_def_u(I,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_u(I,j) = h_norm_u(I,j) + 0.5*(h1+h2) enddo ; enddo ; enddo - if (present(def_rat_u_2lay)) then ; do j=js,je ; do I=is-1,ie - def_rat_u(I,j) = G%mask2dCu(I,j) * h_def_u(I,j) / & - (max(Hmix_min, h_norm_u(I,j)) + h_neglect) - def_rat_u_2lay(I,j) = G%mask2dCu(I,j) * h_def2_u(I,j) / & - (max(Hmix_min, h_norm_u(I,j)) + h_neglect) - enddo ; enddo ; else ; do j=js,je ; do I=is-1,ie + do j=js,je ; do I=is-1,ie def_rat_u(I,j) = G%mask2dCu(I,j) * h_def_u(I,j) / & (max(Hmix_min, h_norm_u(I,j)) + h_neglect) - enddo ; enddo ; endif + enddo ; enddo ! Determine which meridional faces are problematic. do J=js-1,je ; do i=is,ie @@ -726,22 +685,8 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_v(i,J) = 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_v(i,J) = 0.5*(h1+h2) enddo ; enddo - if (present(def_rat_v_2lay)) then ; do J=js-1,je ; do i=is,ie - ! This is a particular metric of the aggregation into two layers. - h1 = e(i,j,1)-e(i,j,nkmb+1) ; h2 = e(i,j+1,1)-e(i,j+1,nkmb+1) - if (e(i,j,nkmb+1) < e(i,j+1,nz+1)) then - if (h1 > h2) h1 = max(e(i,j,1)-e(i,j+1,nz+1), h2) - elseif (e(i,j+1,nkmb+1) < e(i,j,nz+1)) then - if (h2 > h1) h2 = max(e(i,j+1,1)-e(i,j,nz+1), h1) - endif - h_def2_v(i,J) = h_def_v(i,J) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) - enddo ; enddo ; endif do k=1,nkmb ; do J=js-1,je ; do i=is,ie - if (present(h)) then - h1 = h(i,j,k) ; h2 = h(i,j+1,k) - else - h1 = e(i,j,K)-e(i,j,K+1) ; h2 = e(i,j+1,K)-e(i,j+1,K+1) - endif + h1 = h(i,j,k) ; h2 = h(i,j+1,k) ! Thickness deficits can not arise simply because a layer's bottom is bounded ! by the bathymetry. if (e(i,j,K+1) < e(i,j+1,nz+1)) then @@ -752,15 +697,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_v(i,J) = h_def_v(i,J) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_v(i,J) = h_norm_v(i,J) + 0.5*(h1+h2) enddo ; enddo ; enddo - if (present(def_rat_v_2lay)) then ; do J=js-1,je ; do i=is,ie - def_rat_v(i,J) = G%mask2dCv(i,J) * h_def_v(i,J) / & - (max(Hmix_min, h_norm_v(i,J)) + h_neglect) - def_rat_v_2lay(i,J) = G%mask2dCv(i,J) * h_def2_v(i,J) / & - (max(Hmix_min, h_norm_v(i,J)) + h_neglect) - enddo ; enddo ; else ; do J=js-1,je ; do i=is,ie + do J=js-1,je ; do i=is,ie def_rat_v(i,J) = G%mask2dCv(i,J) * h_def_v(i,J) / & (max(Hmix_min, h_norm_v(i,J)) + h_neglect) - enddo ; enddo ; endif + enddo ; enddo end subroutine find_deficit_ratios @@ -773,8 +713,8 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate !! diagnostic output. - type(regularize_layers_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control struct + #include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. logical :: use_temperature @@ -783,11 +723,7 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "regularize_layers_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif + CS%initialized = .true. CS%diag => diag CS%Time => Time @@ -838,19 +774,11 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) ! call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debug, & ! "If true, monitor conservation and extrema.", default=.false., do_not_log=just_read) - call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", CS%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.", & - default=.true., do_not_log=just_read) - if (.not.CS%regularize_surface_layers) return CS%id_def_rat = register_diag_field('ocean_model', 'deficit_ratio', diag%axesT1, & Time, 'Max face thickness deficit ratio', 'nondim') - if (CS%allow_clocks_in_omp_loops) then - id_clock_EOS = cpu_clock_id('(Ocean regularize_layers EOS)', grain=CLOCK_ROUTINE) - endif id_clock_pass = cpu_clock_id('(Ocean regularize_layers halo updates)', grain=CLOCK_ROUTINE) end subroutine regularize_layers_init diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 4ce947e817..061fe776e1 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -56,6 +56,7 @@ module MOM_set_diffusivity !> This control structure contains parameters for MOM_set_diffusivity. type, public :: set_diffusivity_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: debug !< If true, write verbose checksums for debugging. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with @@ -161,7 +162,7 @@ module MOM_set_diffusivity type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() !< Control structure for a child module type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() !< Control structure for a child module type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module - type(tidal_mixing_cs), pointer :: tidal_mixing_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs) :: tidal_mixing !< Control structure for a child module !>@{ Diagnostic IDs integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1 @@ -198,8 +199,8 @@ module MOM_set_diffusivity contains -subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & - G, GV, US, CS, Kd_lay, Kd_int, Kd_extra_T, Kd_extra_S) +subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_int, & + G, GV, US, CS, Kd_lay, Kd_extra_T, Kd_extra_S) 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 @@ -219,13 +220,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & type(optics_type), pointer :: optics !< A structure describing the optical !! properties of the ocean. type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom - !! boundary layer properies, and related fields. + !! boundary layer properties and related fields. real, intent(in) :: dt !< Time increment [T ~> s]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(out) :: Kd_extra_T !< The extra diffusivity at interfaces of !! temperature due to double diffusion relative to @@ -282,6 +283,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"set_diffusivity: "//& + "Module must be initialized before it is used.") + 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. @@ -302,7 +306,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set Kd_lay, Kd_int and Kv_slow to constant values, mostly to fill the halos. if (present(Kd_lay)) Kd_lay(:,:,:) = CS%Kd - if (present(Kd_int)) Kd_int(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd if (present(Kd_extra_T)) Kd_extra_T(:,:,:) = 0.0 if (present(Kd_extra_S)) Kd_extra_S(:,:,:) = 0.0 if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv @@ -326,7 +330,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! set up arrays for tidal mixing diagnostics if (CS%use_tidal_mixing) & - call setup_tidal_diagnostics(G, GV, CS%tidal_mixing_CSp) + call setup_tidal_diagnostics(G, GV, CS%tidal_mixing) if (CS%useKappaShear) then if (CS%debug) then @@ -468,99 +472,72 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the input turbulent diffusivity. if (CS%useKappaShear .or. CS%use_CVMix_shear) then - if (present(Kd_int)) then - do K=2,nz ; do i=is,ie - Kd_int_2d(i,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) - enddo ; enddo - do i=is,ie - Kd_int_2d(i,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. - Kd_int_2d(i,nz+1) = 0.0 - enddo - endif + do K=2,nz ; do i=is,ie + Kd_int_2d(i,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) + enddo ; enddo + do i=is,ie + Kd_int_2d(i,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int_2d(i,nz+1) = 0.0 + enddo do k=1,nz ; do i=is,ie Kd_lay_2d(i,k) = Kd_lay_2d(i,k) + 0.5 * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else - if (present(Kd_int)) then - do i=is,ie - Kd_int_2d(i,1) = Kd_lay_2d(i,1) ; Kd_int_2d(i,nz+1) = 0.0 - enddo - do K=2,nz ; do i=is,ie - Kd_int_2d(i,K) = 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) - enddo ; enddo - endif - endif - - if (present(Kd_int)) then - ! Add the ML_Rad diffusivity. - if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d, Kd_int_2d) - - ! Add the Nikurashin and / or tidal bottom-driven mixing - if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & - N2_lay, N2_int, Kd_lay_2d, Kd_int_2d, CS%Kd_max, visc%Kv_slow) - - ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. - if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then - if (CS%use_LOTW_BBL_diffusivity) then - call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & - dd%Kd_BBL, Kd_lay_2d, Kd_int_2d) - else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_int_2d, dd%Kd_BBL) - endif - endif - - if (CS%limit_dissipation) then - ! This calculates the dissipation ONLY from Kd calculated in this routine - ! dissip has units of W/m3 (= kg/m3 * m2/s * 1/s2) - ! 1) a global constant, - ! 2) a dissipation proportional to N (aka Gargett) and - ! 3) dissipation corresponding to a (nearly) constant diffusivity. - do K=2,nz ; do i=is,ie - dissip = max( CS%dissip_min, & ! Const. floor on dissip. - CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett - CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri - Kd_int_2d(i,K) = max(Kd_int_2d(i,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) - enddo ; enddo - endif - - ! Optionally add a uniform diffusivity at the interfaces. - if (CS%Kd_add > 0.0) then ; do K=1,nz+1 ; do i=is,ie - Kd_int_2d(i,K) = Kd_int_2d(i,K) + CS%Kd_add - enddo ; enddo ; endif - - ! Copy the 2-d slices into the 3-d array that is exported. - do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd_int_2d(i,K) + do i=is,ie + Kd_int_2d(i,1) = Kd_lay_2d(i,1) ; Kd_int_2d(i,nz+1) = 0.0 + enddo + do K=2,nz ; do i=is,ie + Kd_int_2d(i,K) = 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) enddo ; enddo + endif - else ! Kd_int is not present. + ! Add the ML_Rad diffusivity. + if (CS%ML_radiation) & + call add_MLrad_diffusivity(h, fluxes, j, Kd_int_2d, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d) - ! Add the ML_Rad diffusivity. - if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d) + ! Add the Nikurashin and / or tidal bottom-driven mixing + if (CS%use_tidal_mixing) & + call calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, & + maxTKE, G, GV, US, CS%tidal_mixing, & + CS%Kd_max, visc%Kv_slow, Kd_lay_2d, Kd_int_2d) - ! Add the Nikurashin and / or tidal bottom-driven mixing - if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & - N2_lay, N2_int, Kd_lay_2d, Kd_max=CS%Kd_max, Kv=visc%Kv_slow) - ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. - if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then - if (CS%use_LOTW_BBL_diffusivity) then - call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & - dd%Kd_BBL, Kd_lay_2d) - else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_BBL=dd%Kd_BBL) - endif + ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. + if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then + if (CS%use_LOTW_BBL_diffusivity) then + call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int_2d, G, GV, US, CS, & + dd%Kd_BBL, Kd_lay_2d) + else + call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & + maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_int_2d, dd%Kd_BBL) endif + endif + if (CS%limit_dissipation) then + ! This calculates the dissipation ONLY from Kd calculated in this routine + ! dissip has units of W/m3 (= kg/m3 * m2/s * 1/s2) + ! 1) a global constant, + ! 2) a dissipation proportional to N (aka Gargett) and + ! 3) dissipation corresponding to a (nearly) constant diffusivity. + do K=2,nz ; do i=is,ie + dissip = max( CS%dissip_min, & ! Const. floor on dissip. + CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett + CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri + Kd_int_2d(i,K) = max(Kd_int_2d(i,K) , & ! Apply floor to Kd + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) + enddo ; enddo endif + ! Optionally add a uniform diffusivity at the interfaces. + if (CS%Kd_add > 0.0) then ; do K=1,nz+1 ; do i=is,ie + Kd_int_2d(i,K) = Kd_int_2d(i,K) + CS%Kd_add + enddo ; enddo ; endif + + ! Copy the 2-d slices into the 3-d array that is exported. + do K=1,nz+1 ; do i=is,ie + Kd_int(i,j,K) = Kd_int_2d(i,K) + enddo ; enddo + if (CS%limit_dissipation) then ! This calculates the layer dissipation ONLY from Kd calculated in this routine ! dissip has units of W/m3 (= kg/m3 * m2/s * 1/s2) @@ -638,7 +615,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! tidal mixing if (CS%use_tidal_mixing) & - call post_tidal_diagnostics(G, GV, h, CS%tidal_mixing_CSp) + call post_tidal_diagnostics(G, GV, h, CS%tidal_mixing) if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) @@ -994,7 +971,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) enddo - if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing_CSp) + if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing) do k=nz,2,-1 do_any = .false. @@ -1163,7 +1140,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom - !! boundary layer properies, and related fields + !! boundary layer properties and related fields integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1177,8 +1154,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers, !! [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, + real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1]. @@ -1189,9 +1165,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & 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 R ~> kg m-2] + rho_htot, & ! running integral with depth of density [R Z ~> kg m-2] gh_sum_top, & ! BBL value of g'h that can be supported by - ! the local ustar, times R0_g [R ~> kg m-2] + ! the local ustar, times R0_g [R Z ~> 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] @@ -1204,7 +1180,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & 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 [R T2 Z-1 m-1 ~> kg s2 m-5] + real :: R0_g ! Rho0 / G_Earth [R T2 Z-1 ~> kg s2 m-4] 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 @@ -1330,10 +1306,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else Kd_lay(i,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) endif - if (present(Kd_int)) then - Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd - Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd - endif + Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd + Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * delta_Kd @@ -1357,10 +1331,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & delta_Kd = TKE_here * TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,k) = Kd_lay(i,k) + delta_Kd - if (present(Kd_int)) then - Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd - Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd - endif + Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd + Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * delta_Kd @@ -1386,8 +1358,8 @@ end subroutine add_drag_diffusivity !> Calculates a BBL diffusivity use a Prandtl number 1 diffusivity with a law of the !! wall turbulent viscosity, up to a BBL height where the energy used for mixing has !! consumed the mechanical TKE input. -subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & - G, GV, US, CS, Kd_BBL, Kd_lay, Kd_int) +subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int, & + G, GV, US, CS, Kd_BBL, Kd_lay) 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 @@ -1401,16 +1373,16 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom - !! boundary layer properies, and related fields. + !! boundary layer properties and related fields. integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)+1), & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2] + real, dimension(SZI_(G),SZK_(GV)+1), & + intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] ! Local variables real :: TKE_column ! net TKE input into the column [Z3 T-3 ~> m3 s-3] @@ -1429,7 +1401,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 [R-1 ~> m3 kg-1] + 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. @@ -1472,7 +1444,7 @@ 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 [R Z3 T-3 ~> m3 s-3]. + ! Add in tidal dissipation energy at the bottom [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 + fluxes%TKE_tidal(i,j) * I_Rho0 @@ -1537,7 +1509,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - if (present(Kd_int)) Kd_int(i,K) = Kd_int(i,K) + Kd_wall + Kd_int(i,K) = Kd_int(i,K) + Kd_wall if (present(Kd_lay)) Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * (Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next layer up. if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall @@ -1547,7 +1519,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & end subroutine add_LOTW_BBL_diffusivity !> This routine adds effects of mixed layer radiation to the layer diffusivities. -subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, Kd_int) +subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, Kd_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 type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1555,6 +1527,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< Surface fluxes structure integer, intent(in) :: j !< The j-index to work on + real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces + !! [Z2 T-1 ~> m2 s-1]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1563,9 +1537,6 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces - !! [Z2 T-1 ~> m2 s-1]. ! This routine adds effects of mixed layer radiation to the layer diffusivities. @@ -1639,14 +1610,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, Kd_lay(i,k) = Kd_lay(i,k) + Kd_mlr_ml(i) endif ; enddo ; enddo endif - if (present(Kd_int)) then - do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,K) = Kd_int(i,K) + Kd_mlr_ml(i) - endif ; enddo ; enddo - if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,Kml+2) = Kd_int(i,Kml+2) + 0.5 * Kd_mlr_ml(i) - endif ; enddo ; endif - endif + do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then + Kd_int(i,K) = Kd_int(i,K) + Kd_mlr_ml(i) + endif ; enddo ; enddo + if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then + Kd_int(i,Kml+2) = Kd_int(i,Kml+2) + 0.5 * Kd_mlr_ml(i) + endif ; enddo ; endif do k=kml+2,nz-1 do_any = .false. @@ -1674,10 +1643,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, if (present(Kd_lay)) then Kd_lay(i,k) = Kd_lay(i,k) + Kd_mlr endif - if (present(Kd_int)) then - Kd_int(i,K) = Kd_int(i,K) + 0.5 * Kd_mlr - Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * Kd_mlr - endif + Kd_int(i,K) = Kd_int(i,K) + 0.5 * Kd_mlr + Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * Kd_mlr TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) if (TKE_ml_flux(i) * I_decay(i) < 0.1 * CS%Kd_min * Omega2) then @@ -1703,9 +1670,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom - !! boundary layer properies, and related fields. + !! boundary layer properties and related fields. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! This subroutine calculates several properties related to bottom ! boundary layer turbulence. @@ -1736,16 +1703,19 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) local_open_u_BC = .false. local_open_v_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_u_BC = OBC%open_u_BCs_exist_globally local_open_v_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) call MOM_error(FATAL,"set_BBL_TKE: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"set_BBL_TKE: "//& + "Module must be initialized before it is used.") + if (.not.CS%bottomdraglaw .or. (CS%BBL_effic<=0.0)) then if (associated(visc%ustar_BBL)) then do j=js,je ; do i=is,ie ; visc%ustar_BBL(i,j) = 0.0 ; enddo ; enddo @@ -1993,12 +1963,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output. type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control !! structure. - type(int_tide_CS), pointer :: int_tide_CSp !< A pointer to the internal tides control - !! structure + type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control struct integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. - logical, optional, intent(out) :: double_diffuse !< If present, this indicates whether - !! some version of double diffusion is being used. + logical, intent(out) :: double_diffuse !< This indicates whether some version + !! of double diffusion is being used. ! Local variables real :: decay_length @@ -2007,9 +1976,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. - real :: omega_frac_dflt + real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate + ! that is used in place of the absolute value of the local Coriolis + ! parameter in the denominator of some expressions [nondim] logical :: Bryan_Lewis_diffusivity ! If true, the background diapycnal diffusivity uses ! the Bryan-Lewis (1979) style tanh profile. + logical :: use_regridding ! If true, use the ALE algorithm rather than layered + ! isopycnal or stacked shallow water mode. + logical :: TKE_to_Kd_used ! If true, TKE_to_Kd and maxTKE need to be calculated. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -2020,11 +1994,13 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ endif allocate(CS) + CS%initialized = .true. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed CS%diag => diag - if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp + CS%int_tide_CSp => int_tide_CSp ! These default values always need to be set. CS%BBL_mixing_as_max = .true. @@ -2053,8 +2029,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "forms of the same expressions.", default=default_2018_answers) ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. - CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, diag, & - CS%tidal_mixing_CSp) + CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, & + CS%int_tide_CSp, diag, CS%tidal_mixing) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& @@ -2151,11 +2127,15 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ endif CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + TKE_to_Kd_used = (CS%use_tidal_mixing .or. CS%ML_radiation .or. & + (CS%bottomdraglaw .and. .not.CS%use_LOTW_BBL_diffusivity)) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will "//& "work for arbitrary vertical coordinates. If false, "//& "calculates Kd/TKE and bounds based on exact energetics "//& - "for an isopycnal layer-formulation.", default=.false.) + "for an isopycnal layer-formulation.", & + default=.false., do_not_log=.not.TKE_to_Kd_used) ! set params related to the background mixing call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp) @@ -2176,8 +2156,15 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The maximum permitted increment for the diapycnal "//& "diffusivity from TKE-based parameterizations, or a negative "//& "value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T) - if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & + if (CS%simple_TKE_to_Kd) then + if (CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") + call get_param(param_file, mdl, "USE_REGRIDDING", use_regridding, & + do_not_log=.true., default=.false.) + if (use_regridding) call MOM_error(WARNING, & + "set_diffusivity_init: SIMPLE_TKE_TO_KD can not be used reliably with USE_REGRIDDING.") + endif + call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added "//& "everywhere without any filtering or scaling.", & @@ -2307,14 +2294,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ 'Double-diffusion density ratio', 'nondim') endif - if (present(halo_TS)) then - halo_TS = 0 - if (CS%Vertex_Shear) halo_TS = 1 - endif + halo_TS = 0 + if (CS%Vertex_Shear) halo_TS = 1 - if (present(double_diffuse)) then - double_diffuse = (CS%double_diffusion .or. CS%use_CVMix_ddiff) - endif + double_diffuse = (CS%double_diffusion .or. CS%use_CVMix_ddiff) end subroutine set_diffusivity_init @@ -2324,10 +2307,8 @@ subroutine set_diffusivity_end(CS) call bkgnd_mixing_end(CS%bkgnd_mixing_csp) - if (CS%use_tidal_mixing) then - call tidal_mixing_end(CS%tidal_mixing_CSp) - deallocate(CS%tidal_mixing_CSp) - endif + if (CS%use_tidal_mixing) & + call tidal_mixing_end(CS%tidal_mixing) if (CS%user_change_diff) call user_change_diff_end(CS%user_change_diff_CSp) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9770325d85..fb969953c4 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -23,7 +23,7 @@ module MOM_set_visc use MOM_restart, only : register_restart_field_as_obsolete use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E @@ -43,6 +43,7 @@ module MOM_set_visc !> Control structure for MOM_set_visc type, public :: set_visc_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. !! Runtime parameter `HBBL`. real :: cdrag !< The quadratic drag coefficient. @@ -115,7 +116,7 @@ module MOM_set_visc contains !> Calculates the thickness of the bottom boundary layer and the viscosity within that layer. -subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) +subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) 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 @@ -130,11 +131,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !! have NULL ptrs.. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. - logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations - !! of those values in visc that would be - !! calculated with symmetric memory. + type(porous_barrier_ptrs),intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables real, dimension(SZIB_(G)) :: & @@ -180,7 +179,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H 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]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> nondim]. 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, @@ -201,7 +200,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H T T-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl @@ -259,7 +258,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Cell_width ! The transverse width of the velocity cell [L ~> m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's ! velocity magnitude to give the Rayleigh drag velocity, times - ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. + ! a lateral to vertical distance conversion factor [Z L-1 ~> nondim]. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell [nondim]. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -280,20 +279,17 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(ocean_OBC_type), pointer :: OBC => NULL() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& "Module must be initialized before it is used.") - if (.not.CS%bottomdraglaw) return - if (present(symmetrize)) then ; if (symmetrize) then - Jsq = js-1 ; Isq = is-1 - endif ; endif + if (.not.CS%bottomdraglaw) return if (CS%debug) then call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) @@ -380,7 +376,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,US,CS,Rml,nz,nkmb, & !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & - !$OMP OBC,maxitt,D_u,D_v,mask_u,mask_v) & + !$OMP OBC,maxitt,D_u,D_v,mask_u,mask_v, pbv) & !$OMP firstprivate(Vol_quit) do j=Jsq,Jeq ; do m=1,2 @@ -601,7 +597,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! When stratification dominates h_N< kg m-2 or kg2 m-5] htot = 0.0 ! Calculate the thickness of a stratification limited BBL ignoring rotation: @@ -910,8 +906,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ! end of a<0 cases. endif + !modify L(K) for porous barrier parameterization + if (m==1) then ; L(K) = L(K)*pbv%por_layer_widthU(I,j,K) + else ; L(K) = L(K)*pbv%por_layer_widthV(i,J,K); endif + ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acts on each layer. + ! and the Rayleigh drag that acts on each layer. if (L(K) > L(K+1)) then if (vol_below < bbl_thick) then BBL_frac = (1.0-vol_below/bbl_thick)**2 @@ -920,8 +920,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) BBL_frac = 0.0 endif - if (m==1) then ; Cell_width = G%dy_Cu(I,j) - else ; Cell_width = G%dx_Cv(i,J) ; endif + if (m==1) then ; Cell_width = G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k) + else ; Cell_width = G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k) ; endif gam = 1.0 - L(K+1)/L(K) Rayleigh = US%L_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & @@ -956,10 +956,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! set kv_bbl to the bound and recompute bbl_thick to be consistent ! but with a ridiculously large upper bound on thickness (for Cd u*=0) kv_bbl = CS%Kv_BBL_min - if (cdrag_sqrt*ustar(i)*BBL_visc_frac*G%Rad_Earth*US%m_to_Z > kv_bbl) then + if (cdrag_sqrt*ustar(i)*BBL_visc_frac*G%Rad_Earth_L*US%L_to_Z > kv_bbl) then bbl_thick_Z = kv_bbl / ( cdrag_sqrt*ustar(i)*BBL_visc_frac ) else - bbl_thick_Z = G%Rad_Earth * US%m_to_Z + bbl_thick_Z = G%Rad_Earth_L * US%L_to_Z endif else kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac @@ -988,10 +988,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! set kv_bbl to the bound and recompute bbl_thick to be consistent ! but with a ridiculously large upper bound on thickness (for Cd u*=0) kv_bbl = CS%Kv_BBL_min - if (cdrag_sqrt*ustar(i)*G%Rad_Earth*US%m_to_Z > kv_bbl) then + if (cdrag_sqrt*ustar(i)*G%Rad_Earth_L*US%L_to_Z > kv_bbl) then bbl_thick_Z = kv_bbl / ( cdrag_sqrt*ustar(i) ) else - bbl_thick_Z = G%Rad_Earth * US%m_to_Z + bbl_thick_Z = G%Rad_Earth_L * US%L_to_Z endif else kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z @@ -1134,7 +1134,7 @@ end function set_u_at_v !! A bulk Richardson criterion or the thickness of the topmost NKML layers (with a bulk mixed layer) !! are currently used. The thicknesses are given in terms of fractional layers, so that this !! thickness will move as the thickness of the topmost layers change. -subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetrize) +subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, 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. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1151,11 +1151,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. real, intent(in) :: dt !< Time increment [T ~> s]. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. - logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations - !! of those values in visc that would be - !! calculated with symmetric memory. ! Local variables real, dimension(SZIB_(G)) :: & @@ -1194,7 +1191,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the ! interior layer layer times the depth of the the mixed layer - ! [H2 Z2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. + ! [H2 L2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. @@ -1226,7 +1223,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Rho0 divided by G_Earth and the conversion ! 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]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> nondim] 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, @@ -1254,18 +1251,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(ocean_OBC_type), pointer :: OBC => NULL() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& + if (.not.CS%initialized) 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 - if (present(symmetrize)) then ; if (symmetrize) then - Jsq = js-1 ; Isq = is-1 - endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) @@ -1821,7 +1815,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1910,15 +1904,20 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! output. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. Allocated here. - type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables - real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt - real :: Kv_background - real :: omega_frac_dflt + real :: Csmag_chan_dflt ! The default value for SMAG_CONST_CHANNEL [nondim] + real :: smag_const1 ! The default value for the Smagorinsky Laplacian coefficient [nondim] + real :: TKE_decay_dflt ! The default value of a coeficient scaling the vertical decay + ! rate of TKE [nondim] + real :: bulk_Ri_ML_dflt ! The default bulk Richardson number for a bulk mixed layer [nondim] + real :: Kv_background ! The background kinematic viscosity in the interior [m2 s-1] + real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate that + ! is used in place of the absolute value of the local Coriolis + ! parameter in the denominator of some expressions [nondim] real :: Z_rescale ! A rescaling factor for heights from the representation in ! a restart file to the internal representation in this run. real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run @@ -1930,20 +1929,17 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS logical :: default_2018_answers logical :: use_kappa_shear, adiabatic, use_omega, MLE_use_PBL_MLD logical :: use_KPP - logical :: use_regridding + logical :: use_regridding ! If true, use the ALE algorithm rather than layered + ! isopycnal or stacked shallow water mode. + logical :: use_temperature ! If true, temperature and salinity are used as state variables. + logical :: use_EOS ! If true, density calculated from T & S using an equation of state. character(len=200) :: filename, tideamp_file type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "set_visc_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - + CS%initialized = .true. CS%OBC => OBC is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2071,15 +2067,18 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "USE_REGRIDDING", use_regridding, & - do_not_log = .true., default = .false. ) + do_not_log=.true., default=.false. ) + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & + default=.true., do_not_log=.true.) + call get_param(param_file, mdl, "USE_EOS", use_EOS, & + default=use_temperature, do_not_log=.true.) call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & - "If true, use the equation of state in determining the "//& - "properties of the bottom boundary layer. Otherwise use "//& - "the layer target potential densities. The default of "//& - "this is determined by USE_REGRIDDING.", default=use_regridding) + "If true, use the equation of state in determining the properties of the "//& + "bottom boundary layer. Otherwise use the layer target potential densities. "//& + "The default of this parameter is the value of USE_EOS.", & + default=use_EOS, do_not_log=.not.use_temperature) if (use_regridding .and. (.not. CS%BBL_use_EOS)) & - call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to "//& - "set BBL_USE_EOS to True") + call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to set BBL_USE_EOS to True.") endif call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, & "The minimum bottom boundary layer thickness that can be "//& @@ -2244,7 +2243,7 @@ end subroutine set_visc_init subroutine set_visc_end(visc, CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. Elements are deallocated here. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. if (CS%bottomdraglaw) then deallocate(visc%bbl_thick_u) ; deallocate(visc%bbl_thick_v) @@ -2271,8 +2270,6 @@ subroutine set_visc_end(visc, CS) if (associated(visc%tbl_thick_shelf_v)) deallocate(visc%tbl_thick_shelf_v) if (associated(visc%kv_tbl_shelf_u)) deallocate(visc%kv_tbl_shelf_u) if (associated(visc%kv_tbl_shelf_v)) deallocate(visc%kv_tbl_shelf_v) - - deallocate(CS) end subroutine set_visc_end !> \namespace mom_set_visc diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 2699e57099..d0d64079c3 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -42,14 +42,6 @@ module MOM_sponge logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers and nkbl buffer layer. integer :: nz !< The total number of layers. - integer :: isc !< The starting i-index of the computational domain at h. - integer :: iec !< The ending i-index of the computational domain at h. - integer :: jsc !< The starting j-index of the computational domain at h. - integer :: jec !< The ending j-index of the computational domain at h. - integer :: isd !< The starting i-index of the data domain at h. - integer :: ied !< The ending i-index of the data domain at h. - integer :: jsd !< The starting j-index of the data domain at h. - integer :: jed !< The ending j-index of the data domain at h. integer :: num_col !< The number of sponge points within the computational domain. integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field @@ -80,11 +72,10 @@ module MOM_sponge contains -!> This subroutine determines the number of points which are within -!! sponges in this computational domain. Only points that have -!! positive values of Iresttime and which mask2dT indicates are ocean -!! points are included in the sponges. It also stores the target interface -!! heights. +!> This subroutine determines the number of points which are within sponges in +!! this computational domain. Only points that have positive values of +!! Iresttime and which mask2dT indicates are ocean points are included in the +!! sponges. It also stores the target interface heights. subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -104,8 +95,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & !! damp the zonal mean heights [Z ~> m]. -! 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_sponge" ! This module's name. logical :: use_sponge integer :: i, j, k, col, total_sponge_cols @@ -134,8 +125,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & CS%do_i_mean_sponge = present(Iresttime_i_mean) CS%nz = GV%ke -! CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec -! CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed + ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. @@ -203,13 +193,12 @@ subroutine init_sponge_diags(Time, G, GV, US, 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', conversion=US%s_to_T) + Time, 'The diapycnal motion due to the sponges', 'm s-1', conversion=GV%H_to_m*US%s_to_T) end subroutine init_sponge_diags -!> This subroutine stores the reference profile for the variable -!! whose address is given by f_ptr. nlay is the number of layers in -!! this variable. +!> This subroutine stores the reference profile for the variable whose +!! address is given by f_ptr. nlay is the number of layers in this variable. subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -261,8 +250,8 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz), source=0.0) - do k=1,CS%nz ; do j=CS%jsc,CS%jec + allocate(CS%Ref_val_im(CS%fldno)%p(G%jsd:G%jed,CS%nz), source=0.0) + do k=1,CS%nz ; do j=G%jsc,G%jec CS%Ref_val_im(CS%fldno)%p(j,k) = sp_val_i_mean(j,k) enddo ; enddo endif @@ -278,16 +267,10 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) 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. + ! The contents of this structure are intent(inout) here. real, dimension(SZJ_(G)), & optional, intent(in) :: sp_val_i_mean !< the reference values of the zonal mean mixed !! 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. - -! Arguments: sp_val - The reference values of the mixed layer density. -! (in/out) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. integer :: j, col character(len=256) :: mesg ! String for error messages @@ -309,8 +292,8 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed), source=0.0) - do j=CS%jsc,CS%jec + allocate(CS%Rcv_ml_ref_im(G%jsd:G%jed), source=0.0) + do j=G%jsc,G%jec CS%Rcv_ml_ref_im(j) = sp_val_i_mean(j) enddo endif @@ -339,10 +322,6 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) real, dimension(SZI_(G),SZJ_(G)), & 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 -! there is damping. - ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, @@ -369,17 +348,18 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) real :: e0 ! The height of the free surface [Z ~> m]. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces - ! heights in the two profiles to agree. + ! heights in the two profiles to agree [nondim]. real :: w ! The thickness of water moving upward through an ! interface within 1 timestep [H ~> m or kg m-2]. real :: wm ! wm is w if w is negative and 0 otherwise [H ~> m or kg m-2]. real :: wb ! w at the interface below a layer [H ~> m or kg m-2]. real :: wpb ! wpb is wb if wb is positive and 0 otherwise [H ~> m or kg m-2]. - real :: ea_k, eb_k ! [H ~> m or kg m-2] - real :: damp ! The timestep times the local damping coefficient [nondim]. + real :: ea_k ! Water entrained from above within a timestep [H ~> m or kg m-2] + real :: eb_k ! Water entrained from below within a timestep [H ~> m or kg m-2] + 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 times a height unit conversion factor [m H-1 T-1 ~> s-1 or m3 kg-1 s-1]. + real :: Idt ! The inverse of the timestep [T-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 = GV%ke @@ -575,7 +555,7 @@ subroutine apply_sponge(h, dt, G, GV, US, 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 ! Do any height unit conversion here for efficiency. + Idt = 1.0 / dt 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 3b26d60451..be574b4356 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -12,6 +12,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, MOM_read_data, field_size +use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_string_functions, only : uppercase, lowercase use MOM_unit_scaling, only : unit_scale_type @@ -42,30 +43,27 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private - real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 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 [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 [T-2 ~> 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? - real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, - !! interpolated to model vertical coordinate [W m-3?] - real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. - real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent - !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] - real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [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 [Z ~> m] - Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [Z ~> m] - Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient - + real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] + real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Kd_Niku_work(:,:,:) !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] + real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] + real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] + real, allocatable :: N2_int(:,:,:) !< Bouyancy frequency squared at interfaces [T-2 ~> s-2] + real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition [W m-3] + real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme, in UNITS? + real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, + !! interpolated to model vertical coordinate [W m-3?] + real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces + !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Fl_lowmode(:,:,:) !< vertical flux of tidal turbulent + !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] + real, allocatable :: TKE_itidal_used(:,:) !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] + real, allocatable :: N2_bot(:,:) !< bottom squared buoyancy frequency [T-2 ~> s-2] + real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2] + real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m] + real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal diss with Polzin [Z ~> m] + real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient end type !> Control structure with parameters for the tidal mixing module. @@ -146,21 +144,23 @@ module MOM_tidal_mixing !! recover the remapping answers from 2018. If false, use more !! robust forms of the same remapping expressions. + type(int_tide_CS), pointer :: int_tide_CSp=> NULL() !< Control structure for a child module + ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input - !! [R Z3 T-3 ~> W m-2] - real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided - !! 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 [Z2 ~> m2]. - real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [Z T-1 ~> m s-1] - real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] - real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation - !! fraction, q*E(x,y), with the CVMix implementation - !! of Jayne et al tidal mixing [W m-2]. - !! TODO: make this E(x,y) only - real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + real, allocatable :: TKE_Niku(:,:) !< Lee wave driven Turbulent Kinetic Energy input + !! [R Z3 T-3 ~> W m-2] + real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided + !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. + real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1]. + real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input + real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2]. + real, allocatable :: tideamp(:,:) !< RMS tidal amplitude [Z T-1 ~> m s-1] + real, allocatable :: h_src(:) !< tidal constituent input layer thickness [m] + real, allocatable :: tidal_qe_2d(:,:) !< Tidal energy input times the local dissipation + !! fraction, q*E(x,y), with the CVMix implementation + !! of Jayne et al tidal mixing [W m-2]. + !! TODO: make this E(x,y) only + real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the !! answers from the end of 2018. Otherwise, use updated and more robust @@ -168,7 +168,7 @@ module MOM_tidal_mixing ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing - type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays + type(tidal_mixing_diags) :: dd !< Tidal mixing diagnostic arrays !>@{ Diagnostic identifiers integer :: id_TKE_itidal = -1 @@ -209,14 +209,15 @@ module MOM_tidal_mixing contains !> Initializes internal tidal dissipation scheme for diapycnal mixing -logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) +logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, diag, CS) type(time_type), intent(in) :: Time !< The current time. 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 type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(int_tide_CS),target, intent(in) :: int_tide_CSp !< A pointer to the internal tides control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. ! Local variables logical :: use_CVMix_tidal @@ -236,12 +237,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) # include "version_variable.h" character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & - "is already associated.") - return - endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -268,10 +263,9 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) tidal_mixing_init = int_tide_dissipation if (.not. tidal_mixing_init) return - allocate(CS) - allocate(CS%dd) CS%debug = CS%debug.and.is_root_pe() CS%diag => diag + CS%int_tide_CSp => int_tide_CSp CS%use_CVmix_tidal = use_CVmix_tidal CS%int_tide_dissipation = int_tide_dissipation @@ -314,7 +308,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) endif ! CS%use_CVMix_tidal ! Read in vertical profile of tidal energy dissipation - if ( CS%CVMix_tidal_scheme.eq.SCHMITTNER .or. .not. CS%use_CVMix_tidal) then + if ( CS%CVMix_tidal_scheme == SCHMITTNER .or. .not. CS%use_CVMix_tidal) then call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy "//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& @@ -431,10 +425,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & .not. CS%use_CVMix_tidal) then - call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%TKE_itidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 + allocate(CS%Nb(isd:ied,jsd:jed), source=0.) + allocate(CS%h2(isd:ied,jsd:jed), source=0.) + allocate(CS%TKE_itidal(isd:ied,jsd:jed), source=0.) + allocate(CS%mask_itidal(isd:ied,jsd:jed), source=1.) call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& @@ -444,7 +438,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 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, scale=US%m_to_Z*US%T_to_s) - call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide + allocate(CS%tideamp(is:ie,js:je), source=CS%utide) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & "A scaling factor for the roughness amplitude with "//& @@ -519,7 +513,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & filename) - call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je) ; CS%TKE_Niku(:,:) = 0.0 + allocate(CS%TKE_Niku(is:ie,js:je), source=0.) call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja scale=Niku_scale*US%W_m2_to_RZ3_T3) @@ -568,8 +562,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) fail_if_missing=.true.) ! Check whether tidal energy input format and CVMix tidal mixing scheme are consistent if ( .not. ( & - (uppercase(tidal_energy_type(1:4)).eq.'JAYN' .and. CS%CVMix_tidal_scheme.eq.SIMMONS).or. & - (uppercase(tidal_energy_type(1:4)).eq.'ER03' .and. CS%CVMix_tidal_scheme.eq.SCHMITTNER) ) )then + (uppercase(tidal_energy_type(1:4)) == 'JAYN' .and. CS%CVMix_tidal_scheme == SIMMONS).or. & + (uppercase(tidal_energy_type(1:4)) == 'ER03' .and. CS%CVMix_tidal_scheme == SCHMITTNER) ) )then call MOM_error(FATAL, "tidal_mixing_init: Tidal energy file type ("//& trim(tidal_energy_type)//") is incompatible with CVMix tidal "//& " mixing scheme: "//trim(CVMix_tidal_scheme_str) ) @@ -674,20 +668,20 @@ end function tidal_mixing_init !> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. -subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & - N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) +subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kv, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the !! interfaces [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, @@ -695,25 +689,25 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, - !! [Z2 T-1 ~> m2 s-1]. + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)), & + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)+1), & + optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, + !! [Z2 T-1 ~> m2 s-1]. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) + call calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) else - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & - G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) + call add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kd_lay, Kd_int) endif endif end subroutine calculate_tidal_mixing @@ -721,22 +715,22 @@ end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) - integer, intent(in) :: j !< The j-index to work on +subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) 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 - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy - !! frequency at the interfaces [T-2 ~> s-2]. + type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + integer, intent(in) :: j !< The j-index to work on + real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy + !! frequency at the interfaces [T-2 ~> s-2]. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] @@ -753,12 +747,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff - real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] + real, parameter :: rho_fw = 1000.0 ! fresh water density [kg m-3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) - type(tidal_mixing_diags), pointer :: dd => NULL() is = G%isc ; ie = G%iec - dd => CS%dd select case (CS%CVMix_tidal_scheme) case (SIMMONS) @@ -828,17 +820,17 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv endif ! diagnostics - if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + if (allocated(CS%dd%Kd_itidal)) then + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif - if (associated(dd%N2_int)) then - dd%N2_int(i,j,:) = N2_int(i,:) + if (allocated(CS%dd%N2_int)) then + CS%dd%N2_int(i,j,:) = N2_int(i,:) endif - if (associated(dd%Simmons_coeff_2d)) then - dd%Simmons_coeff_2d(i,j) = Simmons_coeff + if (allocated(CS%dd%Simmons_coeff_2d)) then + CS%dd%Simmons_coeff_2d(i,j) = Simmons_coeff endif - if (associated(dd%vert_dep_3d)) then - dd%vert_dep_3d(i,j,:) = vert_dep(:) + if (allocated(CS%dd%vert_dep_3d)) then + CS%dd%vert_dep_3d(i,j,:) = vert_dep(:) endif enddo ! i=is,ie @@ -929,20 +921,20 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv endif ! diagnostics - if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + if (allocated(CS%dd%Kd_itidal)) then + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif - if (associated(dd%N2_int)) then - dd%N2_int(i,j,:) = N2_int(i,:) + if (allocated(CS%dd%N2_int)) then + CS%dd%N2_int(i,j,:) = N2_int(i,:) endif - if (associated(dd%Schmittner_coeff_3d)) then - dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) + if (allocated(CS%dd%Schmittner_coeff_3d)) then + CS%dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) endif - if (associated(dd%tidal_qe_md)) then - dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) + if (allocated(CS%dd%tidal_qe_md)) then + CS%dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) endif - if (associated(dd%vert_dep_3d)) then - dd%vert_dep_3d(i,j,:) = vert_dep(:) + if (allocated(CS%dd%vert_dep_3d)) then + CS%dd%vert_dep_3d(i,j,:) = vert_dep(:) endif enddo ! i=is,ie @@ -962,18 +954,18 @@ end subroutine calculate_CVMix_tidal !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). -subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & - N2_lay, Kd_lay, Kd_int, Kd_max) +subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, @@ -981,16 +973,16 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module + real, intent(in) :: Kd_max !< The maximum increment for diapycnal + !! diffusivity due to TKE-based processes + !! [Z2 T-1 ~> m2 s-1]. + !! Set this to a negative value to have no limit. real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces !! [Z2 T-1 ~> m2 s-1]. - real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes - !! [Z2 T-1 ~> m2 s-1]. - !! Set this to a negative value to have no limit. ! local @@ -1009,7 +1001,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz - N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2] for WKB scaling + N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2 ~> s-2] for WKB scaling TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [Z3 T-3 ~> m3 s-3] TKE_Niku_rem, & ! remaining lee-wave TKE [Z3 T-3 ~> m3 s-3] TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [Z3 T-3 ~> m3 s-3] (BDM) @@ -1037,10 +1029,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, character(len=160) :: mesg ! The text of an error message integer :: i, k, is, ie, nz integer :: a, fr, m - type(tidal_mixing_diags), pointer :: dd => NULL() is = G%isc ; ie = G%iec ; nz = GV%ke - dd => CS%dd if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return @@ -1066,7 +1056,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, GV%H_subroundoff*GV%H_to_Z) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) + if (allocated(CS%dd%N2_bot)) & + CS%dd%N2_bot(i,j) = N2_bot(i) if ( CS%Int_tide_dissipation ) then if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) @@ -1095,7 +1086,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) - if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) + if (allocated(CS%dd%N2_meanz)) & + CS%dd%N2_meanz(i,j) = N2_meanz(i) enddo ! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling @@ -1146,11 +1138,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, endif endif - if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = z0_polzin(i) - if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) + if (allocated(CS%dd%Polzin_decay_scale)) & + CS%dd%Polzin_decay_scale(i,j) = z0_polzin(i) + if (allocated(CS%dd%Polzin_decay_scale_scaled)) & + CS%dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + if (allocated(CS%dd%N2_bot)) & + CS%dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if (CS%answers_2018) then ! These expressions use dimensional constants to avoid NaN values. @@ -1202,8 +1195,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ! Dissipation of locally trapped internal tide (non-propagating high modes) TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) - if (associated(dd%TKE_itidal_used)) & - dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) + if (allocated(CS%dd%TKE_itidal_used)) & + CS%dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) ! Dissipation of locally trapped lee waves TKE_Niku_bot(i) = 0.0 @@ -1215,12 +1208,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_bot(i) = 0.0 if (CS%Lowmode_itidal_dissipation) then ! get loss rate due to wave drag on low modes (already multiplied by q) - - ! TODO: uncomment the following call and fix it - !call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) - write (mesg,*) "========", __FILE__, __LINE__ - call MOM_error(FATAL,trim(mesg)//": this block not supported yet. (aa)") - + call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot endif ! Vertical energy flux at bottom @@ -1228,7 +1216,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_Niku_rem(i) = Inv_int_lee(i) * TKE_Niku_bot(i) TKE_lowmode_rem(i) = Inv_int_low(i) * TKE_lowmode_bot(i) - if (associated(dd%Fl_itidal)) dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM + if (allocated(CS%dd%Fl_itidal)) & + CS%dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM enddo ! Estimate the work that would be done by mixing in each layer. @@ -1276,42 +1265,43 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, endif ! diagnostics - if (associated(dd%Kd_itidal)) then - ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay + if (allocated(CS%dd%Kd_itidal)) then + ! If at layers, CS%dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_itidal(i,j,K) = CS%dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_Niku(i,j,K) = CS%dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_lowmode(i,j,K) = CS%dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_itidal(i,j,K) = CS%dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_Niku(i,j,K) = CS%dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_lowmode(i,j,K) = CS%dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k NULL() isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = GV%ke - dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) & - allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) & - allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Fl_itidal > 0) allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Fl_lowmode > 0) allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Polzin_decay_scale > 0) allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) - if (CS%id_N2_bot > 0) allocate(dd%N2_bot(isd:ied,jsd:jed), source=0.0) - if (CS%id_N2_meanz > 0) allocate(dd%N2_meanz(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_itidal > 0) allocate(CS%dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_lowmode > 0) allocate(CS%dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Polzin_decay_scale > 0) allocate(CS%dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_bot > 0) allocate(CS%dd%N2_bot(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_meanz > 0) allocate(CS%dd%N2_meanz(isd:ied,jsd:jed), source=0.0) if (CS%id_Polzin_decay_scale_scaled > 0) & - allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) & - allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Kd_Niku_work > 0) allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_Kd_Itidal_work > 0) allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_Kd_Lowmode_Work > 0) allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_TKE_itidal > 0) allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) + allocate(CS%dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_Niku_work > 0) allocate(CS%dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Itidal_work > 0) allocate(CS%dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Lowmode_Work > 0) allocate(CS%dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_itidal > 0) allocate(CS%dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) ! additional diags for CVMix - if (CS%id_N2_int > 0) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_N2_int > 0) allocate(CS%dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SIMMONS) then + if (CS%CVMix_tidal_scheme /= SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif - allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) endif - if (CS%id_vert_dep > 0) allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_vert_dep > 0) allocate(CS%dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) endif end subroutine setup_tidal_diagnostics @@ -1475,63 +1463,57 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - - ! local - type(tidal_mixing_diags), pointer :: dd => NULL() - - dd => CS%dd + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then - if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, dd%TKE_itidal_used, CS%diag) + if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, CS%dd%TKE_itidal_used, CS%diag) if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, CS%TKE_Niku, CS%diag) if (CS%id_Nb > 0) call post_data(CS%id_Nb, CS%Nb, CS%diag) - if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, dd%N2_bot, CS%diag) - if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,dd%N2_meanz,CS%diag) + if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, CS%dd%N2_bot, CS%diag) + if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,CS%dd%N2_meanz,CS%diag) - if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, dd%Fl_itidal, CS%diag) - if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, dd%Kd_itidal, CS%diag) - if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, dd%Kd_Niku, CS%diag) - if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, dd%Kd_lowmode, CS%diag) - if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, dd%Fl_lowmode, CS%diag) + if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, CS%dd%Fl_itidal, CS%diag) + if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, CS%dd%Kd_itidal, CS%diag) + if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, CS%dd%Kd_Niku, CS%diag) + if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, CS%dd%Kd_lowmode, CS%diag) + if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, CS%dd%Fl_lowmode, CS%diag) - if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, dd%N2_int, CS%diag) - if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) - if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) - if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) - if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, dd%tidal_qe_md, CS%diag) + if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, CS%dd%N2_int, CS%diag) + if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, CS%dd%vert_dep_3d, CS%diag) + if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, CS%dd%Simmons_coeff_2d, CS%diag) + if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, CS%dd%Schmittner_coeff_3d, CS%diag) + if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, CS%dd%tidal_qe_md, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & - call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) - if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, dd%Kd_Niku_Work, CS%diag) + call post_data(CS%id_Kd_Itidal_Work, CS%dd%Kd_Itidal_Work, CS%diag) + if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, CS%dd%Kd_Niku_Work, CS%diag) if (CS%id_Kd_Lowmode_Work > 0) & - call post_data(CS%id_Kd_Lowmode_Work, dd%Kd_Lowmode_Work, CS%diag) + call post_data(CS%id_Kd_Lowmode_Work, CS%dd%Kd_Lowmode_Work, CS%diag) if (CS%id_Polzin_decay_scale > 0 ) & - call post_data(CS%id_Polzin_decay_scale, dd%Polzin_decay_scale, CS%diag) + call post_data(CS%id_Polzin_decay_scale, CS%dd%Polzin_decay_scale, CS%diag) if (CS%id_Polzin_decay_scale_scaled > 0 ) & - call post_data(CS%id_Polzin_decay_scale_scaled, dd%Polzin_decay_scale_scaled, CS%diag) + call post_data(CS%id_Polzin_decay_scale_scaled, CS%dd%Polzin_decay_scale_scaled, CS%diag) endif - if (associated(dd%Kd_itidal)) deallocate(dd%Kd_itidal) - if (associated(dd%Kd_lowmode)) deallocate(dd%Kd_lowmode) - if (associated(dd%Fl_itidal)) deallocate(dd%Fl_itidal) - if (associated(dd%Fl_lowmode)) deallocate(dd%Fl_lowmode) - if (associated(dd%Polzin_decay_scale)) deallocate(dd%Polzin_decay_scale) - if (associated(dd%Polzin_decay_scale_scaled)) deallocate(dd%Polzin_decay_scale_scaled) - if (associated(dd%N2_bot)) deallocate(dd%N2_bot) - if (associated(dd%N2_meanz)) deallocate(dd%N2_meanz) - if (associated(dd%Kd_Niku)) deallocate(dd%Kd_Niku) - if (associated(dd%Kd_Niku_work)) deallocate(dd%Kd_Niku_work) - if (associated(dd%Kd_Itidal_Work)) deallocate(dd%Kd_Itidal_Work) - if (associated(dd%Kd_Lowmode_Work)) deallocate(dd%Kd_Lowmode_Work) - if (associated(dd%TKE_itidal_used)) deallocate(dd%TKE_itidal_used) - if (associated(dd%N2_int)) deallocate(dd%N2_int) - if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) - if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) - if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) - if (associated(dd%tidal_qe_md)) deallocate(dd%tidal_qe_md) - + if (allocated(CS%dd%Kd_itidal)) deallocate(CS%dd%Kd_itidal) + if (allocated(CS%dd%Kd_lowmode)) deallocate(CS%dd%Kd_lowmode) + if (allocated(CS%dd%Fl_itidal)) deallocate(CS%dd%Fl_itidal) + if (allocated(CS%dd%Fl_lowmode)) deallocate(CS%dd%Fl_lowmode) + if (allocated(CS%dd%Polzin_decay_scale)) deallocate(CS%dd%Polzin_decay_scale) + if (allocated(CS%dd%Polzin_decay_scale_scaled)) deallocate(CS%dd%Polzin_decay_scale_scaled) + if (allocated(CS%dd%N2_bot)) deallocate(CS%dd%N2_bot) + if (allocated(CS%dd%N2_meanz)) deallocate(CS%dd%N2_meanz) + if (allocated(CS%dd%Kd_Niku)) deallocate(CS%dd%Kd_Niku) + if (allocated(CS%dd%Kd_Niku_work)) deallocate(CS%dd%Kd_Niku_work) + if (allocated(CS%dd%Kd_Itidal_Work)) deallocate(CS%dd%Kd_Itidal_Work) + if (allocated(CS%dd%Kd_Lowmode_Work)) deallocate(CS%dd%Kd_Lowmode_Work) + if (allocated(CS%dd%TKE_itidal_used)) deallocate(CS%dd%TKE_itidal_used) + if (allocated(CS%dd%N2_int)) deallocate(CS%dd%N2_int) + if (allocated(CS%dd%vert_dep_3d)) deallocate(CS%dd%vert_dep_3d) + if (allocated(CS%dd%Simmons_coeff_2d)) deallocate(CS%dd%Simmons_coeff_2d) + if (allocated(CS%dd%Schmittner_coeff_3d)) deallocate(CS%dd%Schmittner_coeff_3d) + if (allocated(CS%dd%tidal_qe_md)) deallocate(CS%dd%tidal_qe_md) end subroutine post_tidal_diagnostics !> This subroutine returns a zonal slice of the topographic roughness amplitudes @@ -1539,7 +1521,7 @@ subroutine tidal_mixing_h_amp(h_amp, G, j, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G)), intent(out) :: h_amp !< The topographic roughness amplitude [Z ~> m] integer, intent(in) :: j !< j-index of the row to work on - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(in) :: CS !< The control structure for this module integer :: i @@ -1559,7 +1541,7 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local integer :: i, j, isd, ied, jsd, jed real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] @@ -1588,7 +1570,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidal energy inputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local variables real, parameter :: C1_3 = 1.0/3.0 @@ -1596,13 +1578,13 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert real, allocatable, dimension(:) :: & - z_t, & ! depth from surface to midpoint of input layer [Z] - z_w ! depth from surface to top of input layer [Z] + z_t, & ! depth from surface to midpoint of input layer [Z ~> m] + z_w ! depth from surface to top of input layer [Z ~> m] real, allocatable, dimension(:,:,:) :: & - tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] - tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] - tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] - tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] + tc_m2, & ! input lunar semidiurnal tidal energy flux [W m-2] + tc_s2, & ! input solar semidiurnal tidal energy flux [W m-2] + tc_k1, & ! input lunar diurnal tidal energy flux [W m-2] + tc_o1 ! input lunar diurnal tidal energy flux [W m-2] integer, dimension(4) :: nz_in integer :: k, is, ie, js, je, isd, ied, jsd, jed, i, j @@ -1654,21 +1636,6 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) enddo ; enddo enddo - !open(unit=1905,file="out_1905.txt",access="APPEND") - !do j=G%jsd,G%jed - ! do i=isd,ied - ! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then - ! write(1905,*) "-------------------------------------------" - ! do k=50,nz_in(1) - ! write(1905,*) i,j,k - ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j)+G%Z_ref, z_w(k),CS%tidal_diss_lim_tc - ! end do - ! endif - ! enddo - !enddo - !close(1905) - ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") @@ -1695,7 +1662,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) end subroutine read_tidal_constituents -!> Clear pointers and deallocate memory +!> Deallocate fields subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure, which !! will be deallocated in this routine. @@ -1704,7 +1671,6 @@ subroutine tidal_mixing_end(CS) if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) if (allocated(CS%h_src)) deallocate(CS%h_src) - deallocate(CS%dd) end subroutine tidal_mixing_end end module MOM_tidal_mixing diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f9512d8c06..d384500c3d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -4,23 +4,25 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domains, only : pass_var, To_All, Omit_corners use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl -use MOM_debugging, only : uvchksum, hchksum +use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : mech_forcing -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : mech_forcing +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S -use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init -use MOM_PointAccel, only : PointAccel_CS -use MOM_time_manager, only : time_type, time_type_to_real, operator(-) -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type -use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs -use MOM_variables, only : ocean_internal_state -use MOM_verticalGrid, only : verticalGrid_type +use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init +use MOM_PointAccel, only : PointAccel_CS +use MOM_time_manager, only : time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs +use MOM_variables, only : ocean_internal_state +use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS implicit none ; private @@ -37,6 +39,7 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. @@ -53,12 +56,12 @@ module MOM_vert_friction !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they !! are large enough that the corresponding CFL number - !! exceeds this value, nondim. + !! exceeds this value [nondim]. real :: CFL_report !< The value of the CFL number that will cause the - !! accelerations to be reported, nondim. CFL_report + !! accelerations to be reported [nondim]. CFL_report !! will often equal CFL_trunc. real :: truncRampTime !< The time-scale over which to ramp up the value of - !! CFL_trunc from CFL_truncS to CFL_truncE + !! CFL_trunc from CFL_truncS to CFL_truncE [T ~> s] real :: CFL_truncS !< The start value of CFL_trunc real :: CFL_truncE !< The end/target value of CFL_trunc logical :: CFLrampingIsActivated = .false. !< True if the ramping has been initialized @@ -102,7 +105,7 @@ module MOM_vert_friction !! thickness for viscosity. logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the !! answers from the end of 2018. Otherwise, use expressions that do not - !! use an arbitary and hard-coded maximum viscous coupling coefficient + !! use an arbitrary and hard-coded maximum viscous coupling coefficient !! between layers. logical :: debug !< If true, write verbose checksums for debugging purposes. integer :: nkml !< The number of layers in the mixed layer. @@ -128,16 +131,13 @@ module MOM_vert_friction ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 + integer :: id_h_du_dt_str = -1, id_h_dv_dt_str = -1 + integer :: id_du_dt_str_visc_rem = -1, id_dv_dt_str_visc_rem = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure !! for recording accelerations leading to velocity truncations - ! real, pointer :: hf_du_dt_visc(:,:,:) => NULL() ! Zonal friction accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, pointer :: hf_dv_dt_visc(:,:,:) => NULL() ! Merdional friction accel. x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - end type vertvisc_CS contains @@ -214,12 +214,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. - real, allocatable, dimension(:,:) :: hf_du_dt_visc_2d ! Depth sum of hf_du_dt_visc [L T-2 ~> m s-2] - real, allocatable, dimension(:,:) :: hf_dv_dt_visc_2d ! Depth sum of hf_dv_dt_visc [L T-2 ~> m s-2] - - real, allocatable, dimension(:,:,:) :: h_du_dt_visc ! h x du_dt_visc [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt_visc ! h x dv_dt_visc [H L T-2 ~> m2 s-2] - logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -230,6 +224,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & + "Module must be initialized before it is used.") + if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix @@ -515,54 +512,36 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (CS%id_dv_dt_str > 0) & call post_data(CS%id_dv_dt_str, ADp%dv_dt_str, CS%diag) - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (CS%id_hf_du_dt_visc > 0) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_du_dt_visc, CS%hf_du_dt_visc, CS%diag) - !endif - !if (CS%id_hf_dv_dt_visc > 0) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_dv_dt_visc, CS%hf_dv_dt_visc, CS%diag) - !endif - if (CS%id_hf_du_dt_visc_2d > 0) then - allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_du_dt_visc_2d(I,j) = hf_du_dt_visc_2d(I,j) + ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_du_dt_visc_2d, hf_du_dt_visc_2d, CS%diag) - deallocate(hf_du_dt_visc_2d) - endif - if (CS%id_hf_dv_dt_visc_2d > 0) then - allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dv_dt_visc_2d(i,J) = hf_dv_dt_visc_2d(i,J) + ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dv_dt_visc_2d, hf_dv_dt_visc_2d, CS%diag) - deallocate(hf_dv_dt_visc_2d) + if (associated(ADp%du_dt_visc) .and. associated(ADp%du_dt_visc)) then + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_du_dt_visc > 0) & + ! call post_product_u(CS%id_hf_du_dt_visc, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_dv_dt_visc > 0) & + ! call post_product_v(CS%id_hf_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged viscous accelerations + if (CS%id_hf_du_dt_visc_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_visc_2d, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_visc_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_visc_2d, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x viscous accelerations + if (CS%id_h_du_dt_visc > 0) call post_product_u(CS%id_h_du_dt_visc, ADp%du_dt_visc, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_visc > 0) call post_product_v(CS%id_h_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hv, G, nz, CS%diag) endif - if (CS%id_h_du_dt_visc > 0) then - allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt_visc, h_du_dt_visc, CS%diag) - deallocate(h_du_dt_visc) - endif - if (CS%id_h_dv_dt_visc > 0) then - allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt_visc, h_dv_dt_visc, CS%diag) - deallocate(h_dv_dt_visc) + if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then + ! Diagnostics for thickness x wind stress accelerations + if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for wind stress accelerations multiplied by visc_rem_[uv], + if (CS%id_du_dt_str_visc_rem > 0) & + call post_product_u(CS%id_du_dt_str_visc_rem, ADp%du_dt_str, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_dv_dt_str_visc_rem > 0) & + call post_product_v(CS%id_dv_dt_str_visc_rem, ADp%dv_dt_str, ADp%visc_rem_v, G, nz, CS%diag) endif end subroutine vertvisc @@ -576,11 +555,11 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: visc_rem_u !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences after + !! barotropic acceleration that a layer experiences after !! viscosity is applied in the zonal direction [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences after + !! barotropic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -604,6 +583,9 @@ 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.") + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(remant): "// & + "Module must be initialized before it is used.") + dt_Z_to_H = dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -710,7 +692,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, - ! normalized by the bottom boundary layer thickness, nondim. + ! normalized by the bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. @@ -733,10 +715,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more ! than Htbl into the interior. - real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. + real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2]. - real :: a_cpl_max ! The maximum drag doefficient across interfaces, set so that it will be + real :: a_cpl_max ! The maximum drag coefficient across interfaces, set so that it will be ! representable as a 32-bit float in MKS units [Z T-1 ~> m s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -756,6 +738,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(coef): "// & "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(coef): "// & + "Module must be initialized before it is used.") + h_neglect = GV%H_subroundoff a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) @@ -1208,7 +1193,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_neglect = GV%H_subroundoff if (CS%answers_2018) then - ! The maximum coupling coefficent was originally introduced to avoid + ! The maximum coupling coefficient 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 @@ -1437,7 +1422,6 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. 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 [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_(GV)) ! The previous u-velocity [L T-1 ~> m s-1] real :: v_old(SZI_(G),SZJB_(G),SZK_(GV)) ! The previous v-velocity [L T-1 ~> m s-1] @@ -1449,7 +1433,6 @@ 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_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) @@ -1532,7 +1515,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & - vel_report(I,j), forces%taux(I,j)*dt_Rho0, a=CS%a_u, hv=CS%h_u) + vel_report(I,j), forces%taux(I,j), a=CS%a_u, hv=CS%h_u) endif ; enddo ; enddo endif @@ -1617,7 +1600,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & - vel_report(i,J), forces%tauy(i,J)*dt_Rho0, a=CS%a_v, hv=CS%h_v) + vel_report(i,J), forces%tauy(i,J), a=CS%a_v, hv=CS%h_v) endif ; enddo ; enddo endif @@ -1660,6 +1643,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & endif allocate(CS) + CS%initialized = .true. + if (GV%Boussinesq) then; thickness_units = "m" else; thickness_units = "kg m-2"; endif @@ -1774,7 +1759,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & "The time over which the CFL truncation value is ramped "//& "up at the beginning of the run.", & - units="s", default=0.) + units="s", default=0., scale=US%s_to_T) CS%CFL_truncE = CS%CFL_trunc call get_param(param_file, mdl, "CFL_TRUNCATE_START", CS%CFL_truncS, & "The start value of the truncation CFL number used when "//& @@ -1868,7 +1853,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! 'Fractional Thickness-weighted Zonal Acceleration from Vertical Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if (CS%id_hf_du_dt_visc > 0) then - ! call safe_alloc_ptr(CS%hf_du_dt_visc,IsdB,IedB,jsd,jed,nz) ! call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) !endif @@ -1877,7 +1861,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! 'Fractional Thickness-weighted Meridional Acceleration from Vertical Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if (CS%id_hf_dv_dt_visc > 0) then - ! call safe_alloc_ptr(CS%hf_dv_dt_visc,isd,ied,JsdB,JedB,nz) ! call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) !endif @@ -1899,21 +1882,53 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & endif CS%id_h_du_dt_visc = register_diag_field('ocean_model', 'h_du_dt_visc', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt_visc > 0) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) endif CS%id_h_dv_dt_visc = register_diag_field('ocean_model', 'h_dv_dt_visc', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt_visc > 0) then call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) endif + CS%id_h_du_dt_str = register_diag_field('ocean_model', 'h_du_dt_str', diag%axesCuL, Time, & + 'Thickness Multiplied Zonal Acceleration from Surface Wind Stresses', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_du_dt_str > 0) then + call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + endif + + CS%id_h_dv_dt_str = register_diag_field('ocean_model', 'h_dv_dt_str', diag%axesCvL, Time, & + 'Thickness Multiplied Meridional Acceleration from Surface Wind Stresses', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_dv_dt_str > 0) then + call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) + endif + + CS%id_du_dt_str_visc_rem = register_diag_field('ocean_model', 'du_dt_str_visc_rem', diag%axesCuL, Time, & + 'Zonal Acceleration from Surface Wind Stresses multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_du_dt_str_visc_rem > 0) then + call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + endif + + CS%id_dv_dt_str_visc_rem = register_diag_field('ocean_model', 'dv_dt_str_visc_rem', diag%axesCvL, Time, & + 'Meridional Acceleration from Surface Wind Stresses multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_dv_dt_str_visc_rem > 0) then + call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + endif + 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) @@ -1922,14 +1937,16 @@ end subroutine vertvisc_init !> Update the CFL truncation value as a function of time. !! If called with the optional argument activate=.true., record the !! value of Time as the beginning of the ramp period. -subroutine updateCFLtruncationValue(Time, CS, activate) +subroutine updateCFLtruncationValue(Time, CS, US, activate) type(time_type), target, intent(in) :: Time !< Current model time type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime, wghtA + real :: deltaTime ! The time since CS%rampStartTime [T ~> s], which may be negative. + real :: wghtA ! The relative weight of the final value [nondim] character(len=12) :: msg if (CS%truncRampTime==0.) return ! This indicates to ramping is turned off @@ -1943,7 +1960,7 @@ subroutine updateCFLtruncationValue(Time, CS, activate) endif endif if (.not.CS%CFLrampingIsActivated) return - deltaTime = max( 0., time_type_to_real( Time - CS%rampStartTime ) ) + deltaTime = max( 0., US%s_to_T*time_type_to_real( Time - CS%rampStartTime ) ) if (deltaTime >= CS%truncRampTime) then CS%CFL_trunc = CS%CFL_truncE CS%truncRampTime = 0. ! This turns off ramping after this call @@ -1951,7 +1968,7 @@ subroutine updateCFLtruncationValue(Time, CS, activate) wghtA = min( 1., deltaTime / CS%truncRampTime ) ! Linear profile in time !wghtA = wghtA*wghtA ! Convert linear profile to parabolic profile in time !wghtA = wghtA*wghtA*(3. - 2.*wghtA) ! Convert linear profile to cosine profile - wghtA = 1. - ( (1. - wghtA)**2 ) ! Convert linear profiel to nverted parabolic profile + wghtA = 1. - ( (1. - wghtA)**2 ) ! Convert linear profile to inverted parabolic profile CS%CFL_trunc = CS%CFL_truncS + wghtA * ( CS%CFL_truncE - CS%CFL_truncS ) endif write(msg(1:12),'(es12.3)') CS%CFL_trunc diff --git a/src/parameterizations/vertical/_BML.dox b/src/parameterizations/vertical/_BML.dox new file mode 100644 index 0000000000..2786a26851 --- /dev/null +++ b/src/parameterizations/vertical/_BML.dox @@ -0,0 +1,49 @@ +/*! \page BML Bulk Surface Mixed Layer + +This bulk surface mixed layer scheme was designed to be used with a +purely isopycnal model. Following \cite niiler1977, \cite oberhuber1993, +and Hallberg (\cite muller2003) the TKE budget is used to construct a +time-evolving homogeneous mixed layer. A buffer layer sits between +the mixed layer and the interior ocean to mediate between the two. + + The following processes are executed, in the order listed. + +\li 1. Undergo convective adjustment into mixed layer. +\li 2. Apply surface heating and cooling. +\li 3. Starting from the top, entrain whatever fluid the TKE budget + permits. Penetrating shortwave radiation is also applied at + this point. +\li 4. If there is any unentrained fluid that was formerly in the + mixed layer, detrain this fluid into the buffer layer. This + is equivalent to the mixed layer detraining to the Monin- + Obukhov depth. +\li 5. Divide the fluid in the mixed layer evenly into CS\%nkml pieces. +\li 6. Split the buffer layer if appropriate. + +Layers 1 to nkml are the mixed layer, nkml+1 to nkml+nkbl are the +buffer layers. The results of this subroutine are mathematically +identical if there are multiple pieces of the mixed layer with +the same density or if there is just a single layer. There is no +stability limit on the time step. + +The key parameters for the mixed layer are found in the control structure. +These include mstar, nstar, nstar2, pen\_SW\_frac, pen\_SW\_scale, and TKE\_decay. +For the \cite oberhuber1993 and \cite kraus1967 mixed layers, the values of these are: + + + +
Model variables used in the bulk mixed layer
Symbol Value in Oberhuber (1993) Value in Kraus-Turner (1967) +
pen\_SW\_frac 0.42 0.0 +
pen\_SW\_scale 15.0 m 0.0 m +
mstar 1.25 1.25 +
nstar 1 0.4 +
TKE\_decay 2.5 0.0 +
conv\_decay 0.5 0.0 +
+ +TKE\_decay is \f$1/\kappa\f$ in eq. 28 of \cite oberhuber1993, while +conv\_decay is \f$1/\mu\f$. Conv\_decay has been eliminated in favor of +the well-calibrated form for the efficiency of penetrating convection +from \cite wang2003. + +*/ diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox new file mode 100644 index 0000000000..d531c9ad9a --- /dev/null +++ b/src/parameterizations/vertical/_EPBL.dox @@ -0,0 +1,254 @@ +/*! \page EPBL Energetically-constrained Planetary Boundary Layer + +We here describe a scheme for modeling the ocean surface boundary layer +(OSBL) suitable for use in global climate models. It builds on the ideas in +\ref BML, bringing in some of the ideas from \ref subsection_kappa_shear, to +make an energetically consistent boundary layer suitable for use with +a generalized vertical coordinate. Unlike in \ref BML, variables are +allowed to have vertical structure within the boundary layer. The downward +turbulent flux of buoyant water by OSBL turbulence converts mechanical +energy into potential energy as it mixes with less buoyant water at the +base of the OSBL. As described in \cite reichl2018, we focus on OSBL +parameterizations that constrain this integrated potential energy +conversion due to turbulent mixing. + +The leading-order mean OSBL equation for arbitrary scalar \f$\phi\f$ is: + +\f[ + \frac{\partial \overline{\phi}}{\partial t} = - \frac{\partial}{\partial z} + \overline{w^\prime \phi^\prime} + \nu_\phi \frac{\partial^2 \overline{\phi}}{\partial z^2} +\f] + +where the symbols are as follows: + + + +
Symbols used in TKE equation
Symbol Meaning +
\f$u_i\f$ horizontal components of the velocity +
\f$\phi\f$ arbitrary scalar (tracer) quantity +
\f$w\f$ vertical component of the velocity +
\f$\overline{w}\f$ ensemble average \f$w\f$ +
\f$w^\prime\f$ fluctuations from \f$\overline{w}\f$ +
\f$k\f$ turbulent kinetic energy (TKE) +
\f$K_M\f$ turbulent mixing coefficient for momentum +
\f$K_\phi\f$ turbulent mixing coefficient for \f$\phi\f$ +
\f$\sigma_k\f$ turbulent Schmidt number +
\f$b\f$ buoyancy +
\f$\epsilon\f$ buoyancy turbulent dissipation rate +
+ +This equation describes the evolution of mean quantity \f$\overline{\phi}\f$ +due to vertical processes, including the often negligible molecular +mixing. We would like to parameterize the vertical mixing since we won't be +resolving all the relevant time and space scales. + +We use the Boussinesq hypothesis for turbulence closure. This approximates +the Reynolds stress terms using an eddy viscosity (eddy diffusivity for +turbulent scalar fluxes): + +\f[ + \overline{u_i^\prime w^\prime} = - K_M \frac{\partial \overline{u_i}}{\partial z} , +\f] + +Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes as: + +\f[ + \overline{\phi^\prime w^\prime} = - K_\phi \frac{\partial \overline{\phi}}{\partial z} , +\f] + +The parameters needed to close the system of equations are then reduced to the turbulent +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$. + +We start with an equation for the turbulent kinetic energy (TKE): + +\f[ + \frac{\partial k}{\partial t} = \frac{\partial}{\partial z} \left( \frac{K_M}{\sigma_k} + \frac{\partial k}{\partial z} \right) - \overline{u_i^\prime w^\prime} \frac{\partial \overline{u_i}} + {\partial z} + \overline{w^\prime b^\prime} - \epsilon +\f] + +Terms in this equation represent TKE storage (LHS), TKE flux convergence, +shear production, buoyancy production, and dissipation. + +\section section_WMBL Well-mixed Boundary Layers (WMBL) + +Assuming steady state and other parameterizations, integrating vertically +over the surface boundary layer, \cite reichl2018 obtains the form: + +\f[ + \frac{1}{2} H_{bl} w_e \Delta b = m_\ast u_\ast^3 - n_\ast \frac{H_{bl}}{2} + B(H_{bl}) , +\f] + +with the following variables: + + + +
Symbols used in integrated TKE equation
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$w_e\f$ entrainment velocity +
\f$\Delta b\f$ change in buoyancy at base of mixed layer +
\f$m_\ast\f$ sum of mechanical coefficients +
\f$u_\ast\f$ friction velocity (\f$u_\ast = (|\tau| / \rho_0)^{1/2}\f$) +
\f$\tau\f$ wind stress +
\f$n_\ast\f$ convective proportionality coefficient +
1 for stabilizing surface buoyancy flux, less otherwise +
\f$B(H_{bl})\f$ surface buoyancy flux +
+ +\section section_ePBL Energetics-based Planetary Boundary Layer + +Once again, the goal is to formulate a surface mixing scheme to find the +turbulent eddy diffusivity (and viscosity) in a way that is suitable for use +in a global climate model, using long timesteps and large grid spacing. +After evaluating a well-mixed boundary layer (WMBL), the shear mixing of +\cite jackson2008 (JHL, \ref subsection_kappa_shear), as well as a more complete +boundary layer scheme, it was decided to combine a number of these ideas +into a new scheme: + +\f[ + K(z) = F_x(K_{ePBL}(z), K_{JHL}(z), K_n(z)) +\f] + +where \f$F_x\f$ is some unknown function of a new \f$K_{ePBL}\f$, +\f$K_{JHL}\f$, the diffusivity due to shear as determined by +\cite jackson2008, and \f$K_n\f$, the diffusivity from other ideas. +We start by specifying the form of \f$K_{ePBL}\f$ as being: + +\f[ + K_{ePBL}(z) = C_K w_t l , +\f] + +where \f$w_t\f$ is a turbulent velocity scale, \f$C_K\f$ is a coefficient, and +\f$l\f$ is a length scale. + +\subsection subsection_lengthscale Turbulent length scale + +We propose a form for the length scale as follows: + +\f[ + l = (z_0 + |z|) \times \max \left[ \frac{l_b}{H_{bl}} , \left( + \frac{H_{bl} - |z|}{H_{bl}} \right)^\gamma \, \right] , +\f] + +where we have the following variables: + + + +
Symbols used in ePBL length scale
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$z_0\f$ roughness length +
\f$\gamma\f$ coefficient, 2 is as in KPP, \cite large1994 +
\f$l_b\f$ bottom length scale +
+ +\subsection subsection_velocityscale Turbulent velocity scale + +We do not predict the TKE prognostically and therefore approximate the vertical TKE +profile to estimate \f$w_t\f$. An estimate for the mechanical contribution to the velocity +scale follows the standard two-equation approach. In one and two-equation second-order +\f$K\f$ parameterizations the boundary condition for the TKE is typically employed as a +flux boundary condition. + +\f[ + K \left. \frac{\partial k}{\partial z} \right|_{z=0} = c_\mu^0 u_\ast^3 . +\f] + +The profile of \f$k\f$ decays in the vertical from \f$k \propto (c_\mu^0)^{2/3} +u_\ast^2\f$ toward the base of the OSBL. Here we assume a similar relationship to estimate +the mechanical contribution to the TKE profile. The value of \f$w_t\f$ due to mechanical +sources, \f$v_\ast\f$, is estimate as \f$v_\ast (z=0) \propto (c_\mu^0)^{1/3} u_\ast\f$ at +the surface. Since we only parameterize OSBL turbulent mixing due to surface forcing, the +value of the velocity scale is assumed to decay moving away from the surface. For +simplicity we employ a linear decay in depth: + +\f[ + v_\ast (z) = (c_\mu^0)^{1/3} u_\ast \left( 1 - a \cdot \min \left[ 1, + \frac{|z|}{H_{bl}} \right] \right) , +\f] + +where \f$1 > a > 0\f$ has the effect of making \f$v_\ast(z=H_{bl}) > 0\f$. +Making the constant coefficient \f$a\f$ close to one has the effect of reducing the mixing +rate near the base of the boundary layer, thus producing a more diffuse entrainment +region. Making \f$a\f$ close to zero has the effect of increasing the mixing at the base +of the boundary layer, producing a more 'step-like' entrainment region. + +An estimate for the buoyancy contribution is found utilizing the convective velocity +scale: + +\f[ + w_\ast (z) = C_{w_\ast} \left( \int_z^0 \overline{w^\prime b^\prime} dz \right)^{1/3} , +\f] + +where \f$C_{w_\ast}\f$ is a non-dimensional empirical coefficient. Convection in one and +two-equation closure causes a TKE profile that peaks below the surface. The quantity +\f$\overline{w^\prime b^\prime}\f$ is solved for in ePBL as \f$KN^2\f$. + +These choices for the convective and mechanical components of the velocity scale in the +OSBL are then added together to get an estimate for the total turbulent velocity scale: + +\f[ + w_t (z) = w_\ast (z) + v_\ast (z) . +\f] + +The value of \f$a\f$ is arbitrarily chosen to be 0.95 here. + +\subsection subsection_ePBL_summary Summarizing the ePBL implementation + +The ePBL mixing coefficient is found by multiplying a velocity scale +(\ref subsection_velocityscale) by a length scale (\ref subsection_lengthscale). The +precise value of the coefficient \f$C_K\f$ used does not significantly alter the +prescribed potential energy change constraint. A reasonable value is \f$C_K \approx 0.55\f$ to +be consistent with other approaches (e.g. \cite umlauf2005). + +The boundary layer thickness (\f$H_{bl}\f$) within ePBL is based on +the depth where the energy requirement for turbulent mixing of density +exceeds the available energy (\ref section_WMBL). \f$H_{bl}\f$ is +determined by the energetic constraint imposed using the value of +\f$m_\ast\f$ and \f$n_\ast\f$. An iterative solver is required because +\f$m_\ast\f$ and the mixing length are dependent on \f$H_{bl}\f$. + +We use a constant value for convectively driven TKE of \f$n_\ast = 0.066\f$. The +parameterizations for \f$m_\ast\f$ are formulated specifically for the regimes where +\f$K_{JHL}\f$ is sensitive to model numerics \f$(|f| \Delta t \approx +1)\f$ (\cite reichl2018). + +\subsection subsection_ePBL_JHL Combining ePBL and JHL mixing coefficients + +We now address the combination of the ePBL mixing coefficient and the JHL mixing +coefficient. The function \f$F_x\f$ above cannot be the linear sum of \f$K_{ePBL}\f$ and +\f$K_{JHL}\f$. One reason this sum is not valid is because the JHL mixing coefficient is +determined by resolved current shear, including that driven by the surface wind. The +wind-driven current is also included in the ePBL mixing coefficient formulation. An +alternative approach is therefore needed to avoid double counting. + +\f$K_{ePBL}\f$ is not used at the equator as scalings are only investigated when \f$|f| > +0\f$. The solution we employ is to use the maximum mixing coefficient of the two +contributions, + +\f[ + K (z) = \max (K_{ePBL} (z), K_{JHL} (z)), +\f] + +where \f$m_\ast\f$ (and hence \f$K_{ePBL}\f$) is constrained to be small as \f$|f| +\rightarrow 0\f$. This form uses the JHL mixing coefficient when the ePBL coefficient is +small. + +This approach is reasonable when the wind-driven mixing dominates, since both JHL and ePBL +give a similar solution when deployed optimally. One weakness of this approach is the +tropical region, where the shear-driven ePBL \f$m_\ast\f$ coefficient is not formulated. +The JHL parameterization is skillful to simulate this mixing, but does not include the +contribution of convection. The convective portion of \f$K_{ePBL}\f$ should be combined +with \f$K_{JHL}\f$ in the equatorial region when shear and convection occur together. +Future research is warranted. + +Finally, one should note that the mixing coefficient here (\f$K\f$) is used for both +diffusivity and viscosity, implying a turbulent Prandtl number of 1.0. + +\subsection subsection_Langmuir Langmuir circulation + +While only briefly alluded to in \cite reichl2018, the MOM6 code implementing ePBL does +support the option to add a Langmuir parameterization. There are in fact two options, both +adjusting \f$m_\ast\f$. + +*/ diff --git a/src/parameterizations/vertical/_V_diffusivity.dox b/src/parameterizations/vertical/_V_diffusivity.dox index 8c4c8ce7aa..f3b7ed5962 100644 --- a/src/parameterizations/vertical/_V_diffusivity.dox +++ b/src/parameterizations/vertical/_V_diffusivity.dox @@ -278,7 +278,7 @@ The original version concentrates buoyancy work in regions of strong stratificat The shape of the \cite danabasoglu2012 background mixing has a uniform background value, with a dip at the equator and a bump at \f$\pm 30^{\circ}\f$ degrees latitude. The form is shown in this figure -\image html background_varying.png "Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator." +\image html background_varying.png "Form of the vertically uniform background mixing in Danabasoglu [2012]. The values are symmetric about the equator." \imagelatex{background_varying.png,Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} Some parameters of this curve are set in the input file, some are hard-coded in calculate_bkgnd_mixing. diff --git a/src/parameterizations/vertical/_V_viscosity.dox b/src/parameterizations/vertical/_V_viscosity.dox index cc59e83457..e40123386f 100644 --- a/src/parameterizations/vertical/_V_viscosity.dox +++ b/src/parameterizations/vertical/_V_viscosity.dox @@ -1,4 +1,19 @@ -/*! \page Vertical_Viscosity Viscous Bottom Boundary Layer +/*! \page Vertical_Viscosity Vertical Viscosity + +The vertical viscosity is composed of several components. + +-# The vertical diffusivity computations for the background and shear +mixing all save contributions to the viscosity with an assumed turbulent +Prandtl number of 1.0, though this can be changed with the PRANDTL_BKGND and +PRANDTL_TURB parameters, respectively. +-# If the ePBL scheme is used, it contributes to the vertical viscosity +with a Prandtl number of PRANDTL_EPBL. +-# If the CVMix scheme is used, it contributes to the vertical viscosity +with a Prandtl number of PRANDTL_CONV. +-# If the tidal mixing scheme is used, it contributes to the vertical +viscosity with a Prandtl number of PRANDTL_TIDAL. + +\section set_viscous_BBL Viscous Bottom Boundary Layer A drag law is used, either linearized about an assumed bottom velocity or using the actual near-bottom velocities combined with an assumed unresolved velocity. The bottom @@ -6,8 +21,6 @@ boundary layer thickness is limited by a combination of stratification and rotat in the paper of \cite killworth1999. It is not necessary to calculate the thickness and viscosity every time step; instead previous values may be used. -\section set_viscous_BBL Viscous Bottom Boundary Layer - If set_visc_CS\%bottomdraglaw is True then a bottom boundary layer viscosity and thickness are calculated so that the bottom stress is \f[ @@ -31,7 +44,7 @@ thin upwind cells helps increase the effect of viscosity and inhibits flow out o thin cells. After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer -thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). +thickness is found using the ideas of \cite killworth1999 (hereafter KW99). KW99 solve the equation \f[ \left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 @@ -56,9 +69,54 @@ If a Richardson number dependent mixing scheme is being used, as indicated by set_visc_CS\%rino_mix, then the boundary layer thickness is bounded to be no larger than a half of set_visc_CS\%hbbl . -\todo Channel drag needs to be explained - A BBL viscosity is calculated so that the no-slip boundary condition in the vertical -viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. +viscosity solver implies the stress \f$\mathbf{\tau}_b\f$: + +\f[ + K_{bbl} = \frac{1}{2} h_{bbl} \sqrt{C_{drag}} \, u^\ast +\f] + +\section section_Channel_drag Channel Drag + +The channel drag is an extra Rayleigh drag applied to those layers +within the bottom boundary layer. It is called channel drag because it +accounts for curvature of the bottom, applying the drag proportionally +to how much of each cell is within the bottom boundary layer. +The bottom shape is approximated as locally parabolic. The +bottom drag is applied to each layer with a factor \f$R_k\f$, the sum +of which is 1 over all the layers. + +\image html channel_drag.png "Example of layers intersecting a sloping bottom, with the blue showing the fraction of the cell over which bottom drag is applied." +\imagelatex{channel_drag.png,Example of layers intersecting a sloping bottom\, with the blue showing the fraction of the cell over which bottom drag is applied.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} + +The velocity that is actually subject to the bottom drag may be +substantially lower than the mean layer velocity, especially if only +a small fraction of the layer's width is subject to the bottom drag. + +The code begins by finding the arithmetic mean of the water depths to +find the depth at the velocity points. It then uses these to construct +a parabolic bottom shape, valid for \f$I - \frac{1}{2}\f$ to \f$I + +\frac{1}{2}\f$. The parabola is: + +\f[ + D(x) = a x^2 + b x + D - \frac{a}{12} +\f] + +For sufficiently small curvature \f$a\f$, one can drop the quadratic +term and assume a linear function instead. We want a form that matches +the traditional bottom drag when the bottom is flat. + +We defined the open fraction of each cell as \f$l(k) \equiv L(k)/L_{Tot}\f$, +where terms of order \f$l^2\f$ will be dropped. + +Hallberg (personal communication) shows how they came up with the form used in the code, in which the +\f$R_k\f$ above are set to: + +\f[ + R_k = \gamma_k l_{k-1/2} \left[ \frac{12 c_{Smag} h_k}{12 c_{Smag} k_k + c_d \gamma_k (1 - \gamma_k) + (1 - \frac{3}{2} \gamma_k) l^2_{k-1/2} L_{Tot}} \right] +\f] +with the definition \f$\gamma_k \equiv (l_{k-1/2} - l_{k+1/2})/l_{k-1/2}\f$. This ensures that \f$\sum^N_{k=1} +\gamma_k l_{k-1/2} = 1\f$ since \f$l_{1/2} = 1\f$ and \f$l_{N+1/2} = 0\f$. */ diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 62181fe9ea..2d18b7c907 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -65,7 +65,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(DOME_tracer_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 144b21e29a..013b04a5b3 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -71,7 +71,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(ISOMIP_tracer_CS), pointer :: CS ! NULL(), CFC12 => NULL() real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real :: scale_factor ! convert from cfc1[12]_flux to units of sfc_flux in tracer_vertdiff integer :: i, j, k, m, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return - ! set factor to convert from cfc1[12]_flux units to tracer_vertdiff argument sfc_flux units - ! cfc1[12]_flux units are CU Z T-1 kg m-3 - ! tracer_vertdiff argument sfc_flux units are CU kg m-2 T-1 - scale_factor = US%Z_to_m - - CFC11 => CS%CFC11 ; CFC12 => CS%CFC12 - ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC11, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC11, G, GV, sfc_flux=fluxes%cfc11_flux*scale_factor) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC12, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC12, G, GV, sfc_flux=fluxes%cfc12_flux*scale_factor) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) else - call tracer_vertdiff(h_old, ea, eb, dt, CFC11, G, GV, sfc_flux=fluxes%cfc11_flux*scale_factor) - call tracer_vertdiff(h_old, ea, eb, dt, CFC12, G, GV, sfc_flux=fluxes%cfc12_flux*scale_factor) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) endif ! If needed, write out any desired diagnostics from tracer sources & sinks here. - if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CFC11, CS%diag) - if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CFC12, CS%diag) + if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC11, CS%diag) + if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC12, CS%diag) end subroutine CFC_cap_column_physics !> Calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) +function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CFC_cap_CS), pointer :: CS !< The control structure returned by a !! previous call to register_CFC_cap. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -366,7 +358,7 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: CFC_cap_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -385,7 +377,7 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) @@ -449,11 +441,10 @@ subroutine CFC_cap_fluxes(fluxes, sfc_state, G, US, Rho0, Time, id_cfc11_atm, id real :: sal ! Surface salinity [PSU]. real :: alpha_11 ! The solubility of CFC 11 [mol kg-1 atm-1]. real :: alpha_12 ! The solubility of CFC 12 [mol kg-1 atm-1]. - real :: sc_11, sc_12 ! The Schmidt numbers of CFC 11 and CFC 12. + real :: sc_11, sc_12 ! The Schmidt numbers of CFC 11 and CFC 12 [nondim]. real :: kw_coeff ! A coefficient used to compute the piston velocity [Z T-1 T2 L-2 = Z T L-2 ~> s / m] - real :: Rho0_kg_m3 ! Rho0 in non-scaled units [kg m-3] - real, parameter :: pa_to_atm = 9.8692316931427e-6 ! factor for converting from Pa to atm. - real :: press_to_atm ! converts from model pressure units to atm + real, parameter :: pa_to_atm = 9.8692316931427e-6 ! factor for converting from Pa to atm [atm Pa-1]. + real :: press_to_atm ! converts from model pressure units to atm [atm T2 R-1 L-2 ~> atm Pa-1] integer :: i, j, m, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -488,7 +479,6 @@ subroutine CFC_cap_fluxes(fluxes, sfc_state, G, US, Rho0, Time, id_cfc11_atm, id kw_coeff = (US%m_to_Z*US%s_to_T*US%L_to_m**2) * 6.97e-7 ! set unit conversion factors - Rho0_kg_m3 = Rho0 * US%R_to_kg_m3 press_to_atm = US%R_to_kg_m3*US%L_T_to_m_s**2 * pa_to_atm do j=js,je ; do i=is,ie @@ -506,14 +496,14 @@ subroutine CFC_cap_fluxes(fluxes, sfc_state, G, US, Rho0, Time, id_cfc11_atm, id kw_wo_sc_no_term(i,j) = kw_coeff * ((1.0 - fluxes%ice_fraction(i,j))*fluxes%u10_sqr(i,j)) ! air concentrations and cfcs BC's fluxes - ! CFC flux units: CU Z T-1 kg m-3 = mol kg-1 Z T-1 kg m-3 ~> mol m-2 s-1 + ! CFC flux units: CU R Z T-1 = mol kg-1 R Z T-1 ~> mol m-2 s-1 kw(i,j) = kw_wo_sc_no_term(i,j) * sqrt(660.0 / sc_11) cair(i,j) = press_to_atm * alpha_11 * cfc11_atm(i,j) * fluxes%p_surf_full(i,j) - fluxes%cfc11_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC11(i,j)) * Rho0_kg_m3 + fluxes%cfc11_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC11(i,j)) * Rho0 kw(i,j) = kw_wo_sc_no_term(i,j) * sqrt(660.0 / sc_12) cair(i,j) = press_to_atm * alpha_12 * cfc12_atm(i,j) * fluxes%p_surf_full(i,j) - fluxes%cfc12_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC12(i,j)) * Rho0_kg_m3 + fluxes%cfc12_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC12(i,j)) * Rho0 enddo ; enddo end subroutine CFC_cap_fluxes @@ -524,7 +514,7 @@ subroutine get_solubility(alpha_11, alpha_12, ta, sal , mask) real, intent(inout) :: alpha_12 !< The solubility of CFC 12 [mol kg-1 atm-1] real, intent(in ) :: ta !< Absolute sea surface temperature [hectoKelvin] real, intent(in ) :: sal !< Surface salinity [PSU]. - real, intent(in ) :: mask !< ocean mask + real, intent(in ) :: mask !< ocean mask [nondim] ! Local variables @@ -574,17 +564,17 @@ subroutine comp_CFC_schmidt(sst_in, cfc11_sc, cfc12_sc) real, intent(inout) :: cfc12_sc !< Schmidt number of CFC12 [nondim]. !local variables - real , parameter :: a_11 = 3579.2 - real , parameter :: b_11 = -222.63 - real , parameter :: c_11 = 7.5749 - real , parameter :: d_11 = -0.14595 - real , parameter :: e_11 = 0.0011874 - real , parameter :: a_12 = 3828.1 - real , parameter :: b_12 = -249.86 - real , parameter :: c_12 = 8.7603 - real , parameter :: d_12 = -0.1716 - real , parameter :: e_12 = 0.001408 - real :: sst + real , parameter :: a_11 = 3579.2 ! CFC11 Schmidt number fit coefficient [nondim] + real , parameter :: b_11 = -222.63 ! CFC11 Schmidt number fit coefficient [degC-1] + real , parameter :: c_11 = 7.5749 ! CFC11 Schmidt number fit coefficient [degC-2] + real , parameter :: d_11 = -0.14595 ! CFC11 Schmidt number fit coefficient [degC-3] + real , parameter :: e_11 = 0.0011874 ! CFC11 Schmidt number fit coefficient [degC-4] + real , parameter :: a_12 = 3828.1 ! CFC12 Schmidt number fit coefficient [nondim] + real , parameter :: b_12 = -249.86 ! CFC12 Schmidt number fit coefficient [degC-1] + real , parameter :: c_12 = 8.7603 ! CFC12 Schmidt number fit coefficient [degC-2] + real , parameter :: d_12 = -0.1716 ! CFC12 Schmidt number fit coefficient [degC-3] + real , parameter :: e_12 = 0.001408 ! CFC12 Schmidt number fit coefficient [degC-4] + real :: sst ! A range-limited sea surface temperature [degC] ! clip SST to avoid bad values diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 43a1d7d174..5fe55b896b 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -31,9 +31,6 @@ module MOM_OCMIP2_CFC public OCMIP2_CFC_column_physics, OCMIP2_CFC_surface_state public OCMIP2_CFC_stock, OCMIP2_CFC_end - -integer, parameter :: NTR = 2 !< the number of tracers in this module. - !> The control structure for the OCMPI2_CFC tracer package type, public :: OCMIP2_CFC_CS ; private character(len=200) :: IC_file !< The file in which the CFC initial values can @@ -95,19 +92,17 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) !! structure for this module. type(tracer_registry_type), & pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "MOM_OCMIP2_CFC" ! This module's name. character(len=200) :: inputdir ! The directory where NetCDF input files are. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" real, dimension(:,:,:), pointer :: tr_ptr => NULL() real :: a11_dflt(4), a12_dflt(4) ! Default values of the various coefficients - real :: d11_dflt(4), d12_dflt(4) ! In the expressions for the solubility and - real :: e11_dflt(3), e12_dflt(3) ! Schmidt numbers. + real :: d11_dflt(4), d12_dflt(4) ! in the expressions for the solubility and + real :: e11_dflt(3), e12_dflt(3) ! Schmidt numbers [various units by element]. character(len=48) :: flux_units ! The units for tracer fluxes. logical :: register_OCMIP2_CFC integer :: isd, ied, jsd, jed, nz, m @@ -330,10 +325,6 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for !! the sponges, if they are in use. !! Otherwise this may be unassociated. -! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. - - logical :: from_file = .false. if (.not.associated(CS)) return @@ -441,9 +432,8 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - CFC11_flux, & ! The fluxes of CFC11 and CFC12 into the ocean, in the - CFC12_flux ! units of CFC concentrations times meters per second. - real, pointer, dimension(:,:,:) :: CFC11 => NULL(), CFC12 => NULL() + CFC11_flux, & ! The fluxes of CFC11 and CFC12 into the ocean, in unscaled units of + CFC12_flux ! CFC concentrations times meters per second [CU R Z T-1 ~> CU kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, idim(4), jdim(4) @@ -452,15 +442,13 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (.not.associated(CS)) return - CFC11 => CS%CFC11 ; CFC12 => CS%CFC12 - ! These two calls unpack the fluxes from the input arrays. - ! 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 T-1]. + ! The -GV%Rho0 changes the sign convention of the flux and with the scaling factors changes + ! the units of the flux from [Conc. m s-1] to [Conc. R Z T-1 ~> Conc. kg m-2 s-1]. call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_11_flux, CFC11_flux, & - scale_factor=-GV%Rho0*US%R_to_kg_m3*US%T_to_s, idim=idim, jdim=jdim) + scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim) call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_12_flux, CFC12_flux, & - scale_factor=-GV%Rho0*US%R_to_kg_m3*US%T_to_s, idim=idim, jdim=jdim) + scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim) ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. @@ -468,19 +456,19 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC11, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC11, G, GV, sfc_flux=CFC11_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=CFC11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC12, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC12, G, GV, sfc_flux=CFC12_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=CFC12_flux) else - call tracer_vertdiff(h_old, ea, eb, dt, CFC11, G, GV, sfc_flux=CFC11_flux) - call tracer_vertdiff(h_old, ea, eb, dt, CFC12, G, GV, sfc_flux=CFC12_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=CFC11_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=CFC12_flux) endif ! Write out any desired diagnostics from tracer sources & sinks here. @@ -490,13 +478,14 @@ end subroutine OCMIP2_CFC_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) +function OCMIP2_CFC_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -506,7 +495,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: OCMIP2_CFC_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -525,7 +514,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="OCMIP2_CFC_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index f4120155b2..f8c0f6ac06 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -54,7 +54,7 @@ module MOM_generic_tracer implicit none ; private - !> An state hidden in module data that is very much not allowed in MOM6 + !> A state hidden in module data that is very much not allowed in MOM6 ! ### This needs to be fixed logical :: g_registered = .false. @@ -83,13 +83,8 @@ module MOM_generic_tracer !> Pointer to the first element of the linked list of generic tracers. type(g_tracer_type), pointer :: g_tracer_list => NULL() - integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV - end type MOM_generic_tracer_CS -! This include declares and sets the variable "version". -#include "version_variable.h" - contains !> Initializes the generic tracer packages and adds their tracers to the list @@ -102,11 +97,14 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer !! advection and diffusion module. - type(MOM_restart_CS), pointer :: restart_CS !< Pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! Local variables + ! Local variables logical :: register_MOM_generic_tracer + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer' character(len=200) :: inputdir ! The directory where NetCDF input files are. ! These can be overridden later in via the field manager? @@ -381,8 +379,6 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, call g_tracer_set_csdiag(CS%diag) #endif - CS%H_to_m = GV%H_to_m - end subroutine initialize_MOM_generic_tracer !> Column physics for generic tracers. @@ -395,7 +391,7 @@ end subroutine initialize_MOM_generic_tracer !! tracer physics or chemistry to the tracers from this file. !! CFCs are relatively simple, as they are passive tracers. with only a surface !! flux as a source. - subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, CS, tv, optics, & + subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, CS, tv, optics, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -412,7 +408,8 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [Z ~> m] - 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(optics_type), intent(in) :: optics !< The structure containing optical properties. @@ -469,7 +466,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, 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(:,:) * & - G%US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) + US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) stf_array = stf_array + runoff_tracer_flux_array endif @@ -496,14 +493,15 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dz_ml(:,:) = 0.0 do j=jsc,jec ; do i=isc,iec surface_field(i,j) = tv%S(i,j,1) - dz_ml(i,j) = G%US%Z_to_m * Hml(i,j) + dz_ml(i,j) = US%Z_to_m * Hml(i,j) enddo ; enddo sosga = global_area_mean(surface_field, G) ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! - if ((G%US%L_to_m == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. (G%US%s_to_T == 1.0)) then + if ((G%US%L_to_m == 1.0) .and. (G%US%s_to_T == 1.0) .and. (G%US%Z_to_m == 1.0) .and. & + (G%US%Q_to_J_kg == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0)) then ! Avoid unnecessary copies when no unit conversion is needed. call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%areaT, get_diag_time_end(CS%diag), & @@ -512,7 +510,9 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, else call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & 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, & + optics%nbands, optics%max_wavelength_band, & + sw_pen_band=G%US%QRZ_T_to_W_m2*optics%sw_pen_band(:,:,:), & + opacity_band=G%US%m_to_Z*optics%opacity_band(:,:,:,:), & internal_heat=G%US%RZ_to_kg_m2*tv%internal_heat(:,:), & frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) endif @@ -526,7 +526,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, do k=1,nk ;do j=jsc,jec ; do i=isc,iec h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), G%US%s_to_T*dt, & + call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), dt, & fluxes, h_work, evap_CFL_limit, minimum_forcing_depth) endif @@ -544,16 +544,16 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then ! Last arg is tau which is always 1 for MOM6 - call generic_tracer_vertdiff_G(h_work, ea, eb, dt, GV%kg_m2_to_H, GV%m_to_H, 1) + call generic_tracer_vertdiff_G(h_work, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1) else ! Last arg is tau which is always 1 for MOM6 - call generic_tracer_vertdiff_G(h_old, ea, eb, dt, GV%kg_m2_to_H, GV%m_to_H, 1) + call generic_tracer_vertdiff_G(h_old, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1) endif ! Update bottom fields after vertical processes ! Second arg is tau which is always 1 for MOM6 - call generic_tracer_update_from_bottom(dt, 1, get_diag_time_end(CS%diag)) + call generic_tracer_update_from_bottom(US%T_to_s*dt, 1, get_diag_time_end(CS%diag)) !Output diagnostics via diag_manager for all generic tracers and their fluxes call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1) @@ -568,12 +568,13 @@ end subroutine MOM_generic_tracer_column_physics !! being requested specifically, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding !! to that coded index is returned. - function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) + function MOM_generic_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. @@ -583,7 +584,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde !! number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] type(g_tracer_type), pointer :: g_tracer, g_tracer_next real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr @@ -604,7 +605,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde if (.NOT. associated(CS%g_tracer_list)) return ! No stocks. - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 m=1 ; g_tracer=>CS%g_tracer_list do call g_tracer_get_alias(g_tracer,names(m)) @@ -864,7 +865,7 @@ subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS) !nnz: fake rho0 rho0=1.0 - dzt(:,:,:) = CS%H_to_m * h(:,:,:) + dzt(:,:,:) = GV%H_to_m * h(:,:,:) sosga = global_area_mean(sfc_state%SSS, G) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index dc6a121df1..4a98aa1934 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -156,13 +156,13 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: hbl !< Boundary layer depth [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uFlx !< Zonal flux of tracer [conc H L2 ~> conc kg or conc m^3] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uFlx !< Zonal flux of tracer [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vFlx !< Meridional flux of tracer - !! [conc H L2 ~> conc kg or conc m^3] + !! [conc H L2 ~> conc m3 or conc kg] real, dimension(SZIB_(G),SZJ_(G)) :: uwork_2d !< Layer summed u-flux transport - !! [conc H L2 ~> conc kg or conc m^3] + !! [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZJB_(G)) :: vwork_2d !< Layer summed v-flux transport - !! [conc H L2 ~> conc kg or conc m^3] + !! [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tendency !< tendency array for diagnostic [conc T-1 ~> conc s-1] real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d !< depth integrated content tendency for diagn type(tracer_type), pointer :: tracer => NULL() !< Pointer to the current tracer @@ -174,8 +174,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) real, dimension(SZI_(G),SZJ_(G)) :: tracer_end !< integrated tracer after LBD is applied. !! [conc H L2 ~> conc m3 or conc kg] integer :: i, j, k, m !< indices to loop over - real :: Idt !< inverse of the time step [s-1] - real :: tmp1, tmp2 !< temporary variables + real :: Idt !< inverse of the time step [T-1 ~> s-1] + real :: tmp1, tmp2 !< temporary variables [conc H L2 ~> conc m3 or conc kg] call cpu_clock_begin(id_clock_lbd) Idt = 1./dt @@ -569,51 +569,50 @@ end subroutine boundary_k_range !> Calculate the lateral boundary diffusive fluxes using the layer by layer method. !! See \ref section_method subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & - khtr_u, F_layer, area_L, area_R, CS) - - integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] - integer, intent(in ) :: ke !< Number of layers in the native grid [nondim] - real, intent(in ) :: hbl_L !< Thickness of the boundary boundary - !! layer (left) [H ~> m or kg m-2] - real, intent(in ) :: hbl_R !< Thickness of the boundary boundary - !! layer (right) [H ~> m or kg m-2] - real, dimension(ke), intent(in ) :: h_L !< Thicknesses in the native grid (left) [H ~> m or kg m-2] - real, dimension(ke), intent(in ) :: h_R !< Thicknesses in the native grid (right) [H ~> m or kg m-2] - real, dimension(ke), intent(in ) :: phi_L !< Tracer values in the native grid (left) [conc] - real, dimension(ke), intent(in ) :: phi_R !< Tracer values in the native grid (right) [conc] - real, intent(in ) :: khtr_u !< Horizontal diffusivities times delta t - !! at a velocity point [L2 ~> m2] - real, dimension(ke), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point in the native - !! grid [H L2 conc ~> m3 conc] - real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] - real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] - type(lbd_CS), pointer :: CS !< Lateral diffusion control structure - !! the boundary layer + khtr_u, F_layer, area_L, area_R, CS) + + integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] + integer, intent(in ) :: ke !< Number of layers in the native grid [nondim] + real, intent(in ) :: hbl_L !< Thickness of the boundary boundary + !! layer (left) [H ~> m or kg m-2] + real, intent(in ) :: hbl_R !< Thickness of the boundary boundary + !! layer (right) [H ~> m or kg m-2] + real, dimension(ke), intent(in ) :: h_L !< Thicknesses in the native grid (left) [H ~> m or kg m-2] + real, dimension(ke), intent(in ) :: h_R !< Thicknesses in the native grid (right) [H ~> m or kg m-2] + real, dimension(ke), intent(in ) :: phi_L !< Tracer values in the native grid (left) [conc] + real, dimension(ke), intent(in ) :: phi_R !< Tracer values in the native grid (right) [conc] + real, intent(in ) :: khtr_u !< Horizontal diffusivities times the time step + !! at a velocity point [L2 ~> m2] + real, dimension(ke), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point + !! in the native grid [H L2 conc ~> m3 conc] + real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] + real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] + type(lbd_CS), pointer :: CS !< Lateral diffusion control structure + ! Local variables - real, dimension(:), allocatable :: dz_top !< The LBD z grid to be created [L ~ m] - real, dimension(:), allocatable :: phi_L_z !< Tracer values in the ztop grid (left) [conc] - real, dimension(:), allocatable :: phi_R_z !< Tracer values in the ztop grid (right) [conc] - real, dimension(:), allocatable :: F_layer_z !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] - real, dimension(ke) :: h_vel !< Thicknesses at u- and v-points in the native grid - !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] + real, allocatable :: dz_top(:) !< The LBD z grid to be created [H ~> m or kg m-2] + real, allocatable :: phi_L_z(:) !< Tracer values in the ztop grid (left) [conc] + real, allocatable :: phi_R_z(:) !< Tracer values in the ztop grid (right) [conc] + real, allocatable :: F_layer_z(:) !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] + real :: h_vel(ke) !< Thicknesses at u- and v-points in the native grid + !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] + real :: khtr_avg !< Thickness-weighted diffusivity at the velocity-point [L2 T-1 ~> m2 s-1] !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. - real :: htot !< Total column thickness [H ~> m or kg m-2] + real :: htot !< Total column thickness [H ~> m or kg m-2] integer :: k, k_bot_min, k_top_max !< k-indices, min and max for bottom and top, respectively integer :: k_bot_max, k_top_min !< k-indices, max and min for bottom and top, respectively integer :: k_bot_diff, k_top_diff !< different between left and right k-indices for bottom and top, respectively integer :: k_top_L, k_bot_L !< k-indices left native grid integer :: k_top_R, k_bot_R !< k-indices right native grid real :: zeta_top_L, zeta_top_R !< distance from the top of a layer to the boundary - !! layer depth in the native grid [nondim] + !! layer depth in the native grid [nondim] real :: zeta_bot_L, zeta_bot_R !< distance from the bottom of a layer to the boundary - !!layer depth in the native grid [nondim] - real :: hbl_min !< minimum BLD (left and right) [m] - real :: wgt !< weight to be used in the linear transition to the interior [nondim] + !! layer depth in the native grid [nondim] + real :: wgt !< weight to be used in the linear transition to the interior [nondim] real :: a !< coefficient to be used in the linear transition to the interior [nondim] - real :: tmp1, tmp2 !< dummy variables - real :: htot_max !< depth below which no fluxes should be applied + real :: tmp1, tmp2 !< dummy variables [H ~> m or kg m-2] + real :: htot_max !< depth below which no fluxes should be applied [H ~> m or kg m-2] integer :: nk !< number of layers in the LBD grid F_layer(:) = 0.0 @@ -644,7 +643,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ k_bot_diff = (k_bot_max - k_bot_min) ! tracer flux where the minimum BLD intersets layer - if ((CS%linear) .and. (k_bot_diff .gt. 1)) then + if ((CS%linear) .and. (k_bot_diff > 1)) then ! apply linear decay at the base of hbl do k = k_bot_min,1,-1 F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) @@ -679,11 +678,11 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ ! ! TODO: GMM add option to apply linear decay ! k_top_max = MAX(k_top_L, k_top_R) ! ! make sure left and right k indices span same range -! if (k_top_max .ne. k_top_L) then +! if (k_top_max /= k_top_L) then ! k_top_L = k_top_max ! zeta_top_L = 1.0 ! endif -! if (k_top_max .ne. k_top_R) then +! if (k_top_max /= k_top_R) then ! k_top_R= k_top_max ! zeta_top_R = 1.0 ! endif @@ -743,16 +742,16 @@ logical function near_boundary_unit_tests( verbose ) integer, parameter :: nk = 2 ! Number of layers real, dimension(nk+1) :: eta1 ! Updated interfaces with one extra value [m] real, dimension(:), allocatable :: h1 ! Upates layer thicknesses [m] - real, dimension(nk) :: phi_L, phi_R ! Tracer values (left and right column) [ nondim m^-3 ] + real, dimension(nk) :: phi_L, phi_R ! Tracer values (left and right column) [conc] real, dimension(nk) :: h_L, h_R ! Layer thickness (left and right) [m] - real :: khtr_u ! Horizontal diffusivities at U-point [m^2 s^-1] + real :: khtr_u ! Horizontal diffusivities at U-point [m2 s-1] real :: hbl_L, hbl_R ! Depth of the boundary layer (left and right) [m] - real, dimension(nk) :: F_layer ! Diffusive flux within each layer at U-point [nondim s^-1] + real, dimension(nk) :: F_layer ! Diffusive flux within each layer at U-point [conc m3 s-1] character(len=120) :: test_name ! Title of the unit test integer :: k_top ! Index of cell containing top of boundary - real :: zeta_top ! Nondimension position + real :: zeta_top ! Nondimension position [nondim] integer :: k_bot ! Index of cell containing bottom of boundary - real :: zeta_bot ! Nondimension position + real :: zeta_bot ! Nondimension position [nondim] type(lbd_CS), pointer :: CS allocate(CS) @@ -1012,10 +1011,10 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a character(len=80) :: test_name !< Name of the unit test logical :: verbose !< If true always print output - test_boundary_k_range = k_top .ne. k_top_ans - test_boundary_k_range = test_boundary_k_range .or. (zeta_top .ne. zeta_top_ans) - test_boundary_k_range = test_boundary_k_range .or. (k_bot .ne. k_bot_ans) - test_boundary_k_range = test_boundary_k_range .or. (zeta_bot .ne. zeta_bot_ans) + test_boundary_k_range = k_top /= k_top_ans + test_boundary_k_range = test_boundary_k_range .or. (zeta_top /= zeta_top_ans) + test_boundary_k_range = test_boundary_k_range .or. (k_bot /= k_bot_ans) + test_boundary_k_range = test_boundary_k_range .or. (zeta_bot /= zeta_bot_ans) if (test_boundary_k_range) write(stdout,*) "UNIT TEST FAILED: ", test_name if (test_boundary_k_range .or. verbose) then diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 4851bec9c1..fd479eeaf3 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -305,14 +305,15 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [H ~> m or kg m-2] integer :: iMethod real, dimension(SZI_(G)) :: ref_pres ! Reference pressure used to calculate alpha/beta [R L2 T-2 ~> Pa] - real, dimension(SZI_(G)) :: rho_tmp ! Routine to calculate drho_dp, returns density which is not used + real, dimension(SZI_(G)) :: rho_tmp ! Routine to calculate drho_dp, returns density which is not used [R ~> kg m-3] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] integer, dimension(SZI_(G), SZJ_(G)) :: k_top ! Index of the first layer within the boundary real, dimension(SZI_(G), SZJ_(G)) :: zeta_top ! Distance from the top of a layer to the intersection of the ! top extent of the boundary layer (0 at top, 1 at bottom) [nondim] integer, dimension(SZI_(G), SZJ_(G)) :: k_bot ! Index of the last layer within the boundary - real, dimension(SZI_(G), SZJ_(G)) :: zeta_bot ! Distance of the lower layer to the boundary layer depth - real :: pa_to_H ! A conversion factor from pressure to H units [H T2 R-1 Z-2 ~> m Pa-1 or s2 m-2] + real, dimension(SZI_(G), SZJ_(G)) :: zeta_bot ! Distance of the lower layer to the boundary layer depth [nondim] + real :: pa_to_H ! A conversion factor from rescaled pressure to thickness + ! (H) units [H T2 R-1 Z-2 ~> m Pa-1 or s2 m-1] pa_to_H = 1. / (GV%H_to_RZ * GV%g_Earth) @@ -968,9 +969,9 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT [R degC-1 ~> kg m-3 degC-1] real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS [R ppt-1 ~> kg m-3 ppt-1] real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within - !! layer KoL of left column + !! layer KoL of left column [nondim] real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within - !! layer KoR of right column + !! layer KoR of right column [nondim] integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces @@ -985,7 +986,6 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS integer :: k_surface ! Index of neutral surface integer :: kl ! Index of left interface integer :: kr ! Index of right interface - real :: dRdT, dRdS ! dRho/dT [kg m-3 degC-1] and dRho/dS [kg m-3 ppt-1] for the neutral surface logical :: searching_left_column ! True if searching for the position of a right interface in the left column logical :: searching_right_column ! True if searching for the position of a left interface in the right column logical :: reached_bottom ! True if one of the bottom-most interfaces has been used as the target @@ -1245,7 +1245,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, & integer, optional, intent(in) :: k_bot_L !< k-index for the boundary layer (left) [nondim] integer, optional, intent(in) :: k_bot_R !< k-index for the boundary layer (right) [nondim] logical, optional, intent(in) :: hard_fail_heff !< If true (default) bring down the model if the - !! neutral surfaces ever cross [logical] + !! neutral surfaces ever cross ! Local variables integer :: ns ! Number of neutral surfaces integer :: k_surface ! Index of neutral surface @@ -2389,7 +2389,6 @@ logical function ndiff_unit_tests_discontinuous(verbose) real, dimension(ns) :: PoL, PoR real, dimension(ns-1) :: hEff, Flx type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure - type(EOS_type), pointer :: EOS !< Structure for linear equation of state type(remapping_CS), pointer :: remap_CS !< Remapping control structure (PLM) real, dimension(nk,2) :: ppoly_T_l, ppoly_T_r ! Linear reconstruction for T real, dimension(nk,2) :: ppoly_S_l, ppoly_S_r ! Linear reconstruction for S diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 9486e87369..bdd6be4fe0 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -15,6 +15,7 @@ module MOM_offline_aux use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER use MOM_opacity, only : optics_type use MOM_time_manager, only : time_type, operator(-) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar @@ -34,43 +35,36 @@ module MOM_offline_aux public offline_add_diurnal_sw #include "MOM_memory.h" -#include "version_variable.h" contains !> This updates thickness based on the convergence of horizontal mass fluxes !! NOTE: Only used in non-ALE mode subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: uhtr !< Accumulated mass flux through zonal face [kg] + intent(in) :: uhtr !< Accumulated mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: vhtr !< Accumulated mass flux through meridional face [kg] + intent(in) :: vhtr !< Accumulated mass flux through meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_pre !< Previous layer thicknesses [kg m-2]. + intent(in) :: h_pre !< Previous layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. + intent(inout) :: h_new !< Updated layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - do k = 1, nz + do k=1,nz do i=is-1,ie+1 ; do j=js-1,je+1 - h_new(i,j,k) = max(0.0, G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k) + & - ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) - - ! In the case that the layer is now dramatically thinner than it was previously, - ! add a bit of mass to avoid truncation errors. This will lead to - ! non-conservation of tracers - h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k)) + h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = max(GV%Angstrom_H, h_new(i,j,k) * G%IareaT(i,j)) enddo ; enddo enddo @@ -79,52 +73,40 @@ end subroutine update_h_horizontal_flux !> Updates layer thicknesses due to vertical mass transports !! NOTE: Only used in non-ALE configuration subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep [kg m-2] + !! above within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< Mass of fluid entrained from the layer - !! below within this timestep [kg m-2] + !! below within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step [kg m-2]. + !! step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. + intent(inout) :: h_new !< Updated layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Update h_new with convergence of vertical mass transports do j=js-1,je+1 do i=is-1,ie+1 - ! Top layer - h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) - h_new(i,j,1) = h_new(i,j,1) + & - max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) + h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) ! Bottom layer -! h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz)) - h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) - h_new(i,j,nz) = h_new(i,j,nz) + & - max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) - + h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 - h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1)))) - h_new(i,j,k) = h_new(i,j,k) + & - max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) - + (eb(i,j,k) - ea(i,j,k+1)))) enddo ; enddo - enddo end subroutine update_h_vertical_flux @@ -132,35 +114,41 @@ end subroutine update_h_vertical_flux !> This routine limits the mass fluxes so that the a layer cannot be completely depleted. !! NOTE: Only used in non-ALE mode subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Mass flux through zonal face [kg] + intent(inout) :: uh !< Mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Mass flux through meridional face [kg] + intent(inout) :: vh !< Mass flux through meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep [kg m-2] + !! above within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< Mass of fluid entrained from the layer - !! below within this timestep [kg m-2] + !! below within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step [kg m-2]. + !! step [H ~> m or kg m-2] ! Local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net upward fluxes through the layer + ! top [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net downward fluxes through the layer + ! bottom [H ~> m or kg m-2] + real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg] + real :: hvol ! Cell volume [H L2 ~> m3 or kg] + real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] + real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux, bottom_flux - real :: pos_flux, hvol, h_neglect, scale_factor, max_off_cfl - max_off_cfl =0.5 + max_off_cfl = 0.5 ! In this subroutine, fluxes out of the box are scaled away if they deplete ! the layer, note that we define the positive direction as flux out of the box. ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs ! to enforce the positive out convention @@ -170,7 +158,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo - do k=2, nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=2,nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo ; enddo @@ -184,49 +172,36 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! Calculate sum of positive fluxes (negatives applied to enforce convention) ! in a given cell and scale it back if it would deplete a layer - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hvol = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) - pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & - max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + hvol = h_pre(i,j,k) * G%areaT(i,j) + pos_flux = ((max(0.0, -uh(I-1,j,k)) + max(0.0, uh(I,j,k))) + & + (max(0.0, -vh(i,J-1,k)) + max(0.0, vh(i,J,k)))) + & + (max(0.0, top_flux(i,j,k)) + max(0.0, bottom_flux(i,j,k))) * G%areaT(i,j) if (pos_flux>hvol .and. pos_flux>0.0) then - scale_factor = ( hvol )/pos_flux*max_off_cfl + scale_factor = (hvol / pos_flux) * max_off_cfl else ! Don't scale scale_factor = 1.0 endif ! Scale horizontal fluxes - if (-uh(I-1,j,k)>0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor - if (uh(I,j,k)>0) uh(I,j,k) = uh(I,j,k)*scale_factor - if (-vh(i,J-1,k)>0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor - if (vh(i,J,k)>0) vh(i,J,k) = vh(i,J,k)*scale_factor - - if (k>1 .and. k0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale top layer - elseif (k==1) then - if (top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale bottom layer - elseif (k==nz) then - if (top_flux(i,j,k)>0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) eb(i,j,k)=eb(i,j,k)*scale_factor + if (-uh(I-1,j,k) > 0.0) uh(I-1,j,k) = uh(I-1,j,k) * scale_factor + if (uh(I,j,k) > 0.0) uh(I,j,k) = uh(I,j,k) * scale_factor + if (-vh(i,J-1,k) > 0.0) vh(i,J-1,k) = vh(i,J-1,k) * scale_factor + if (vh(i,J,k) > 0.0) vh(i,J,k) = vh(i,J,k) * scale_factor + + ! Scale the flux across the interface atop a layer if it is upward + if (top_flux(i,j,k) > 0.0) then + ea(i,j,k) = ea(i,j,k) * scale_factor + if (k > 1) & + eb(i,j,k-1) = eb(i,j,k-1) * scale_factor + endif + ! Scale the flux across the interface atop a layer if it is downward + if (bottom_flux(i,j,k) > 0.0) then + eb(i,j,k) = eb(i,j,k) * scale_factor + if (k < nz) & + ea(i,j,k+1) = ea(i,j,k+1) * scale_factor endif enddo ; enddo ; enddo @@ -235,29 +210,32 @@ end subroutine limit_mass_flux_3d !> In the case where offline advection has failed to converge, redistribute the u-flux !! into remainder of the water column as a barotropic equivalent subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Zonal mass transport within a timestep [kg] - - real, dimension(SZIB_(G),SZK_(GV)) :: uh2d - real, dimension(SZIB_(G)) :: uh2d_sum - real, dimension(SZI_(G),SZK_(GV)) :: h2d - real, dimension(SZI_(G)) :: h2d_sum + intent(inout) :: uh !< Zonal mass transport within a timestep [H L2 ~> m3 or kg] + ! Local variables + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d ! A 2-d slice of transports [H L2 ~> m3 or kg] + real, dimension(SZIB_(G)) :: uh2d_sum ! Vertically summed transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] + real, dimension(SZI_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + + real :: abs_uh_sum ! The vertical sum of the absolute value of the transports [H L2 ~> m3 or kg] + real :: new_uh_sum ! The vertically summed transports after redistribution [H L2 ~> m3 or kg] + real :: uh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz - real :: uh_neglect ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do j=js,je uh2d_sum(:) = 0.0 ! Copy over uh to a working array and sum up the remaining fluxes in a column - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh2d(I,k) = uh(I,j,k) uh2d_sum(I) = uh2d_sum(I) + uh2d(I,k) enddo ; enddo @@ -269,13 +247,13 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) if (hvol(i,j,k)>0.) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d(i,k) = GV%H_subroundoff + h2d(i,k) = GV%H_subroundoff * G%areaT(i,j) endif enddo ; enddo ! Distribute flux. Note min/max is intended to make sure that the mass transport ! does not deplete a cell - do i=is-1,ie + do I=is-1,ie if ( uh2d_sum(I)>0.0 ) then do k=1,nz uh2d(I,k) = uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)) @@ -289,15 +267,20 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) uh2d(I,k) = 0.0 enddo endif - ! Calculate and check that column integrated transports match the original to - ! within the tolerance limit - uh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i+1,j)) - if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & - call MOM_error(WARNING,"Column integral of uh does not match after "//& - "barotropic redistribution") + + ! Check that column integrated transports match the original to within roundoff. + uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) + abs_uh_sum = 0.0 ; new_uh_sum = 0.0 + do k=1,nz + abs_uh_sum = abs_uh_sum + abs(uh2d(j,k)) + new_uh_sum = new_uh_sum + uh2d(j,k) + enddo + if ( abs(new_uh_sum - uh2d_sum(j)) > max(uh_neglect, (5.0e-16*nz)*abs_uh_sum) ) & + call MOM_error(WARNING, "Column integral of uh does not match after "//& + "barotropic redistribution") enddo - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo enddo @@ -306,29 +289,32 @@ end subroutine distribute_residual_uh_barotropic !> Redistribute the v-flux as a barotropic equivalent subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Meridional mass transport within a timestep [kg] - - real, dimension(SZJB_(G),SZK_(GV)) :: vh2d - real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(GV)) :: h2d - real, dimension(SZJ_(G)) :: h2d_sum + intent(inout) :: vh !< Meridional mass transport within a timestep [H L2 ~> m3 or kg] + ! Local variables + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d ! A 2-d slice of transports [H L2 ~> m3 or kg] + real, dimension(SZJB_(G)) :: vh2d_sum ! Vertically summed transports [H L2 ~> m3 or kg] + real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] + real, dimension(SZJ_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + + real :: abs_vh_sum ! The vertical sum of the absolute value of the transports [H L2 ~> m3 or kg] + real :: new_vh_sum ! The vertically summed transports after redistribution [H L2 ~> m3 or kg] + real :: vh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz - real :: vh_neglect ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do i=is,ie vh2d_sum(:) = 0.0 ! Copy over uh to a working array and sum up the remaining fluxes in a column - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh2d(J,k) = vh(i,J,k) vh2d_sum(J) = vh2d_sum(J) + vh2d(J,k) enddo ; enddo @@ -340,12 +326,12 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) if (hvol(i,j,k)>0.) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d(j,k) = GV%H_subroundoff + h2d(i,k) = GV%H_subroundoff * G%areaT(i,j) endif enddo ; enddo ! Distribute flux evenly throughout a column - do j=js-1,je + do J=js-1,je if ( vh2d_sum(J)>0.0 ) then do k=1,nz vh2d(J,k) = vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)) @@ -359,17 +345,20 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) vh2d(J,k) = 0.0 enddo endif - ! Calculate and check that column integrated transports match the original to - ! within the tolerance limit - vh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i,j+1)) - if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then - call MOM_error(WARNING,"Column integral of vh does not match after "//& - "barotropic redistribution") - endif + ! Check that column integrated transports match the original to within roundoff. + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) + abs_vh_sum = 0.0 ; new_vh_sum = 0.0 + do k=1,nz + abs_vh_sum = abs_vh_sum + abs(vh2d(J,k)) + new_vh_sum = new_vh_sum + vh2d(J,k) + enddo + if ( abs(new_vh_sum - vh2d_sum(J)) > max(vh_neglect, (5.0e-16*nz)*abs_vh_sum) ) & + call MOM_error(WARNING, "Column integral of vh does not match after "//& + "barotropic redistribution") enddo - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo @@ -379,23 +368,25 @@ end subroutine distribute_residual_vh_barotropic !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Zonal mass transport within a timestep [kg] + intent(inout) :: uh !< Zonal mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZK_(GV)) :: uh2d - real, dimension(SZI_(G),SZK_(GV)) :: h2d + ! Local variables + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d ! A slice of transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A slice of updated cell volumes [H L2 ~> m3 or kg] - real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max - real :: hup, hdown, hlos, min_h + real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max ! Transports [H L2 ~> m3 or kg] + real :: hup, hlos ! Various cell volumes [H L2 ~> m3 or kg] + real :: min_h ! A minimal layer thickness [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h = GV%Angstrom_H*0.1 @@ -406,10 +397,10 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) + h2d(i,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo - do i=is-1,ie + do I=is-1,ie uh_col = SUM(uh2d(I,:)) ! Store original column-integrated transport do k=1,nz uh_remain = uh2d(I,k) @@ -457,15 +448,14 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i+1,j)) - if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then - call MOM_error(WARNING,"Column integral of uh does not match after "//& - "upwards redistribution") + uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) + if (abs(uh_col - sum(uh2d(I,:))) > uh_neglect) then + call MOM_error(WARNING,"Column integral of uh does not match after upwards redistribution") endif enddo ! i-loop - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo enddo @@ -475,38 +465,40 @@ end subroutine distribute_residual_uh_upwards !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Meridional mass transport within a timestep [kg] + intent(inout) :: vh !< Meridional mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZJB_(G),SZK_(GV)) :: vh2d - real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(GV)) :: h2d - real, dimension(SZJ_(G)) :: h2d_sum - - real :: vh_neglect, vh_remain, vh_col, vh_sum - real :: hup, hlos, min_h + ! Local variables + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d ! A slice of transports [H L2 ~> m3 or kg] + real, dimension(SZJB_(G)) :: vh2d_sum ! Summed transports [H L2 ~> m3 or kg] + real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A slice of updated cell volumes [H L2 ~> m3 or kg] + real, dimension(SZJ_(G)) :: h2d_sum ! Summed cell volumes [H L2 ~> m3 or kg] + + real :: vh_neglect, vh_remain, vh_col, vh_sum ! Transports [H L2 ~> m3 or kg] + real :: hup, hlos ! Various cell volumes [H L2 ~> m3 or kg] + real :: min_h ! A minimal layer thickness [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h = 0.1*GV%Angstrom_H do i=is,ie ! Copy over uh and cell volume to working arrays - do k=1,nz ; do j=js-2,je+1 + do k=1,nz ; do J=js-2,je+1 vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 - h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) + h2d(j,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo - do j=js-1,je + do J=js-1,je vh_col = SUM(vh2d(J,:)) do k=1,nz vh_remain = vh2d(J,k) @@ -555,14 +547,14 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") endif enddo - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo @@ -577,12 +569,20 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) type(time_type), intent(in) :: Time_start !< The start time for this step. type(time_type), intent(in) :: Time_end !< The ending time for this step. - real :: diurnal_factor, time_since_ae, rad - real :: fracday_dt, fracday_day - real :: cosz_day, cosz_dt, rrsun_day, rrsun_dt - type(time_type) :: dt_here - - integer :: i, j, k, i2, j2, isc, iec, jsc, jec, i_off, j_off + real :: diurnal_factor ! A scaling factor to insert a synthetic diurnal cycle [nondim] + real :: time_since_ae ! Time since the autumnal equinox expressed as a fraction of a year times 2 pi [nondim] + real :: rad ! A conversion factor from degrees to radians = pi/180 degrees [nondim] + real :: fracday_dt ! Daylight fraction averaged over a timestep [nondim] + real :: fracday_day ! Daylight fraction averaged over a day [nondim] + real :: cosz_day ! Cosine of the solar zenith angle averaged over a day [nondim] + real :: cosz_dt ! Cosine of the solar zenith angle averaged over a timestep [nondim] + real :: rrsun_day ! Earth-Sun distance (r) relative to the semi-major axis of + ! the orbital ellipse averaged over a day [nondim] + real :: rrsun_dt ! Earth-Sun distance (r) relative to the semi-major axis of + ! the orbital ellipse averaged over a timestep [nondim] + type(time_type) :: dt_here ! The time increment covered by this call + + integer :: i, j, i2, j2, isc, iec, jsc, jec, i_off, j_off isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec i_off = LBOUND(fluxes%sens,1) - G%isc ; j_off = LBOUND(fluxes%sens,2) - G%jsc @@ -593,10 +593,8 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) dt_here = Time_end - Time_start rad = acos(-1.)/180. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,rad,Time_start,dt_here,time_since_ae, & -!$OMP fluxes,i_off,j_off) & -!$OMP private(i,j,i2,j2,k,cosz_dt,fracday_dt,rrsun_dt, & -!$OMP fracday_day,cosz_day,rrsun_day,diurnal_factor) + !$OMP parallel do default(shared) private(i,j,i2,j2,cosz_dt,fracday_dt,rrsun_dt, & + !$OMP fracday_day,cosz_day,rrsun_day,diurnal_factor) do j=jsc,jec ; do i=isc,iec ! Per Rick Hemler: ! Call diurnal_solar with dtime=dt_here to get cosz averaged over dt_here. @@ -622,31 +620,32 @@ end subroutine offline_add_diurnal_sw !> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored !! in a previous integration of the online model -subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_file, surf_file, h_end, & - uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, ridx_sum, ridx_snap, read_mld, read_sw, & - read_ts_uvh, do_ale_in) +subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, snap_file, & + surf_file, h_end, uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, & + ridx_sum, ridx_snap, read_mld, read_sw, read_ts_uvh, do_ale_in) type(ocean_grid_type), intent(inout) :: G !< Horizontal grid type type(verticalGrid_type), intent(in ) :: GV !< Vertical grid type + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type integer, intent(in ) :: nk_input !< Number of levels in input file character(len=*), intent(in ) :: mean_file !< Name of file with averages fields character(len=*), intent(in ) :: sum_file !< Name of file with summed fields character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields character(len=*), intent(in ) :: surf_file !< Name of file with surface fields + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_end !< End of timestep layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uhtr !< Zonal mass fluxes [kg] + intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vhtr !< Meridional mass fluxes [kg] + intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_end !< End of timestep layer thickness + intent(inout) :: temp_mean !< Averaged temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: temp_mean !< Averaged temperature - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt_mean !< Averaged salinity + intent(inout) :: salt_mean !< Averaged salinity [ppt] real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: mld !< Averaged mixed layer depth + intent(inout) :: mld !< Averaged mixed layer depth [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: Kd !< Diapycnal diffusivities at interfaces + intent(inout) :: Kd !< Diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files integer, intent(in ) :: ridx_snap !< Read index for snapshot file @@ -656,15 +655,22 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ logical, optional, intent(in ) :: do_ale_in !< True if using ALE algorithms logical :: do_ale + real :: convert_to_H ! A scale conversion factor from the thickness units in the + ! file to H [H m-1 or H m2 kg-1 ~> 1] integer :: i, j, k, is, ie, js, je, nz - real :: Initer_vert do_ale = .false. - if (present(do_ale_in) ) do_ale = do_ale_in + if (present(do_ale_in)) do_ale = do_ale_in is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! Check if reading in UH, VH, and h_end + if (GV%Boussinesq) then + convert_to_H = GV%m_to_H + else + convert_to_H = GV%kg_m2_to_H + endif + + ! Check if reading in temperature, salinity, transports and ending thickness if (read_ts_uvh) then h_end(:,:,:) = 0.0 temp_mean(:,:,:) = 0.0 @@ -673,25 +679,27 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ vhtr(:,:,:) = 0.0 ! Time-summed fields call MOM_read_vector(sum_file, 'uhtr_sum', 'vhtr_sum', uhtr(:,:,1:nk_input), & - vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum) + vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum, & + scale=US%m_to_L**2*GV%kg_m2_to_H) call MOM_read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), G%Domain, & - timelevel=ridx_snap,position=CENTER) + timelevel=ridx_snap, position=CENTER, scale=convert_to_H) call MOM_read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) call MOM_read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) - endif - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j)>0.) then - temp_mean(:,:,nk_input:nz) = temp_mean(i,j,nk_input) - salt_mean(:,:,nk_input:nz) = salt_mean(i,j,nk_input) - endif - enddo ; enddo + ! Fill temperature and salinity downward from the deepest input data. + do k=nk_input+1,nz ; do j=js,je ; do i=is,ie + if (G%mask2dT(i,j)>0.) then + temp_mean(i,j,k) = temp_mean(i,j,nk_input) + salt_mean(i,j,k) = salt_mean(i,j,nk_input) + endif + enddo ; enddo ; enddo + endif ! Check if reading vertical diffusivities or entrainment fluxes call MOM_read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), G%Domain, & - timelevel=ridx_sum,position=CENTER) + timelevel=ridx_sum, position=CENTER, scale=US%m2_s_to_Z2_T) ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine @@ -704,9 +712,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ fluxes%netMassOut(:,:) = 0.0 fluxes%netMassIn(:,:) = 0.0 call MOM_read_data(surf_file,'massout_flux_sum',fluxes%netMassOut, G%Domain, & - timelevel=ridx_sum) + timelevel=ridx_sum, scale=GV%kg_m2_to_H) call MOM_read_data(surf_file,'massin_flux_sum', fluxes%netMassIn, G%Domain, & - timelevel=ridx_sum) + timelevel=ridx_sum, scale=GV%kg_m2_to_H) do j=js,je ; do i=is,ie if (G%mask2dT(i,j)<1.0) then @@ -718,7 +726,7 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ endif if (read_mld) then - call MOM_read_data(surf_file, 'ePBL_h_ML', mld, G%Domain, timelevel=ridx_sum) + call MOM_read_data(surf_file, 'ePBL_h_ML', mld, G%Domain, timelevel=ridx_sum, scale=US%m_to_Z) endif if (read_sw) then @@ -727,9 +735,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! direct fluxes in the visible and near-infrared bands. For convenience, we store the ! sum of the direct and diffuse fluxes in the 'dir' field and set the 'dif' fields to zero call MOM_read_data(mean_file,'sw_vis', fluxes%sw_vis_dir, G%Domain, & - timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + timelevel=ridx_sum, scale=US%W_m2_to_QRZ_T) call MOM_read_data(mean_file,'sw_nir', fluxes%sw_nir_dir, G%Domain, & - timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + timelevel=ridx_sum, scale=US%W_m2_to_QRZ_T) fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir(:,:) fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 @@ -763,12 +771,14 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ character(len=200), intent(in ) :: mean_file !< Name of file with averages fields character(len=200), intent(in ) :: sum_file !< Name of file with summed fields character(len=200), intent(in ) :: snap_file !< Name of file with snapshot fields - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hend !< End of timestep layer thickness [kg m-2] - real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [kg] - real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [kg] - real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness [kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hend !< End of timestep layer thickness + !! [H ~> m or kg m-2] + real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0a61ee1ba2..d5b3f708a3 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -6,6 +6,7 @@ module MOM_offline_main use MOM_ALE, only : ALE_CS, ALE_main_offline, ALE_offline_inputs use MOM_checksums, only : hchksum, uvchksum +use MOM_coms, only : reproducing_sum 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 @@ -13,7 +14,7 @@ module MOM_offline_main use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field -use MOM_domains, only : sum_across_PEs, pass_var, pass_vector +use MOM_domains, only : pass_var, pass_vector use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : read_param, get_param, log_version, param_file_type @@ -39,7 +40,6 @@ module MOM_offline_main implicit none ; private #include "MOM_memory.h" -#include "version_variable.h" !> The control structure for the offline transport module type, public :: offline_transport_CS ; private @@ -63,12 +63,6 @@ module MOM_offline_main !< A pointer to the tracer registry type(thermo_var_ptrs), pointer :: tv => NULL() !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), pointer :: G => NULL() - !< Pointer to a structure containing metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - !< Pointer to structure containing information about the vertical grid - type(unit_scale_type), pointer :: US => NULL() - !< structure containing various unit conversion factors type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() @@ -125,7 +119,8 @@ module MOM_offline_main !! This is copied from diabatic_CS controlling how tracers follow freshwater fluxes real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity - real :: min_residual !< The minimum amount of total mass flux before exiting the main advection routine + real :: min_residual !< The minimum amount of total mass flux before exiting the main advection + !! routine [H L2 ~> m3 or kg] !>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport integer :: & id_uhr = -1, & @@ -158,9 +153,9 @@ module MOM_offline_main integer :: id_clock_offline_adv = -1 !< A CPU time clock integer :: id_clock_redistribute = -1 !< A CPU time clock - !> Zonal transport that may need to be stored between calls to step_MOM + !> Zonal transport that may need to be stored between calls to step_MOM [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:) :: uhtr - !> Meridional transport that may need to be stored between calls to step_MOM + !> Meridional transport that may need to be stored between calls to step_MOM [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:) :: vhtr ! Fields at T-point @@ -171,19 +166,19 @@ module MOM_offline_main !< Amount of fluid entrained from the layer below within !! one time step [H ~> m or kg m-2] ! Fields at T-points on interfaces - real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity - real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep + real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep [H ~> m or kg m-2] real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean - real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m]. + real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m] ! Allocatable arrays to read in entire fields during initialization - real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport - real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of mericional transport - real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses - real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures - real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities + real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of meridional transport [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures [degC] + real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities [ppt] end type offline_transport_CS @@ -206,41 +201,37 @@ module MOM_offline_main !> 3D advection is done by doing flux-limited nonlinear horizontal advection interspersed with an ALE !! regridding/remapping step. The loop in this routine is exited if remaining residual transports are below !! a runtime-specified value or a maximum number of iterations is reached. -subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval - type(offline_transport_CS), pointer :: CS !< control structure for offline module - integer, intent(in) :: id_clock_ALE !< Clock for ALE routines - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection - !! [H ~> m or kg m-2] - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: uhtr !< Zonal mass transport [H m2 ~> m3 or kg] - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), & - intent(inout) :: vhtr !< Meridional mass transport [H m2 ~> m3 or kg] - logical, intent( out) :: converged !< True if the iterations have converged - - ! Local pointers - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information - ! about the vertical grid - ! Work arrays for mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhtr_sub - ! Meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhtr_sub - - real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are +subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS, id_clock_ale, & + h_pre, uhtr, vhtr, converged) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval covered by this call [s] + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< control structure for offline module + integer, intent(in) :: id_clock_ALE !< Clock for ALE routines + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection + !! [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] + logical, intent( out) :: converged !< True if the iterations have converged + + ! Local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhtr_sub ! Substep zonal mass transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub ! Substep meridional mass transports [H L2 ~> m3 or kg] + + real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol - ! Fields for eta_diff diagnostic - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end - integer :: niter, iter - real :: Inum_iter + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! Updated layer thicknesses [H ~> m or kg m-2] + h_vol ! Layer volumes [H L2 ~> m3 or kg] + integer :: niter, iter + real :: Inum_iter ! The inverse of the number of iterations [nondim] character(len=256) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. @@ -250,15 +241,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! top layer in a timestep [nondim] real :: minimum_forcing_depth ! The smallest depth over which fluxes can be applied [H ~> m or kg m-2] real :: dt_iter ! The timestep to use for each iteration [T ~> s] - - integer :: nstocks - real :: stock_values(MAX_FIELDS_) + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] character(len=20) :: debug_msg call cpu_clock_begin(CS%id_clock_offline_adv) ! Grid-related pointer assignments - G => CS%G - GV => CS%GV x_before_y = CS%x_before_y @@ -270,6 +257,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock evap_CFL_limit = CS%evap_CFL_limit minimum_forcing_depth = CS%minimum_forcing_depth + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 niter = CS%num_off_iter Inum_iter = 1./real(niter) dt_iter = CS%dt_offline*Inum_iter @@ -314,12 +302,12 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_pre,"h_pre before transport",G%HI) - call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI) + call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_m) + call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) endif - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif @@ -328,34 +316,34 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k) * G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_vol,"h_vol before advect",G%HI) - call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI) + call hchksum(h_vol, "h_vol before advect", G%HI, scale=HL2_to_kg_scale) + call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) write(debug_msg, '(A,I4.4)') 'Before advect ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & - uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhtr, vhr_out=vhtr) ! Switch the direction every iteration x_before_y = .not. x_before_y ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then ! Do ALE remapping/regridding to allow for more advection to occur in the next iteration call pass_var(h_new,G%Domain) if (CS%debug) then - call hchksum(h_new,"h_new before ALE",G%HI) + call hchksum(h_new,"h_new before ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'Before ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -364,7 +352,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call cpu_clock_end(id_clock_ALE) if (CS%debug) then - call hchksum(h_new,"h_new after ALE",G%HI) + call hchksum(h_new, "h_new after ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'After ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -375,13 +363,13 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo call pass_var(h_new, G%Domain) - call pass_vector(uhtr_sub,vhtr_sub,G%Domain) + call pass_vector(uhtr_sub, vhtr_sub, G%Domain) ! Check for whether we've used up all the advection, or if we need to move on because ! advection has stalled - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif ! If all the mass transports have been used u, then quit @@ -403,11 +391,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Make sure that uhtr and vhtr halos are updated h_pre(:,:,:) = h_new(:,:,:) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then - call hchksum(h_pre,"h after offline_advection_ale",G%HI) - call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI) + call hchksum(h_pre, "h after offline_advection_ale", G%HI, scale=GV%H_to_m) + call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -419,53 +407,49 @@ end subroutine offline_advection_ale !! transport. Two different ways are offered, 'barotropic' means that the residual is distributed equally !! throughout the water column. 'upwards' attempts to redistribute the transport in the layers above and will !! eventually work down the entire water column -subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) +subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, converged) type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), & - intent(inout) :: vhtr !< Meridional mass transport + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] logical, intent(in ) :: converged !< True if the iterations have converged - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information - ! about the vertical grid logical :: x_before_y ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! New layer thicknesses [H ~> m or kg m-2] + h_vol ! Cell volume [H L2 ~> m3 or kg] ! Used to calculate the eta diagnostics - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_work - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhr !< Meridional mass transport + real, dimension(SZI_(G),SZJ_(G)) :: eta_work ! The total column thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhr !< Remaining meridional mass transport [H L2 ~> m3 or kg] character(len=256) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter - real :: prev_tot_residual, tot_residual, stock_values(MAX_FIELDS_) - integer :: nstocks - - ! Assign grid pointers - G => CS%G - GV => CS%GV + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] + real :: prev_tot_residual, tot_residual ! The absolute value of the remaining transports [H L2 ~> m3 or kg] 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 x_before_y = CS%x_before_y + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 if (CS%id_eta_pre_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom_H) then + if (h_pre(i,j,k) > GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo - call post_data(CS%id_eta_pre_distribute,eta_work,CS%diag) + call post_data(CS%id_eta_pre_distribute, eta_work, CS%diag) endif ! These are used to find out how much will be redistributed in this routine @@ -489,17 +473,14 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) - - ! Store volumes for advect_tracer - h_pre(:,:,:) = h_vol(:,:,:) + call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) - call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif if (x_before_y) then @@ -510,9 +491,9 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -522,8 +503,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -534,17 +514,14 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) - - ! Copy h_vol to h_pre for advect_tracer routine - h_pre(:,:,:) = h_vol(:,:,:) + call pass_var(h_vol, G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) - call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif if (x_before_y) then @@ -555,9 +532,9 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -567,17 +544,16 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! redistribute barotropic ! Check to see if all transport has been exhausted - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif ! If the remaining residual is 0, then this return is done @@ -598,15 +574,15 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo - call post_data(CS%id_eta_post_distribute,eta_work,CS%diag) + call post_data(CS%id_eta_post_distribute, eta_work, CS%diag) endif - if (CS%id_uhr>0) call post_data(CS%id_uhr,uhtr,CS%diag) - if (CS%id_vhr>0) call post_data(CS%id_vhr,vhtr,CS%diag) + if (CS%id_uhr>0) call post_data(CS%id_uhr, uhtr, CS%diag) + if (CS%id_vhr>0) call post_data(CS%id_vhr, vhtr, CS%diag) if (CS%debug) then - call hchksum(h_pre,"h_pre after redistribute",G%HI) - call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI) + call hchksum(h_pre, "h_pre after redistribute", G%HI, scale=GV%H_to_m) + call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) endif @@ -614,76 +590,81 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) end subroutine offline_redistribute_residual -!> Sums any non-negligible remaining transport to check for advection convergence -real function remaining_transport_sum(CS, uhtr, vhtr) - type(offline_transport_CS), pointer :: CS !< control structure for offline module - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(in ) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(in ) :: vhtr !< Meridional mass transport +!> Returns the sums of any non-negligible remaining transport [H L2 ~> m3 or kg] to check for advection convergence +real function remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in ) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in ) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in ) :: h_new !< Layer thicknesses [H ~> m or kg m-2] ! Local variables - integer :: i, j, k - integer :: is, ie, js, je, nz - real :: h_min !< A layer thickness below roundoff from GV type - real :: uh_neglect !< A small value of zonal transport that effectively is below roundoff error - real :: vh_neglect !< A small value of meridional transport that effectively is below roundoff error + real, dimension(SZI_(G),SZJ_(G)) :: trans_rem_col !< The vertical sum of the absolute value of + !! transports through the faces of a column, in MKS units [kg]. + real :: trans_cell !< The sum of the absolute value of the remaining transports through the faces + !! of a tracer cell [H L2 ~> m3 or kg] + real :: HL2_to_kg_scale !< Unit conversion factor to cell mass [kg H-1 L-2 ~> kg m-3 or 1] + integer :: i, j, k, is, ie, js, je, nz - nz = CS%GV%ke - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - h_min = CS%GV%H_subroundoff + HL2_to_kg_scale = GV%H_to_kg_m2 * US%L_to_m**2 - remaining_transport_sum = 0. + trans_rem_col(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - uh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) - vh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) - if (ABS(uhtr(I,j,k))>uh_neglect) then - remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) - endif - if (ABS(vhtr(i,J,k))>vh_neglect) then - remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) - endif + trans_cell = (ABS(uhtr(I-1,j,k)) + ABS(uhtr(I,j,k))) + & + (ABS(vhtr(i,J-1,k)) + ABS(vhtr(i,J,k))) + if (trans_cell > max(1.0e-16*h_new(i,j,k), GV%H_subroundoff) * G%areaT(i,j)) & + trans_rem_col(i,j) = trans_rem_col(i,j) + HL2_to_kg_scale * trans_cell enddo ; enddo ; enddo - call sum_across_PEs(remaining_transport_sum) + + ! The factor of 0.5 here is to avoid double-counting because two cells share a face. + remaining_transport_sum = 0.5 * GV%kg_m2_to_H*US%m_to_L**2 * & + reproducing_sum(trans_rem_col, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) end function remaining_transport_sum !> The vertical/diabatic driver for offline tracers. First the eatr/ebtr associated with the interpolated !! vertical diffusivities are calculated and then any tracer column functions are done which can include !! vertical diffuvities and source/sink terms. -subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr) - - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - type(time_type), intent(in) :: Time_end !< time interval - type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] - - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & +subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_pre, eatr, ebtr) + + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + type(time_type), intent(in) :: Time_end !< ending time of a segment, as a time type + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] + + real, dimension(SZI_(G),SZJ_(G)) :: & sw, sw_vis, sw_nir !< Save old values of shortwave radiation [Q R Z T-1 ~> W m-2] - real :: hval - integer :: i,j,k - integer :: is, ie, js, je, nz + real :: I_hval ! An inverse thickness [H-1 ~> m2 kg-1] + integer :: i, j, k, is, ie, js, je, nz integer :: k_nonzero - real :: stock_values(MAX_FIELDS_) - real :: Kd_bot - integer :: nstocks - nz = CS%GV%ke - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + real :: Kd_bot ! Near-bottom diffusivity [Z2 T-1 ~> m2 s-1] + nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec call cpu_clock_begin(CS%id_clock_offline_diabatic) call MOM_mesg("Applying tracer source, sinks, and vertical mixing") if (CS%debug) then - call hchksum(h_pre,"h_pre before offline_diabatic_ale",CS%G%HI) - call hchksum(eatr,"eatr before offline_diabatic_ale",CS%G%HI) - call hchksum(ebtr,"ebtr before offline_diabatic_ale",CS%G%HI) - call MOM_tracer_chkinv("Before offline_diabatic_ale", CS%G, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h_pre, "h_pre before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(eatr, "eatr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "ebtr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif eatr(:,:,:) = 0. @@ -712,8 +693,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e eatr(i,j,1) = 0. enddo ; enddo do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(CS%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) - eatr(i,j,k) = (CS%GV%m_to_H**2*CS%US%T_to_s) * CS%dt_offline_vertical * hval * CS%Kd(i,j,k) + I_hval = 1.0 / (GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) + eatr(i,j,k) = GV%Z_to_H**2 * CS%dt_offline_vertical * I_hval * CS%Kd(i,j,k) ebtr(i,j,k-1) = eatr(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -725,17 +706,17 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e sw(:,:) = fluxes%sw(:,:) sw_vis(:,:) = fluxes%sw_vis_dir(:,:) sw_nir(:,:) = fluxes%sw_nir_dir(:,:) - call offline_add_diurnal_SW(fluxes, CS%G, Time_start, Time_end) + call offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) endif if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%US, CS%diabatic_aux_CSp, & + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, & CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, fluxes, CS%MLD, CS%dt_offline_vertical, & - CS%G, CS%GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) if (CS%diurnal_SW .and. CS%read_sw) then fluxes%sw(:,:) = sw(:,:) @@ -744,10 +725,10 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (CS%debug) then - call hchksum(h_pre,"h_pre after offline_diabatic_ale",CS%G%HI) - call hchksum(eatr,"eatr after offline_diabatic_ale",CS%G%HI) - call hchksum(ebtr,"ebtr after offline_diabatic_ale",CS%G%HI) - call MOM_tracer_chkinv("After offline_diabatic_ale", CS%G, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h_pre, "h_pre after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(eatr, "eatr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "ebtr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call MOM_tracer_chkinv("After offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_end(CS%id_clock_offline_diabatic) @@ -768,7 +749,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) !! of tracer that leaves with freshwater integer :: i, j, m - real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes + real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes [H ~> m or kg m-2] logical :: update_h !< Flag for whether h should be updated if ( present(in_flux_optional) ) & @@ -786,17 +767,17 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) enddo ; enddo if (CS%debug) then - call hchksum(h, "h before fluxes into ocean", G%HI) + call hchksum(h, "h before fluxes into ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif do m = 1,CS%tracer_reg%ntr ! Layer thicknesses should only be updated after the last tracer is finished update_h = ( m == CS%tracer_reg%ntr ) call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_reg%tr(m)%t, CS%dt_offline, fluxes, h, & - CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) + CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt=update_h) enddo if (CS%debug) then - call hchksum(h, "h after fluxes into ocean", G%HI) + call hchksum(h, "h after fluxes into ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -824,7 +805,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) call MOM_error(WARNING, "Negative freshwater fluxes with non-zero tracer concentration not supported yet") if (CS%debug) then - call hchksum(h,"h before fluxes out of ocean",G%HI) + call hchksum(h, "h before fluxes out of ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif do m = 1, CS%tracer_reg%ntr @@ -834,7 +815,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) enddo if (CS%debug) then - call hchksum(h,"h after fluxes out of ocean",G%HI) + call hchksum(h, "h after fluxes out of ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -842,46 +823,51 @@ end subroutine offline_fw_fluxes_out_ocean !> When in layer mode, 3D horizontal advection using stored mass fluxes must be used. Horizontal advection is !! done via tracer_advect, whereas the vertical component is actually handled by vertdiff in tracer_column_fns -subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, eatr, ebtr, uhtr, vhtr) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< Offline transport time interval - type(offline_transport_CS), pointer :: CS !< Control structure for offline module - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: eatr !< Entrainment from layer above - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: ebtr !< Entrainment from layer below - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(inout) :: vhtr !< Meridional mass transport - ! Local pointers - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information - ! about the vertical grid - ! Remaining zonal mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhtr_sub - ! Remaining meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhtr_sub - - real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are - real :: dt_offline +subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS, h_pre, eatr, ebtr, uhtr, vhtr) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< Offline transport time interval [s] + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] ! Local variables - ! Vertical diffusion related variables - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - eatr_sub, & - ebtr_sub + + ! Remaining zonal mass transports [H L2 ~> m3 or kg] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhtr_sub + ! Remaining meridional mass transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub + + real, dimension(SZI_(G),SZJB_(G)) :: rem_col_flux ! The summed absolute value of the remaining + ! fluxes through the faces of a column or within a column, in mks units [kg] + real :: sum_flux ! Globally summed absolute value of fluxes in mks units [kg], which is + ! used to keep track of how close to convergence we are. + + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + eatr_sub, & ! Layer entrainment rate from above for this sub-cycle [H ~> m or kg m-2] + ebtr_sub ! Layer entrainment rate from below for this sub-cycle [H ~> m or kg m-2] ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! Updated thicknesses [H ~> m or kg m-2] + h_vol ! Cell volumes [H L2 ~> m3 or kg] ! Work arrays for temperature and salinity - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - temp_old, salt_old, & - temp_mean, salt_mean, & - zero_3dh ! + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + temp_old, temp_mean, & ! Temperatures [degC] + salt_old, salt_mean ! Salinities [ppt] integer :: niter, iter - real :: Inum_iter real :: dt_iter ! The timestep of each iteration [T ~> s] + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] logical :: converged character(len=160) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz @@ -889,30 +875,28 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, integer :: IsdB, IedB, JsdB, JedB logical :: z_first, x_before_y - G => CS%G ; GV => CS%GV 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 ; JsdB = G%JsdB ; JedB = G%JedB - dt_iter = CS%US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) + dt_iter = US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) x_before_y = CS%x_before_y do iter=1,CS%num_off_iter - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr_sub(i,j,k) = eatr(i,j,k) ebtr_sub(i,j,k) = ebtr(i,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr_sub(I,j,k) = uhtr(I,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo - ! Calculate 3d mass transports to be used in this iteration call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) @@ -920,24 +904,24 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First do vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, CS%mld, dt_iter, G, GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + fluxes, CS%mld, dt_iter, G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo call pass_var(h_pre,G%Domain) ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, max_iter_in=30) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif @@ -946,39 +930,39 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, CS%tracer_adv_CSp, & + CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, max_iter_in=30) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Second vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, CS%mld, dt_iter, G, GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + fluxes, CS%mld, dt_iter, G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! Update remaining transports - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo ; enddo ; enddo @@ -986,25 +970,25 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, call pass_var(ebtr,G%Domain) call pass_var(h_pre,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) - ! + ! Calculate how close we are to converging by summing the remaining fluxes at each point - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + rem_col_flux(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) - sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) - sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + rem_col_flux(i,j) = rem_col_flux(i,j) + HL2_to_kg_scale * & + ( (abs(eatr(i,j,k)) + abs(ebtr(i,j,k))) + & + ((abs(uhtr(I-1,j,k)) + abs(uhtr(I,j,k))) + & + (abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k))) ) ) enddo ; enddo ; enddo - call sum_across_PEs(sum_abs_fluxes) + sum_flux = reproducing_sum(rem_col_flux, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) - write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", sum_u, sum_v - call MOM_mesg(mesg) - if (sum_abs_fluxes==0) then + if (sum_flux==0) then write(mesg,*) 'offline_advection_layer: Converged after iteration', iter call MOM_mesg(mesg) exit + else + write(mesg,*) "offline_advection_layer: Iteration ", iter, " remaining total fluxes: ", sum_flux + call MOM_mesg(mesg) endif ! Switch order of Strang split every iteration @@ -1016,42 +1000,59 @@ end subroutine offline_advection_layer !> Update fields used in this round of offline transport. First fields are updated from files or from arrays !! read during initialization. Then if in an ALE-dependent coordinate, regrid/remap fields. -subroutine update_offline_fields(CS, h, fluxes, do_ale) - type(offline_transport_CS), pointer :: CS !< Control structure for offline module - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: h !< The regridded layer thicknesses - type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields - logical, intent(in ) :: do_ale !< True if using ALE +subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< The regridded layer thicknesses [H ~> m or kg m-2] + type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields + logical, intent(in ) :: do_ale !< True if using ALE ! Local variables integer :: i, j, k, is, ie, js, je, nz - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: h_start - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec ; nz = CS%GV%ke + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_start ! Initial thicknesses [H ~> m or kg m-2] + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call cpu_clock_begin(CS%id_clock_read_fields) call callTree_enter("update_offline_fields, MOM_offline_main.F90") + if (CS%debug) then + call uvchksum("[uv]htr before update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%h_end, "h_end before update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%tv%T, "Temp before update_offline_fields", G%HI) + call hchksum(CS%tv%S, "Salt before update_offline_fields", G%HI) + endif + ! Store a copy of the layer thicknesses before ALE regrid/remap h_start(:,:,:) = h(:,:,:) ! Most fields will be read in from files - call update_offline_from_files( CS%G, CS%GV, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, CS%surf_file, & - CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, CS%mld, CS%Kd, fluxes, & - CS%ridx_sum, CS%ridx_snap, CS%read_mld, CS%read_sw, .not. CS%read_all_ts_uvh, do_ale) + call update_offline_from_files( G, GV, US, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, & + CS%surf_file, CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, & + CS%mld, CS%Kd, fluxes, CS%ridx_sum, CS%ridx_snap, CS%read_mld, & + CS%read_sw, .not.CS%read_all_ts_uvh, do_ale) ! If uh, vh, h_end, temp, salt were read in at the beginning, fields are copied from those arrays if (CS%read_all_ts_uvh) then - call update_offline_from_arrays(CS%G, CS%GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, CS%snap_file, & - CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) - endif + call update_offline_from_arrays(G, GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, & + CS%snap_file, CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, & + CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) + endif if (CS%debug) then - call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, CS%G%HI) + call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%tv%T, "Temp after update offline from files and arrays", G%HI) + call hchksum(CS%tv%S, "Salt after update offline from files and arrays", G%HI) endif ! If using an ALE-dependent vertical coordinate, fields will need to be remapped if (do_ale) then ! These halo passes are necessary because u, v fields will need information 1 step into the halo - call pass_var(h, CS%G%Domain) - call pass_var(CS%tv%T, CS%G%Domain) - call pass_var(CS%tv%S, CS%G%Domain) - call ALE_offline_inputs(CS%ALE_CSp, CS%G, CS%GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, & + call pass_var(h, G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) + call ALE_offline_inputs(CS%ALE_CSp, G, GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, & CS%debug, CS%OBC) if (CS%id_temp_regrid>0) call post_data(CS%id_temp_regrid, CS%tv%T, CS%diag) if (CS%id_salt_regrid>0) call post_data(CS%id_salt_regrid, CS%tv%S, CS%diag) @@ -1059,15 +1060,16 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) if (CS%id_vhtr_regrid>0) call post_data(CS%id_vhtr_regrid, CS%vhtr, CS%diag) if (CS%id_h_regrid>0) call post_data(CS%id_h_regrid, h, CS%diag) if (CS%debug) then - call uvchksum("[uv]h after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, CS%G%HI) - call hchksum(h_start,"h_start after update offline from files and arrays", CS%G%HI) + call uvchksum("[uv]htr after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(h_start,"h_start after ALE regridding/remapping of inputs", G%HI, scale=GV%H_to_m) endif endif ! Update halos for some - call pass_var(CS%h_end, CS%G%Domain) - call pass_var(CS%tv%T, CS%G%Domain) - call pass_var(CS%tv%S, CS%G%Domain) + call pass_var(CS%h_end, G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) @@ -1075,8 +1077,8 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie - if (CS%G%mask2dT(i,j)<1.0) then - CS%h_end(i,j,k) = CS%GV%Angstrom_H + if (G%mask2dT(i,j)<1.0) then + CS%h_end(i,j,k) = GV%Angstrom_H endif enddo ; enddo ; enddo @@ -1088,22 +1090,23 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie - if (CS%G%mask2dCv(i,J)<1.0) then + if (G%mask2dCv(i,J)<1.0) then CS%vhtr(i,J,k) = 0.0 endif enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie - if (CS%G%mask2dCu(I,j)<1.0) then + if (G%mask2dCu(I,j)<1.0) then CS%uhtr(I,j,k) = 0.0 endif enddo ; enddo ; enddo if (CS%debug) then - call uvchksum("[uv]htr_sub after update_offline_fields", CS%uhtr, CS%vhtr, CS%G%HI) - call hchksum(CS%h_end, "h_end after update_offline_fields", CS%G%HI) - call hchksum(CS%tv%T, "Temp after update_offline_fields", CS%G%HI) - call hchksum(CS%tv%S, "Salt after update_offline_fields", CS%G%HI) + call uvchksum("[uv]htr after update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%h_end, "h_end after update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%tv%T, "Temp after update_offline_fields", G%HI) + call hchksum(CS%tv%S, "Salt after update_offline_fields", G%HI) endif call callTree_leave("update_offline_fields") @@ -1112,80 +1115,100 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) end subroutine update_offline_fields !> Initialize additional diagnostics required for offline tracer transport -subroutine register_diags_offline_transport(Time, diag, CS) +subroutine register_diags_offline_transport(Time, diag, CS, GV, US) type(offline_transport_CS), pointer :: CS !< Control structure for offline module + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Time !< current model time type(diag_ctrl), intent(in) :: diag !< Structure that regulates diagnostic output ! U-cell fields CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & - 'Zonal thickness fluxes remaining at end of advection', 'kg') + 'Zonal thickness fluxes remaining at end of advection', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_uhr_redist = register_diag_field('ocean_model', 'uhr_redist', diag%axesCuL, Time, & - 'Zonal thickness fluxes to be redistributed vertically', 'kg') + 'Zonal thickness fluxes to be redistributed vertically', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_uhr_end = register_diag_field('ocean_model', 'uhr_end', diag%axesCuL, Time, & - 'Zonal thickness fluxes at end of offline step', 'kg') + 'Zonal thickness fluxes at end of offline step', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) ! V-cell fields CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & - 'Meridional thickness fluxes remaining at end of advection', 'kg') + 'Meridional thickness fluxes remaining at end of advection', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhr_redist = register_diag_field('ocean_model', 'vhr_redist', diag%axesCvL, Time, & - 'Meridional thickness to be redistributed vertically', 'kg') + 'Meridional thickness to be redistributed vertically', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhr_end = register_diag_field('ocean_model', 'vhr_end', diag%axesCvL, Time, & - 'Meridional thickness at end of offline step', 'kg') + 'Meridional thickness at end of offline step', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) ! T-cell fields CS%id_hdiff = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & - 'Difference between the stored and calculated layer thickness', 'm') + 'Difference between the stored and calculated layer thickness', & + 'm', conversion=GV%H_to_m) CS%id_hr = register_diag_field('ocean_model', 'hr', diag%axesTL, Time, & - 'Layer thickness at end of offline step', 'm') + 'Layer thickness at end of offline step', 'm', conversion=GV%H_to_m) CS%id_ear = register_diag_field('ocean_model', 'ear', diag%axesTL, Time, & 'Remaining thickness entrained from above', 'm') CS%id_ebr = register_diag_field('ocean_model', 'ebr', diag%axesTL, Time, & 'Remaining thickness entrained from below', 'm') CS%id_eta_pre_distribute = register_diag_field('ocean_model','eta_pre_distribute', & - diag%axesT1, Time, 'Total water column height before residual transport redistribution','m') + diag%axesT1, Time, 'Total water column height before residual transport redistribution', & + 'm', conversion=GV%H_to_m) CS%id_eta_post_distribute = register_diag_field('ocean_model','eta_post_distribute', & - diag%axesT1, Time, 'Total water column height after residual transport redistribution','m') + diag%axesT1, Time, 'Total water column height after residual transport redistribution', & + 'm', conversion=GV%H_to_m) CS%id_eta_diff_end = register_diag_field('ocean_model','eta_diff_end', diag%axesT1, Time, & 'Difference in total water column height from online and offline ' // & - 'at the end of the offline timestep','m') + 'at the end of the offline timestep', 'm', conversion=GV%H_to_m) CS%id_h_redist = register_diag_field('ocean_model','h_redist', diag%axesTL, Time, & - 'Layer thicknesses before redistribution of mass fluxes','m') + 'Layer thicknesses before redistribution of mass fluxes', & + 'm', conversion=GV%H_to_m) ! Regridded/remapped input fields CS%id_uhtr_regrid = register_diag_field('ocean_model', 'uhtr_regrid', diag%axesCuL, Time, & - 'Zonal mass transport regridded/remapped onto offline grid','kg') + 'Zonal mass transport regridded/remapped onto offline grid', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhtr_regrid = register_diag_field('ocean_model', 'vhtr_regrid', diag%axesCvL, Time, & - 'Meridional mass transport regridded/remapped onto offline grid','kg') + 'Meridional mass transport regridded/remapped onto offline grid', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_temp_regrid = register_diag_field('ocean_model', 'temp_regrid', diag%axesTL, Time, & 'Temperature regridded/remapped onto offline grid','C') CS%id_salt_regrid = register_diag_field('ocean_model', 'salt_regrid', diag%axesTL, Time, & 'Salinity regridded/remapped onto offline grid','g kg-1') CS%id_h_regrid = register_diag_field('ocean_model', 'h_regrid', diag%axesTL, Time, & - 'Layer thicknesses regridded/remapped onto offline grid','m') - + 'Layer thicknesses regridded/remapped onto offline grid', & + 'm', conversion=GV%H_to_m) end subroutine register_diags_offline_transport !> Posts diagnostics related to offline convergence diagnostics -subroutine post_offline_convergence_diags(CS, h_off, h_end, uhtr, vhtr) +subroutine post_offline_convergence_diags(G, GV, CS, h_off, h_end, uhtr, vhtr) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(offline_transport_CS), intent(in ) :: CS !< Offline control structure - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_off !< Thicknesses at end of offline step - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_end !< Stored thicknesses - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: uhtr !< Remaining zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(inout) :: vhtr !< Remaining meridional mass transport + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_off !< Thicknesses at end of offline step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_end !< Stored thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Remaining meridional mass transport [H L2 ~> m3 or kg] - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff + real, dimension(SZI_(G),SZJ_(G)) :: eta_diff ! Differences in column thickness [H ~> m or kg m-2] integer :: i, j, k if (CS%id_eta_diff_end>0) then ! Calculate difference in column thickness eta_diff = 0. - do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k) enddo ; enddo ; enddo - do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k) enddo ; enddo ; enddo @@ -1205,8 +1228,8 @@ subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_t dt_offline, dt_offline_vertical, skip_diffusion) type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure ! Returned optional arguments - real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H m2 ~> m3 or kg] - real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H m2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H L2 ~> m3 or kg] real, dimension(:,:,:), optional, pointer :: eatr !< Amount of fluid entrained from the layer above within !! one time step [H ~> m or kg m-2] real, dimension(:,:,:), optional, pointer :: ebtr !< Amount of fluid entrained from the layer below within @@ -1243,7 +1266,7 @@ end subroutine extract_offline_main !> Inserts (assigns values to) members of the offline main control structure. All arguments !! are optional except for the CS itself subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, & - tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug) + tracer_flow_CSp, tracer_Reg, tv, x_before_y, debug) type(offline_transport_CS), intent(inout) :: CS !< Offline control structure ! Inserted optional arguments type(ALE_CS), & @@ -1262,10 +1285,6 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ target, optional, intent(in ) :: tracer_Reg !< A pointer to the tracer registry type(thermo_var_ptrs), & target, optional, intent(in ) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), & - target, optional, intent(in ) :: G !< ocean grid structure - type(verticalGrid_type), & - target, optional, intent(in ) :: GV !< ocean vertical grid structure logical, optional, intent(in ) :: x_before_y !< Indicates which horizontal direction is advected first logical, optional, intent(in ) :: debug !< If true, write verbose debugging messages @@ -1278,8 +1297,6 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ if (present(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp if (present(tracer_Reg)) CS%tracer_Reg => tracer_Reg if (present(tv)) CS%tv => tv - if (present(G)) CS%G => G - if (present(GV)) CS%GV => GV if (present(x_before_y)) CS%x_before_y = x_before_y if (present(debug)) CS%debug = debug @@ -1298,7 +1315,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method - + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -1309,37 +1327,33 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) call callTree_enter("offline_transport_init, MOM_offline_control.F90") if (associated(CS)) then - call MOM_error(WARNING, "offline_transport_init called with an associated "// & - "control structure.") + call MOM_error(WARNING, "offline_transport_init called with an associated control structure.") return endif allocate(CS) - call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") - - ! Determining the internal unit scaling factors for this run. - CS%US => US + call log_version(param_file, mdl, version, "This module allows for tracers to be run offline") ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & - "Input directory where the offline fields can be found", fail_if_missing = .true.) + "Input directory where the offline fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SUM_FILE", CS%sum_file, & - "Filename where the accumulated fields can be found", fail_if_missing = .true.) + "Filename where the accumulated fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SNAP_FILE", CS%snap_file, & - "Filename where snapshot fields can be found", fail_if_missing = .true.) + "Filename where snapshot fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where averaged fields can be found", fail_if_missing = .true.) + "Filename where averaged fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SURF_FILE", CS%surf_file, & - "Filename where averaged fields can be found", fail_if_missing = .true.) + "Filename where averaged fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "NUMTIME", CS%numtime, & - "Number of timelevels in offline input files", fail_if_missing = .true.) + "Number of timelevels in offline input files", fail_if_missing=.true.) call get_param(param_file, mdl, "NK_INPUT", CS%nk_input, & - "Number of vertical levels in offline input files", default = nz) + "Number of vertical levels in offline input files", default=nz) call get_param(param_file, mdl, "DT_OFFLINE", CS%dt_offline, & - "Length of time between reading in of input fields", units='s', scale=US%s_to_T, fail_if_missing = .true.) + "Length of time between reading in of input fields", units='s', scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_OFFLINE_VERTICAL", CS%dt_offline_vertical, & "Length of the offline timestep for tracer column sources/sinks " //& "This should be set to the length of the coupling timestep for " //& - "tracers which need shortwave fluxes", units="s", scale=US%s_to_T, fail_if_missing = .true.) + "tracers which need shortwave fluxes", units="s", scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "START_INDEX", CS%start_index, & "Which time index to start from", default=1) call get_param(param_file, mdl, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & @@ -1355,42 +1369,40 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) default='barotropic') call get_param(param_file, mdl, "NUM_OFF_ITER", CS%num_off_iter, & "Number of iterations to subdivide the offline tracer advection and diffusion", & - default = 60) + default=60) call get_param(param_file, mdl, "OFF_ALE_MOD", CS%off_ale_mod, & - "Sets how many horizontal advection steps are taken before an ALE " //& - "remapping step is done. 1 would be x->y->ALE, 2 would be" //& - "x->y->x->y->ALE", default = 1) + "Sets how many horizontal advection steps are taken before an ALE "//& + "remapping step is done. 1 would be x->y->ALE, 2 would be x->y->x->y->ALE", default=1) call get_param(param_file, mdl, "PRINT_ADV_OFFLINE", CS%print_adv_offline, & - "Print diagnostic output every advection subiteration",default=.false.) + "Print diagnostic output every advection subiteration", default=.false.) call get_param(param_file, mdl, "SKIP_DIFFUSION_OFFLINE", CS%skip_diffusion, & - "Do not do horizontal diffusion",default=.false.) + "Do not do horizontal diffusion", default=.false.) call get_param(param_file, mdl, "READ_SW", CS%read_sw, & - "Read in shortwave radiation field instead of using values from the coupler"//& - "when in offline tracer mode",default=.false.) + "Read in shortwave radiation field instead of using values from the coupler "//& + "when in offline tracer mode", default=.false.) call get_param(param_file, mdl, "READ_MLD", CS%read_mld, & - "Read in mixed layer depths for tracers which exchange with the atmosphere"//& - "when in offline tracer mode",default=.false.) + "Read in mixed layer depths for tracers which exchange with the atmosphere "//& + "when in offline tracer mode", default=.false.) call get_param(param_file, mdl, "MLD_VAR_NAME", CS%mld_var_name, & - "Name of the variable containing the depth of active mixing",& - default='ePBL_h_ML') + "Name of the variable containing the depth of active mixing", default='ePBL_h_ML') call get_param(param_file, mdl, "OFFLINE_ADD_DIURNAL_SW", CS%diurnal_sw, & - "Adds a synthetic diurnal cycle in the same way that the ice " // & - "model would have when time-averaged fields of shortwave " // & + "Adds a synthetic diurnal cycle in the same way that the ice "//& + "model would have when time-averaged fields of shortwave "//& "radiation are read in", default=.false.) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal "//& "diffusivity from TKE-based parameterizations, or a "//& - "negative value for no limit.", units="m2 s-1", default=-1.0) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "MIN_RESIDUAL_TRANSPORT", CS%min_residual, & - "How much remaining transport before the main offline advection "// & - "is exited. The default value corresponds to about 1 meter of " // & - "difference in a grid cell", default = 1.e9) + "How much remaining transport before the main offline advection is exited. "//& + "The default value corresponds to about 1 meter of difference in a grid cell", & + default=1.e9, units="m3", scale=GV%m_to_H*US%m_to_L**2) call get_param(param_file, mdl, "READ_ALL_TS_UVH", CS%read_all_ts_uvh, & "Reads all time levels of a subset of the fields necessary to run " // & "the model offline. This can require a large amount of memory "// & "and will make initialization very slow. However, for offline "// & "runs spanning more than a year this can reduce total I/O overhead", & - default = .false.) + default=.false.) ! Concatenate offline directory and file names CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) @@ -1398,7 +1410,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) CS%surf_file = trim(CS%offlinedir)//trim(CS%surf_file) - CS%num_vert_iter = CS%dt_offline/CS%dt_offline_vertical + CS%num_vert_iter = CS%dt_offline / CS%dt_offline_vertical ! Map redistribute_method onto logicals in CS select case (redistribute_method) @@ -1430,10 +1442,6 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) - ! Grid pointer assignments - CS%G => G - CS%GV => GV - ! Allocate arrays allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz), source=0.0) allocate(CS%vhtr(isd:ied,JsdB:JedB,nz), source=0.0) @@ -1446,7 +1454,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) if (CS%read_mld) allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed), source=0.0) if (CS%read_all_ts_uvh) then - call read_all_input(CS) + call read_all_input(CS, G, GV, US) endif ! Initialize ids for clocks used in offline routines @@ -1461,15 +1469,18 @@ end subroutine offline_transport_init !> Coordinates the allocation and reading in all time levels of uh, vh, hend, temp, and salt from files. Used !! when read_all_ts_uvh -subroutine read_all_input(CS) - type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module +subroutine read_all_input(CS, G, GV, US) + type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime integer :: IsdB, IedB, JsdB, JedB - nz = CS%GV%ke ; ntime = CS%numtime - isd = CS%G%isd ; ied = CS%G%ied ; jsd = CS%G%jsd ; jed = CS%G%jed - IsdB = CS%G%IsdB ; IedB = CS%G%IedB ; JsdB = CS%G%JsdB ; JedB = CS%G%JedB + nz = GV%ke ; ntime = CS%numtime + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Extra safety check that we're not going to overallocate any arrays if (CS%read_all_ts_uvh) then @@ -1488,13 +1499,14 @@ subroutine read_all_input(CS) call MOM_mesg("Reading in uhtr, vhtr, h_start, h_end, temp, salt") do t = 1,ntime call MOM_read_vector(CS%snap_file, 'uhtr_sum', 'vhtr_sum', CS%uhtr_all(:,:,1:CS%nk_input,t), & - CS%vhtr_all(:,:,1:CS%nk_input,t), CS%G%Domain, timelevel=t) - call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) - call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) - call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) + CS%vhtr_all(:,:,1:CS%nk_input,t), G%Domain, timelevel=t, & + scale=US%m_to_L**2*GV%kg_m2_to_H) + call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER, scale=GV%kg_m2_to_H) + call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER) + call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER) enddo endif diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index cd6572cc9c..e8324b6043 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -559,13 +559,13 @@ end function find_limited_slope !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, k_start, G, GV, US, & - eos, h_massless) + EOS, h_massless) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: temp !< potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt !< salinity [PSU] + intent(inout) :: salt !< salinity [ppt] real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations @@ -575,7 +575,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, intent(in) :: h !< layer thickness, used only to avoid working on !! massless layers [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(eos_type), pointer :: eos !< seawater equation of state control structure + type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure real, optional, intent(in) :: h_massless !< A threshold below which a layer is !! determined to be massless [H ~> m or kg m-2] @@ -627,9 +627,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, adjust_salt = .true. iter_loop: do itt = 1,niter do k=1,nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, EOSdom ) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), EOS, EOSdom ) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & - eos, EOSdom ) + EOS, EOSdom ) enddo do k=k_start,nz ; do i=is,ie ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln) then @@ -656,9 +656,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, if (adjust_salt .and. old_fit) then ; do itt = 1,niter do k=1,nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, EOSdom ) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), EOS, EOSdom ) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & - eos, EOSdom ) + EOS, EOSdom ) enddo do k=k_start,nz ; do i=is,ie ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln ) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index a3c9965a11..e2c669fcc7 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -34,7 +34,7 @@ module MOM_tracer_advect logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: usePPM !< If true, use PPM instead of PLM logical :: useHuynh !< If true, use the Huynh scheme for PPM interface values - type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structred used for group passes + type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structure used for group passes end type tracer_advect_CS !>@{ CPU time clocks @@ -47,34 +47,41 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & - h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first_in, & + vol_prev, max_iter_in, update_vol_prev, uhr_out, vhr_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] + intent(in) :: h_end !< Layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] + intent(in) :: uhtr !< Accumulated volume or mass flux through the + !! zonal faces [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] + intent(in) :: vhtr !< Accumulated volume or mass flux through the + !! meridional faces [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 [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 - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: h_prev_opt !< layer thickness before advection [H ~> m or kg m-2] - integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update !! first in the x- or y-direction. + ! The remaining optional arguments are only used in offline tracer mode. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: vol_prev !< Cell volume before advection [H L2 ~> m3 or kg]. + !! If update_vol_prev is true, the returned value is + !! the cell volume after the transport that was done + !! by this call, and if all the transport could be + !! accommodated it should be close to h_end*G%areaT. + integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations + logical, optional, intent(in) :: update_vol_prev !< If present and true, update vol_prev to + !! return its value after the tracer have been updated. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face - !! [H L2 ~> m3 or kg] + optional, intent(out) :: uhr_out !< Remaining accumulated volume or mass fluxes + !! through the zonal faces [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face - !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] + optional, intent(out) :: vhr_out !< Remaining accumulated volume or mass fluxes + !! through the meridional faces [H L2 ~> m3 or kg] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -135,9 +142,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & enddo call cpu_clock_end(id_clock_pass) -!$OMP parallel default(none) shared(nz,jsd,jed,IsdB,IedB,uhr,jsdB,jedB,Isd,Ied,vhr, & -!$OMP hprev,domore_k,js,je,is,ie,uhtr,vhtr,G,GV,h_end,& -!$OMP uh_neglect,vh_neglect,ntr,Tr,h_prev_opt) + !$OMP parallel default(shared) ! This initializes the halos of uhr and vhr because pass_vector might do ! calculations on them, even though they are never used. @@ -150,7 +155,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! Put the remaining (total) thickness fluxes into uhr and vhr. do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = vhtr(i,J,k) ; enddo ; enddo - if (.not. present(h_prev_opt)) then + if (.not. present(vol_prev)) then ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. @@ -165,7 +170,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & enddo ; enddo else do i=is,ie ; do j=js,je - hprev(i,j,k) = h_prev_opt(i,j,k) + hprev(i,j,k) = vol_prev(i,j,k) enddo ; enddo endif enddo @@ -324,7 +329,9 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & if (present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) if (present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) - if (present(h_out)) h_out(:,:,:) = hprev(:,:,:) + if (present(vol_prev) .and. present(update_vol_prev)) then + if (update_vol_prev) vol_prev(:,:,:) = hprev(:,:,:) + endif call cpu_clock_end(id_clock_advect) @@ -364,7 +371,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZIB_(G),SZJ_(G),ntr) :: & flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr) :: & - T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + T_tmp ! The copy of the tracer concentration at constant i,k [conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. @@ -380,7 +387,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. - real :: tiny_h ! The smallest numerically invertable thickness [H ~> m or kg m-2]. + real :: tiny_h ! The smallest numerically invertible thickness [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: do_i(SZIB_(G),SZJ_(G)) ! If true, work on given points. @@ -450,7 +457,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then I = segment%HI%IsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_W) then T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -594,7 +601,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = uhr(I,j,k) ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else ; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -617,7 +624,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then uhh(I) = uhr(I,j,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif enddo @@ -727,9 +734,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, dimension(SZI_(G),ntr,SZJ_(G)) :: & slope_y ! The concentration slope per grid point [conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_y ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + T_tmp ! The copy of the tracer concentration at constant i,k [conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the @@ -744,7 +751,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. - real :: tiny_h ! The smallest numerically invertable thickness [H ~> m or kg m-2]. + real :: tiny_h ! The smallest numerically invertible thickness [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles. @@ -821,7 +828,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (i>=segment%HI%isd .and. i<=segment%HI%ied) then J = segment%HI%JsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_S) then T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -966,7 +973,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -989,7 +996,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index c1e39598cc..c865e645ad 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -35,17 +35,17 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & 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 [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 R Z 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 in [CU kg m-2 T-1 ~> CU kg m-2 s-1] or + !! tracer in [CU R Z 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(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir - !! [CU kg m-2]; formerly [CU m] + !! [CU R Z ~> CU kg m-2] real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks - !! [m T-1 ~> m s-1] + !! [Z T-1 ~> m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time @@ -83,7 +83,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (present(convert_flux_in)) convert_flux = convert_flux_in h_neglect = GV%H_subroundoff sink_dist = 0.0 - if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%m_to_H + if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%Z_to_H !$OMP parallel default(shared) private(sink,h_minus_dsink,b_denom_1,b1,d1,h_tr,c1) !$OMP do do j=js,je ; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo @@ -91,7 +91,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (convert_flux) then !$OMP do do j=js,je ; do i=is,ie - sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H + sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%RZ_to_H enddo ; enddo else !$OMP do @@ -104,7 +104,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (convert_flux) then !$OMP do do j=js,je ; do i=is,ie - btm_src(i,j) = (btm_flux(i,j)*dt) * GV%kg_m2_to_H + btm_src(i,j) = (btm_flux(i,j)*dt) * GV%RZ_to_H enddo ; enddo else !$OMP do @@ -174,8 +174,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & (ea(i,j,nz) + sink(i,nz)) * tr(i,j,nz-1)) endif ; enddo if (present(btm_reservoir)) then ; do i=is,ie ; if (G%mask2dT(i,j)>0.5) then - btm_reservoir(i,j) = btm_reservoir(i,j) + & - (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_kg_m2 + btm_reservoir(i,j) = btm_reservoir(i,j) + (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_RZ endif ; enddo ; endif do k=nz-1,1,-1 ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then @@ -233,7 +232,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & 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 [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 R Z 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 @@ -241,9 +240,9 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & !! [CU H ~> CU m or CU kg m-2] if !! convert_flux_in is .false. 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] + !! [CU R Z ~> CU kg m-2] real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks - !! [m T-1 ~> m s-1] + !! [Z T-1 ~> m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time @@ -282,7 +281,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & if (present(convert_flux_in)) convert_flux = convert_flux_in h_neglect = GV%H_subroundoff sink_dist = 0.0 - if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%m_to_H + if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%Z_to_H !$OMP parallel default(shared) private(sink,h_minus_dsink,b_denom_1,b1,d1,h_tr,c1) !$OMP do do j=js,je ; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo @@ -290,7 +289,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & if (convert_flux) then !$OMP do do j=js,je ; do i=is,ie - sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H + sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%RZ_to_H enddo ; enddo else !$OMP do @@ -373,8 +372,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & (ent(i,j,nz) + sink(i,nz)) * tr(i,j,nz-1)) endif ; enddo if (present(btm_reservoir)) then ; do i=is,ie ; if (G%mask2dT(i,j)>0.5) then - btm_reservoir(i,j) = btm_reservoir(i,j) + & - (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_kg_m2 + btm_reservoir(i,j) = btm_reservoir(i,j) + (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_RZ endif ; enddo ; endif do k=nz-1,1,-1 ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then @@ -425,7 +423,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim type(ocean_grid_type), intent(in ) :: G !< Grid structure type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: Tr !< Tracer concentration on T-cell + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: Tr !< Tracer concentration on T-cell [conc] real, intent(in ) :: dt !< Time-step over which forcing is applied [T ~> s] type(forcing), intent(in ) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] @@ -436,30 +434,36 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim !! which fluxes can be applied [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated !! amount of tracer that enters with freshwater + !! [conc H ~> conc m or conc kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional !< The total time-integrated !! amount of tracer that leaves with freshwater + !! [conc H ~> conc m or conc kg m-2] logical, optional, intent(in) :: update_h_opt !< Optional flag to determine whether !! h should be updated integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) - real :: H_limit_fluxes, IforcingDepthScale - real :: dThickness, dTracer - real :: fractionOfForcing, hOld, Ithickness - real :: RivermixConst ! A constant used in implementing river mixing [Pa s]. - real, dimension(SZI_(G)) :: & - netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step - netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step - netMassOut ! mass leaving ocean surface [H ~> m or kg m-2] over a time step - - real, dimension(SZI_(G),SZK_(GV)) :: h2d, Tr2d - real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! - ! that leaves with freshwater - real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d - real :: hGrounding(maxGroundings) - real :: Tr_in + real :: IforcingDepthScale ! The inverse of the scale over which to apply forcing [H-1 ~> m-1 or m2 kg-1] + real :: dThickness ! The change in a layer's thickness [H ~> m or kg m-2] + real :: dTracer ! The change in the integrated tracer content of a layer [conc H ~> conc m or conc kg m-2] + real :: fractionOfForcing ! The fraction of the forcing to apply to a layer [nondim] + real :: hOld ! The layer thickness before surface forcing is applied [H ~> m or kg m-2] + real :: Ithickness ! The inverse of the new layer thickness [H-1 ~> m-1 or m2 kg-1] + + real :: h2d(SZI_(G),SZK_(GV)) ! A 2-d work copy of layer thicknesses [H ~> m or kg m-2] + real :: Tr2d(SZI_(G),SZK_(GV)) ! A 2-d work copy of tracer concentrations [conc] + real :: in_flux(SZI_(G),SZJ_(G)) ! The total time-integrated amount of tracer that + ! enters with freshwater [conc H ~> conc m or conc kg m-2] + real :: out_flux(SZI_(G),SZJ_(G)) ! The total time-integrated amount of tracer that + ! leaves with freshwater [conc H ~> conc m or conc kg m-2] + real :: netMassIn(SZI_(G)) ! The remaining mass entering ocean surface [H ~> m or kg m-2] + real :: netMassOut(SZI_(G)) ! The remaining mass leaving ocean surface [H ~> m or kg m-2] + real :: in_flux_1d(SZI_(G)) ! The remaining amount of tracer that enters with + ! the freshwater [conc H ~> conc m or conc kg m-2] + real :: out_flux_1d(SZI_(G)) ! The remaining amount of tracer that leaves with + ! the freshwater [conc H ~> conc m or conc kg m-2] + real :: hGrounding(maxGroundings) ! The remaining fresh water flux that was not able to be + ! supplied from a column that grounded out [H ~> m or kg m-2] logical :: update_h integer :: i, j, is, ie, js, je, k, nz, n, nsw character(len=45) :: mesg @@ -493,10 +497,9 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim !$OMP IforcingDepthScale,minimum_forcing_depth, & !$OMP numberOfGroundings,iGround,jGround,update_h, & !$OMP in_flux,out_flux,hGrounding,evap_CFL_limit) & -!$OMP private(h2d,Tr2d,netMassInOut,netMassOut, & +!$OMP private(h2d,Tr2d,netMassIn,netMassOut, & !$OMP in_flux_1d,out_flux_1d,fractionOfForcing, & -!$OMP dThickness,dTracer,hOld,Ithickness, & -!$OMP netMassIn, Tr_in) +!$OMP dThickness,dTracer,hOld,Ithickness) ! Work in vertical slices for efficiency do j=js,je @@ -521,8 +524,8 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim ! Note here that the aggregateFW flag has already been taken care of in the call to ! applyBoundaryFluxesInOut do i=is,ie - netMassOut(i) = fluxes%netMassOut(i,j) - netMassIn(i) = fluxes%netMassIn(i,j) + netMassOut(i) = fluxes%netMassOut(i,j) + netMassIn(i) = fluxes%netMassIn(i,j) enddo ! Apply the surface boundary fluxes in three steps: diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 9426ced9ca..2ae72a3270 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -158,7 +158,7 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the !! control structure for the tracer !! advection and diffusion module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control + type(MOM_restart_CS), intent(inout) :: restart_CS !< A pointer to the restart control !! structure. @@ -262,13 +262,13 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) register_pseudo_salt_tracer(HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_boundary_impulse_tracer) CS%use_boundary_impulse_tracer = & - register_boundary_impulse_tracer(HI, GV, param_file, CS%boundary_impulse_tracer_CSp, & + register_boundary_impulse_tracer(HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = & register_dyed_obc_tracer(HI, GV, param_file, CS%dyed_obc_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_nw2_tracers) CS%use_nw2_tracers = & - register_nw2_tracers(HI, GV, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) + register_nw2_tracers(HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register @@ -310,7 +310,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag ! Add other user-provided calls here. if (CS%use_USER_tracer_example) & - call USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS%USER_tracer_example_CSp, & + call USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS%USER_tracer_example_CSp, & sponge_CSp) if (CS%use_DOME_tracer) & call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, & @@ -346,7 +346,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag call initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & sponge_CSp, tv) if (CS%use_boundary_impulse_tracer) & - call initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & + call initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & sponge_CSp, tv) if (CS%use_dyed_obc_tracer) & call initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS%dyed_obc_tracer_CSp) @@ -495,8 +495,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & - G, GV, CS%MOM_generic_tracer_CSp, tv, optics, & + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) endif @@ -555,8 +555,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & - G, GV, CS%MOM_generic_tracer_CSp, tv, optics) + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics) endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & @@ -575,7 +575,7 @@ end subroutine call_tracer_column_fns !> This subroutine calls all registered tracer packages to enable them to !! add to the surface state returned to the coupler. These routines are optional. -subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, & +subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock_units, & num_stocks, stock_index, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -584,6 +584,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer !! on the current PE, usually in kg x concentration [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to !! call_tracer_register. @@ -624,7 +625,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni ! Add other user-provided calls here. if (CS%use_USER_tracer_example) then - ns = USER_tracer_stock(h, values, G, GV, CS%USER_tracer_example_CSp, & + ns = USER_tracer_stock(h, values, G, GV, US, CS%USER_tracer_example_CSp, & names, units, stock_index) call store_stocks("tracer_example", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) @@ -636,44 +637,44 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni ! set_pkg_name, max_ns, ns_tot, stock_names, stock_units) ! endif if (CS%use_ideal_age) then - ns = ideal_age_stock(h, values, G, GV, CS%ideal_age_tracer_CSp, & + ns = ideal_age_stock(h, values, G, GV, US, CS%ideal_age_tracer_CSp, & names, units, stock_index) call store_stocks("ideal_age_example", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_regional_dyes) then - ns = dye_stock(h, values, G, GV, CS%dye_tracer_CSp, & + ns = dye_stock(h, values, G, GV, US, CS%dye_tracer_CSp, & names, units, stock_index) call store_stocks("regional_dyes", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_oil) then - ns = oil_stock(h, values, G, GV, CS%oil_tracer_CSp, & + ns = oil_stock(h, values, G, GV, US, CS%oil_tracer_CSp, & names, units, stock_index) call store_stocks("oil_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_OCMIP2_CFC) then - ns = OCMIP2_CFC_stock(h, values, G, GV, CS%OCMIP2_CFC_CSp, names, units, stock_index) + ns = OCMIP2_CFC_stock(h, values, G, GV, US, CS%OCMIP2_CFC_CSp, names, units, stock_index) call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_CFC_cap) then - ns = CFC_cap_stock(h, values, G, GV, CS%CFC_cap_CSp, names, units, stock_index) + ns = CFC_cap_stock(h, values, G, GV, US, CS%CFC_cap_CSp, names, units, stock_index) call store_stocks("MOM_CFC_cap", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_advection_test_tracer) then - ns = advection_test_stock( h, values, G, GV, CS%advection_test_tracer_CSp, & + ns = advection_test_stock( h, values, G, GV, US, CS%advection_test_tracer_CSp, & names, units, stock_index ) call store_stocks("advection_test_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_MOM_generic_tracer) then - ns = MOM_generic_tracer_stock(h, values, G, GV, CS%MOM_generic_tracer_CSp, & + ns = MOM_generic_tracer_stock(h, values, G, GV, US, CS%MOM_generic_tracer_CSp, & names, units, stock_index) call store_stocks("MOM_generic_tracer", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) @@ -684,14 +685,14 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni endif if (CS%use_pseudo_salt_tracer) then - ns = pseudo_salt_stock(h, values, G, GV, CS%pseudo_salt_tracer_CSp, & + ns = pseudo_salt_stock(h, values, G, GV, US, CS%pseudo_salt_tracer_CSp, & names, units, stock_index) call store_stocks("pseudo_salt_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_boundary_impulse_tracer) then - ns = boundary_impulse_stock(h, values, G, GV, CS%boundary_impulse_tracer_CSp, & + ns = boundary_impulse_stock(h, values, G, GV, US, CS%boundary_impulse_tracer_CSp, & names, units, stock_index) call store_stocks("boundary_impulse_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index eb59dcc74f..850480e3e6 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -109,8 +109,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE type - type(VarMix_CS), pointer :: VarMix !< Variable mixing type + type(MEKE_type), intent(in) :: MEKE !< MEKE fields + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers @@ -176,7 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online "register_tracer must be called before tracer_hordiff.") if (LOC(Reg)==0) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "register_tracer must be called before tracer_hordiff.") - if ((Reg%ntr==0) .or. ((CS%KhTr <= 0.0) .and. .not.associated(VarMix)) ) return + if (Reg%ntr == 0 .or. (CS%KhTr <= 0.0 .and. .not. VarMix%use_variable_mixing)) return if (CS%show_call_tree) call callTree_enter("tracer_hordiff(), MOM_tracer_hor_diff.F90") @@ -199,7 +199,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%debug) call MOM_tracer_chksum("Before tracer diffusion ", Reg%Tr, ntr, G) use_VarMix = .false. ; Resoln_scaled = .false. ; use_Eady = .false. - if (Associated(VarMix)) then + if (VarMix%use_variable_mixing) then use_VarMix = VarMix%use_variable_mixing Resoln_scaled = VarMix%Resoln_scaled_KhTr use_Eady = CS%KhTr_Slope_Cff > 0. @@ -219,7 +219,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & @@ -236,7 +236,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index bb12d316cb..2c77df3e74 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -82,9 +82,10 @@ module MOM_tracer_registry real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] +! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! expressed as a change in concentration [conc s-1] +! !! expressed as a change in concentration +! !! [conc T-1 ~> conc s-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous !! timestep used for diagnostics [conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array @@ -217,9 +218,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the !! character string template to use in !! labeling diagnostics - type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure - !! this tracer will be registered for - !! restarts if this argument is present + type(MOM_restart_CS), optional, intent(inout) :: restart_CS !< MOM restart control struct logical, optional, intent(in) :: mandatory !< If true, this tracer must be read !! from a restart file. @@ -317,14 +316,13 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit if (present(advection_xy)) then ; if (associated(advection_xy)) Tr%advection_xy => advection_xy ; endif - if (present(restart_CS)) then ; if (associated(restart_CS)) then + if (present(restart_CS)) then ! Register this tracer to be read from and written to restart files. mand = .true. ; if (present(mandatory)) mand = mandatory call register_restart_field(tr_ptr, Tr%name, mand, restart_CS, & longname=Tr%longname, units=Tr%units) - endif ; endif - + endif end subroutine register_tracer @@ -829,7 +827,7 @@ subroutine MOM_tracer_chkinv(mesg, G, GV, h, Tr, ntr) integer, intent(in) :: ntr !< number of registered tracers ! Local variables - real :: vol_scale ! The dimensional scaling factor to convert volumes to m3 [m3 H-1 L-2 ~> nondim or m3 kg-1] + real :: vol_scale ! The dimensional scaling factor to convert volumes to m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tr_inv ! Volumetric tracer inventory in each cell [conc m3] real :: total_inv ! The total amount of tracer [conc m3] integer :: is, ie, js, je, nz diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 6d355db36f..244eebb2bc 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -72,7 +72,7 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(RGC_tracer_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct character(len=80) :: name, longname ! This include declares and sets the variable "version". @@ -184,7 +184,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. real, pointer :: tr_ptr(:,:,:) => NULL() real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg-2]. + ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB integer :: nzdata diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4d05d43fd9..8fdb525b4a 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -71,7 +71,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname @@ -344,12 +344,13 @@ end subroutine advection_test_tracer_surface_state !> Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated. !! If the stock_index is present, only the stock corresponding to that coded index is returned. -function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) +function advection_test_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -358,7 +359,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: advection_test_stock !< the number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -373,7 +374,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="advection_test_stock") stocks(m) = 0.0 diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 3aaa51b301..ea60a09608 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -46,9 +46,8 @@ module boundary_impulse_tracer integer :: nkml !< Number of layers in mixed layer real, dimension(NTR_MAX) :: land_val = -1.0 !< A value to use to fill in tracers over land - real :: kw_eff !< An effective piston velocity used to flux tracer out at the surface real :: remaining_source_time !< How much longer (same units as the timestep) to - !! inject the tracer at the surface [s] + !! inject the tracer at the surface [T ~> s] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -60,16 +59,17 @@ module boundary_impulse_tracer contains !> Read in runtime options and add boundary impulse tracer to tracer registry -function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) +function register_boundary_impulse_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in ) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + type(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(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name. @@ -79,7 +79,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() real, pointer :: rem_time_ptr => NULL() logical :: register_boundary_impulse_tracer @@ -99,7 +99,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar "Length of time for the boundary tracer to be injected "//& "into the mixed layer. After this time has elapsed, the "//& "surface becomes a sink for the boundary impulse tracer.", & - default=31536000.0) + default=31536000.0, scale=US%s_to_T) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code "//& "if they are not found in the restart files. Otherwise "//& @@ -145,13 +145,14 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar end function register_boundary_impulse_tracer !> Initialize tracer from restart or set to 1 at surface to initialize -subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, tv) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -186,14 +187,17 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=name, caller="initialize_boundary_impulse_tracer") - if ((.not.restart) .or. (.not. & - query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then + if ((.not.restart) .or. (.not. query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then do k=1,CS%nkml ; do j=jsd,jed ; do i=isd,ied CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo endif enddo ! Tracer loop + if (restart .and. (US%s_to_T_restart /= 0.0) .and. (US%s_to_T /= US%s_to_T_restart) ) then + CS%remaining_source_time = (US%s_to_T / US%s_to_T_restart) * CS%remaining_source_time + endif + if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. endif @@ -268,7 +272,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo - CS%remaining_source_time = CS%remaining_source_time-US%T_to_s*dt + CS%remaining_source_time = CS%remaining_source_time-dt else do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 0.0 @@ -283,12 +287,13 @@ end subroutine boundary_impulse_tracer_column_physics !> This function calculates the mass-weighted integral of the boundary impulse, !! tracer stocks returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) +function boundary_impulse_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. @@ -302,7 +307,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) ! is present, only the stock corresponding to that coded index is returned. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -317,7 +322,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,1 call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="boundary_impulse_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a26c967eae..dca01e974a 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -72,7 +72,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) !! structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and diffusion module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables ! This include declares and sets the variable "version". @@ -325,12 +325,13 @@ end subroutine dye_tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) +function dye_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of !! each tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(dye_tracer_CS), pointer :: CS !< The control structure returned by a !! previous call to register_dye_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -341,7 +342,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) !! calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -356,7 +357,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="dye_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index f299febfa8..b6bd212a37 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -56,7 +56,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(dyed_obc_tracer_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index ffe4f9df72..d5c813b3d0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -76,7 +76,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -369,13 +369,14 @@ end subroutine ideal_age_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it !! has calculated. If stock_index is present, only the stock corresponding to that coded index is found. -function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) +function ideal_age_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -385,7 +386,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: ideal_age_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -400,7 +401,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="ideal_age_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index 4578a422dc..0e66ebbcf3 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -33,7 +33,8 @@ module nw2_tracers type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? - real, allocatable , dimension(:) :: restore_rate !< The exponential growth rate for restoration value [year-1]. + real, allocatable , dimension(:) :: restore_rate !< The rate at which the tracer is damped toward + !! its target profile [T-1 ~> s-1] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure @@ -42,16 +43,17 @@ module nw2_tracers contains !> Register the NW2 tracer fields to be used with MOM. -logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS) +logical function register_nw2_tracers(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(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(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -62,7 +64,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS logical :: do_nw2 integer :: isd, ied, jsd, jed, nz, m, ig integer :: n_groups ! Number of groups of three tracers (i.e. # tracers/3) - real, allocatable, dimension(:) :: timescale_in_days + real, allocatable, dimension(:) :: timescale_in_days ! Damping timescale [days] type(vardesc) :: tr_desc ! Descriptions and metadata for the tracers isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -100,7 +102,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, tr_desc=tr_desc, & registry_diags=.true., restart_CS=restart_CS, mandatory=.false.) ig = int( (m+2)/3 ) ! maps (1,2,3)->1, (4,5,6)->2, ... - CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0 ) + CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0*US%s_to_T ) enddo CS%tr_Reg => tr_Reg @@ -125,8 +127,8 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights - real :: rscl ! z* scaling factor + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] + real :: rscl ! z* scaling factor [nondim] character(len=8) :: var_name ! The variable's name. integer :: i, j, k, m @@ -206,11 +208,11 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] integer :: i, j, k, m - real :: dt_x_rate ! dt * restoring rate - real :: rscl ! z* scaling factor + real :: dt_x_rate ! dt * restoring rate [nondim] + real :: rscl ! z* scaling factor [nondim] real :: target_value ! tracer value ! if (.not.associated(CS)) return @@ -253,8 +255,8 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US endif do m=1,CS%ntr - dt_x_rate = ( dt * CS%restore_rate(m) ) * US%T_to_s -!$OMP parallel do default(private) shared(CS,G,dt,dt_x_rate) + dt_x_rate = dt * CS%restore_rate(m) + !$OMP parallel do default(shared) private(target_value) do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec target_value = nw2_tracer_dist(m, G, GV, eta, i, j, k) CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j) * dt_x_rate * ( target_value - CS%tr(i,j,k,m) ) @@ -270,13 +272,13 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),0:SZK_(G)), & - intent(in) :: eta !< Interface position [m] + intent(in) :: eta !< Interface position [Z ~> m] integer, intent(in) :: i !< Cell index i integer, intent(in) :: j !< Cell index j integer, intent(in) :: k !< Layer index k ! Local variables - real :: pi ! 3.1415... - real :: x, y, z ! non-dimensional positions + real :: pi ! 3.1415... [nondim] + real :: x, y, z ! non-dimensional relative positions [nondim] pi = 2.*acos(0.) x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1 y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1 diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index fcc0de23d8..6f690ab760 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -51,7 +51,6 @@ module oil_tracer real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. - real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil [T-1 ~> s-1] calculated from oil_decay_days integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code @@ -78,12 +77,13 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "oil_tracer" ! This module's name. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" + real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying oils @@ -136,7 +136,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "OIL_SOURCE_RATE", CS%oil_source_rate, & "The rate of oil injection.", & units="kg s-1", scale=US%T_to_s, default=1.0) - call get_param(param_file, mdl, "OIL_DECAY_DAYS", CS%oil_decay_days, & + call get_param(param_file, mdl, "OIL_DECAY_DAYS", oil_decay_days, & "The decay timescale in days (if positive), or no decay "//& "if 0, or use the temperature dependent decay rate of "//& "Adcroft et al. (GRL, 2010) if negative.", units="days", & @@ -156,9 +156,9 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%ntr = CS%ntr + 1 CS%tr_desc(m) = var_desc("oil"//trim(name_tag), "kg m-3", "Oil Tracer", caller=mdl) CS%IC_val(m) = 0.0 - if (CS%oil_decay_days(m)>0.) then - CS%oil_decay_rate(m) = 1. / (86400.0*US%s_to_T * CS%oil_decay_days(m)) - elseif (CS%oil_decay_days(m)<0.) then + if (oil_decay_days(m) > 0.) then + CS%oil_decay_rate(m) = 1. / (86400.0*US%s_to_T * oil_decay_days(m)) + elseif (oil_decay_days(m) < 0.) then CS%oil_decay_rate(m) = -1. endif endif @@ -326,9 +326,12 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real :: Isecs_per_year = 1.0 / (365.0*86400.0) - real :: vol_scale ! A conversion factor for volumes into m3 [m3 H-1 L-2 ~> nondim or m3 kg-1] - real :: year, h_total, ldecay + real :: Isecs_per_year = 1.0 / (365.0*86400.0) ! Conversion factor from seconds to year [year s-1] + real :: vol_scale ! A conversion factor for volumes into m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] + real :: year ! Time in fractional years [years] + real :: h_total ! A running sum of thicknesses [H ~> m or kg m-2] + real :: decay_timescale ! Chemical decay timescale for oil [T ~> s] + real :: ldecay ! Chemical decay rate of oil [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -360,8 +363,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (CS%oil_decay_rate(m)>0.) then CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then - ldecay = 12.*(3.0**(-(tv%T(i,j,k)-20.)/10.)) ! Timescale [days] - ldecay = 1. / (86400.*US%s_to_T * ldecay) ! Rate [T-1 ~> s-1] + decay_timescale = (12.*(3.0**(-(tv%T(i,j,k)-20.)/10.))) * (86400.*US%s_to_T) ! Timescale [s ~> T] + ldecay = 1. / decay_timescale ! Rate [T-1 ~> s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*ldecay,0.)*CS%tr(i,j,k,m) endif enddo ; enddo ; enddo @@ -399,12 +402,13 @@ end subroutine oil_tracer_column_physics !> Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it !! has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) +function oil_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -414,7 +418,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: oil_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -429,7 +433,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="oil_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index cd1ee41ebd..c441e519be 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -3,25 +3,25 @@ module pseudo_salt_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : hchksum -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : query_initialized, MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_debugging, only : hchksum +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -36,15 +36,15 @@ module pseudo_salt_tracer type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this - !! subroutine [ppt} - real, pointer :: diff(:,:,:) => NULL() !< The difference between the pseudo-salt + !! subroutine [ppt] + real, allocatable :: diff(:,:,:) !< The difference between the pseudo-salt !! tracer and the real salt [ppt]. logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter - integer :: id_psd = -1 !< A diagnostic ID + integer :: id_psd = -1 !< A diagnostic ID - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to - !! regulate the timing of diagnostic output. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate + !! the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(vardesc) :: tr_desc !< A description and metadata for the pseudo-salt tracer @@ -52,35 +52,32 @@ module pseudo_salt_tracer contains -!> Register the pseudo-salt tracer with MOM6 +!> Register the pseudo-salt tracer with MOM6, and return .true. if the tracer is to be used. function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control - !! structure for the tracer advection and - !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control structure ! Local variables character(len=40) :: mdl = "pseudo_salt_tracer" ! This module's name. - character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. - character(len=3) :: name_tag ! String for creating identifying pseudo_salt -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_pseudo_salt_tracer - integer :: isd, ied, jsd, jed, nz, i, j + integer :: isd, ied, jsd, jed, nz isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(WARNING, "register_pseudo_salt_tracer called with an "// & "associated control structure.") + register_pseudo_salt_tracer = .false. return endif allocate(CS) @@ -89,7 +86,6 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call log_version(param_file, mdl, version, "") allocate(CS%ps(isd:ied,jsd:jed,nz), source=0.0) - allocate(CS%diff(isd:ied,jsd:jed,nz), source=0.0) CS%tr_desc = var_desc(trim("pseudo_salt"), "psu", & "Pseudo salt passive tracer", caller=mdl) @@ -113,38 +109,30 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. - type(time_type), target, intent(in) :: day !< Time of the start of the run. + type(time_type), target, intent(in) :: day !< Time of the start of the run type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate - !! diagnostic output. + !! diagnostic output type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables -! This subroutine initializes the tracer fields in CS%ps(:,:,:). + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing various thermodynamic variables + + ! This subroutine initializes the tracer fields in CS%ps(:,:,:). ! Local variables - character(len=16) :: name ! A variable's name in a NetCDF file. - character(len=72) :: longname ! The long name of that variable. - character(len=48) :: units ! The dimensions of the variable. - character(len=48) :: flux_units ! The units for age tracer fluxes, either - ! years m3 s-1 or years kg s-1. - logical :: OK - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: IsdB, IedB, JsdB, JedB + character(len=16) :: name ! A variable's name in a NetCDF file + integer :: i, j, k, isd, ied, jsd, jed, nz if (.not.associated(CS)) return - if (.not.associated(CS%diff)) return - 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 ; JsdB = G%JsdB ; JedB = G%JedB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke CS%Time => day CS%diag => diag @@ -163,112 +151,132 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, CS%id_psd = register_diag_field("ocean_model", "pseudo_salt_diff", CS%diag%axesTL, & day, "Difference between pseudo salt passive tracer and salt tracer", "psu") + if (.not.allocated(CS%diff)) allocate(CS%diff(isd:ied,jsd:jed,nz), source=0.0) end subroutine initialize_pseudo_salt_tracer !> Apply sources, sinks and diapycnal diffusion to the tracers in this package. subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: ea !< an array to which the amount of fluid entrained - !! from the layer above during this call will be - !! added [H ~> m or kg m-2]. + intent(in) :: ea !< The amount of fluid entrained from the layer above + !! during this call [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: eb !< an array to which the amount of fluid entrained - !! from the layer below during this call will be - !! added [H ~> m or kg m-2]. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic - !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + intent(in) :: eb !< The amount of fluid entrained from the layer below + !! during this call [H ~> m or kg m-2] + type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic and + !! tracer forcing fields + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: debug !< If true calculate checksums real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep [nondim] + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied [H ~> m or kg m-2] + !! fluxes can be applied [H ~> m or kg m-2] -! This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. + ! This subroutine applies diapycnal diffusion and any other column + ! tracer physics or chemistry to the tracers from this file. -! The arguments to this subroutine are redundant in that -! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) + ! The arguments to this subroutine are redundant in that + ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real :: year, h_total, scale, htot, Ih_limit - integer :: secs, days - integer :: i, j, k, is, ie, js, je, nz, k_max + real :: net_salt(SZI_(G),SZJ_(G)) ! Net salt flux into the ocean integrated over + ! a timestep [ppt H ~> ppt m or ppt kg m-2] + real :: htot(SZI_(G)) ! Total ocean depth [H ~> m or kg m-2] + real :: FluxRescaleDepth ! Minimum total ocean depth at which fluxes start to be scaled + ! away [H ~> m or kg m-2] + real :: Ih_limit ! Inverse of FluxRescaleDepth or 0 for no limiting [H-1 ~> m-1 or m2 kg-1] + real :: scale ! Scale scales away fluxes if depth < FluxRescaleDepth [nondim] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return - if (.not.associated(CS%diff)) return + if (.not.associated(CS%ps)) return if (debug) then call hchksum(tv%S,"salt pre pseudo-salt vertdiff", G%HI) call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI) endif - ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + ! This option uses applyTracerBoundaryFluxesInOut, usually in ALE mode + + ! Determine the time-integrated salt flux, including limiting for small total ocean depths. + net_Salt(:,:) = 0.0 + FluxRescaleDepth = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) + Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth + do j=js,je + do i=is,ie ; htot(i) = h_old(i,j,1) ; enddo + do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h_old(i,j,k) ; enddo ; enddo + do i=is,ie + scale = 1.0 ; if ((Ih_limit > 0.0) .and. (htot(i)*Ih_limit < 1.0)) scale = htot(i)*Ih_limit + net_salt(i,j) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H + enddo + enddo + do k=1,nz ; do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CS%ps, dt, fluxes, h_work, & - evap_CFL_limit, minimum_forcing_depth, out_flux_optional=fluxes%netSalt) + call applyTracerBoundaryFluxesInOut(G, GV, CS%ps, dt, fluxes, h_work, evap_CFL_limit, & + minimum_forcing_depth, out_flux_optional=net_salt) call tracer_vertdiff(h_work, ea, eb, dt, CS%ps, G, GV) else call tracer_vertdiff(h_old, ea, eb, dt, CS%ps, G, GV) endif - do k=1,nz ; do j=js,je ; do i=is,ie - CS%diff(i,j,k) = CS%ps(i,j,k)-tv%S(i,j,k) - enddo ; enddo ; enddo - if (debug) then - call hchksum(tv%S,"salt post pseudo-salt vertdiff", G%HI) - call hchksum(CS%ps,"pseudo_salt post pseudo-salt vertdiff", G%HI) + call hchksum(tv%S, "salt post pseudo-salt vertdiff", G%HI) + call hchksum(CS%ps, "pseudo_salt post pseudo-salt vertdiff", G%HI) endif - if (CS%id_psd>0) call post_data(CS%id_psd, CS%diff, CS%diag) + if (allocated(CS%diff)) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%diff(i,j,k) = CS%ps(i,j,k) - tv%S(i,j,k) + enddo ; enddo ; enddo + if (CS%id_psd>0) call post_data(CS%id_psd, CS%diff, CS%diag) + endif end subroutine pseudo_salt_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] +function pseudo_salt_stock(h, stocks, G, GV, US, CS, names, units, stock_index) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + !! tracer, in kg times concentration units [kg conc] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated integer, optional, intent(in) :: stock_index !< The coded index of a specific stock - !! being sought. + !! being sought integer :: pseudo_salt_stock !< Return value: the number of - !! stocks calculated here. + !! stocks calculated here ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pseudo_salt_stock = 0 if (.not.associated(CS)) return - if (.not.associated(CS%diff)) return + if (.not.allocated(CS%diff)) return if (present(stock_index)) then ; if (stock_index > 0) then ! Check whether this stock is available from this routine. @@ -277,7 +285,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 call query_vardesc(CS%tr_desc, name=names(1), units=units(1), caller="pseudo_salt_stock") units(1) = trim(units(1))//" kg" stocks(1) = 0.0 @@ -294,22 +302,18 @@ end function pseudo_salt_stock !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. subroutine pseudo_salt_tracer_surface_state(sfc_state, h, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. + !! call to register_pseudo_salt_tracer ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. - integer :: m, is, ie, js, je, isd, ied, jsd, jed - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (.not.associated(CS)) return ! By design, this tracer package does not return any surface states. @@ -319,12 +323,11 @@ end subroutine pseudo_salt_tracer_surface_state !> Deallocate memory associated with this tracer package subroutine pseudo_salt_tracer_end(CS) type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - integer :: m + !! call to register_pseudo_salt_tracer if (associated(CS)) then if (associated(CS%ps)) deallocate(CS%ps) - if (associated(CS%diff)) deallocate(CS%diff) + if (allocated(CS%diff)) deallocate(CS%diff) deallocate(CS) endif end subroutine pseudo_salt_tracer_end diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 3eb83a79c5..a41f0ab76d 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -60,7 +60,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname @@ -134,13 +134,14 @@ end function USER_register_tracer_example !> This subroutine initializes the NTR tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. -subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -163,7 +164,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. - real :: dist2 ! The distance squared from a line [m2]. + real :: dist2 ! The distance squared from a line [L2 ~> m2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB, lntr @@ -196,9 +197,9 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! This sets a stripe of tracer across the basin. PI = 4.0*atan(1.0) do j=js,je - dist2 = (G%Rad_Earth * PI / 180.0)**2 * & + dist2 = (G%Rad_Earth_L * PI / 180.0)**2 * & (G%geoLatT(i,j) - 40.0) * (G%geoLatT(i,j) - 40.0) - tr_y = 0.5*exp(-dist2/(1.0e5*1.0e5)) + tr_y = 0.5 * exp( -dist2 / (1.0e5*US%m_to_L)**2 ) do k=1,nz ; do i=is,ie ! This adds the stripes of tracer to every layer. @@ -282,10 +283,10 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, ! Local variables real :: hold0(SZI_(G)) ! The original topmost layer thickness, - ! with surface mass fluxes added back, m. - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. - real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver. + ! with surface mass fluxes added back [H ~> m or kg m-2]. + real :: b1(SZI_(G)) ! b1 is a variable used by the tridiagonal solver [H ~> m or kg m-2]. + real :: c1(SZI_(G),SZK_(GV)) ! c1 is a variable used by the tridiagonal solver [nondim]. + real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. @@ -357,13 +358,14 @@ end subroutine tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) +function USER_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a !! previous call to register_USER_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -374,7 +376,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) !! stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -388,7 +390,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,NTR call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="USER_tracer_stock") units(m) = trim(units(m))//" kg" diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 49c0a03235..8ef21d190f 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -35,15 +35,14 @@ 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, US, param_file, eqn_of_state) +subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(GV%ke), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(GV%ke+1), 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 to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - ! Local variables + real :: drho_dt, SST_s, T_bot, rho_top, rho_bot integer :: k, nz character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name. @@ -92,7 +91,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, in depth units [Z ~> m]. - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: H0(SZK_(GV)) ! Resting layer thicknesses in depth units [Z ~> m]. real :: min_depth ! The minimum ocean depth in depth units [Z ~> m]. real :: slat, wlon, lenlat, lenlon, nlat diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 3963d4d90d..6214f2d095 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -29,8 +29,6 @@ module BFB_surface_forcing 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 [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] @@ -54,7 +52,7 @@ subroutine BFB_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure @@ -179,8 +177,9 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to !! regulate diagnostic output. type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure for this module -! This include declares and sets the variable "version". -#include "version_variable.h" + + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "BFB_surface_forcing" ! This module's name. if (associated(CS)) then @@ -220,8 +219,6 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, & "The rate of change of density with temperature.", & units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R) - call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", default=0.0) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index f99f0b8d5c..70b4bbc27d 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -90,18 +90,18 @@ subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) end subroutine DOME2d_initialize_topography !> Initialize thicknesses according to coordinate mode -subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params ) +subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: e0(SZK_(GV)) ! The resting interface heights, in depth units [Z ~> m], usually @@ -113,13 +113,10 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju real :: delta_h real :: min_thickness real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") @@ -223,34 +220,28 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration -subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. - ! Local variables integer :: i, j, k, is, ie, js, je, nz real :: x integer :: index_bay_z real :: delta_S, delta_T - real :: S_ref, T_ref; ! Reference salinity and temperature within surface layer - real :: S_range, T_range; ! Range of salinities and temperatures over the vertical + real :: S_ref, T_ref ! Reference salinity and temperature within surface layer + real :: S_range, T_range ! Range of salinities and temperatures over the vertical real :: xi0, xi1 - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & @@ -371,7 +362,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [ppt] real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2]. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m] - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: S_ref ! Reference salinity within the surface layer [ppt] real :: T_ref ! Reference temerature within the surface layer [degC] real :: S_range ! Range of salinities in the vertical [ppt] @@ -427,7 +418,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A call get_param(param_file, mdl, "T_RANGE", T_range, default=0.0) - ! Set the inverse damping rate as a function of position + ! Set the sponge damping rate as a function of position Idamp(:,:) = 0.0 do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0.) then ! Only set damping rate for wet points diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 1f3d24e1c9..248bf6c0f0 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -40,13 +40,12 @@ module DOME_initialization subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum and maximum depths [Z ~> m]. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -57,22 +56,20 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" DOME_initialization.F90, DOME_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) do j=js,je ; do i=is,ie if (G%geoLatT(i,j) < 600.0) then if (G%geoLatT(i,j) < 300.0) then D(i,j) = max_depth else - D(i,j) = max_depth - 10.0*m_to_Z * (G%geoLatT(i,j)-300.0) + D(i,j) = max_depth - 10.0*US%m_to_Z * (G%geoLatT(i,j)-300.0) endif else if ((G%geoLonT(i,j) > 1000.0) .AND. (G%geoLonT(i,j) < 1100.0)) then - D(i,j) = 600.0*m_to_Z + D(i,j) = 600.0*US%m_to_Z else D(i,j) = 0.5*min_depth endif @@ -87,7 +84,7 @@ end subroutine DOME_initialize_topography ! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the DOME experiment -subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_params) +subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) 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)), & @@ -96,21 +93,18 @@ subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_ intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. call MOM_mesg(" DOME_initialization.F90, DOME_initialize_thickness: setting thickness", 5) @@ -142,18 +136,16 @@ end subroutine DOME_initialize_thickness ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -!> This subroutine sets the inverse restoration time (Idamp), and ! -!! the values towards which the interface heights and an arbitrary ! -!! number of tracers should be restored within each sponge. The ! -!! interface height is always subject to damping, and must always be ! -!! the first registered field. ! +!> This subroutine sets the inverse restoration time (Idamp), and the values +!! toward which the interface heights and an arbitrary number of tracers will be +!! restored within the sponges for the DOME configuration. ! subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temperature and - !! salinity or mixed layer density. Absent fields have NULL ptrs. + type(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 any available + !! thermodynamic fields, including potential + !! temperature and salinity or mixed layer density. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: PF !< A structure indicating the open file to @@ -162,12 +154,15 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) !! structure for this module. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. - real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables. ! - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. + real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables [various] + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] - real :: H0(SZK_(GV)) ! Interface heights [Z ~> m]. + real :: e_tgt(SZK_(GV)+1) ! Target interface heights [Z ~> m]. real :: min_depth ! The minimum depth at which to apply damping [Z ~> m] - real :: damp, damp_new ! Damping rates in the sponge [days] + real :: damp_W, damp_E ! Damping rates in the western and eastern sponges [days-1] + real :: peak_damping ! The maximum sponge damping rates as the edges [days-1] + real :: edge_dist ! The distance to an edge, in the same units as longitude [km] + real :: sponge_width ! The width of the sponges, in the same units as longitude [km] real :: e_dense ! The depth of the densest interfaces [Z ~> m] character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -175,66 +170,61 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - eta(:,:,:) = 0.0 ; temp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 - -! Here the inverse damping time [s-1], is set. Set Idamp to 0 ! -! wherever there is no sponge, and the subroutines that are called ! -! will automatically set up the sponges only where Idamp is positive! -! and mask2dT is 1. ! - -! Set up sponges for DOME configuration + ! Set up sponges for the DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) - H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo - do j=js,je ; do i=is,ie - if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 - elseif (G%geoLonT(i,j) < 200.0) then - damp = 10.0 * (200.0-G%geoLonT(i,j))/100.0 - else ; damp=0.0 + ! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 wherever + ! there is no sponge, and the subroutines that are called will automatically + ! set up the sponges only where Idamp is positive and mask2dT is 1. + peak_damping = 10.0 ! The maximum sponge damping rate in [days-1] + sponge_width = 200.0 ! The width of the sponges [km] + Idamp(:,:) = 0.0 + do j=js,je ; do i=is,ie ; if (depth_tot(i,j) > min_depth) then + edge_dist = G%geoLonT(i,j) - G%west_lon + if (edge_dist < 0.5*sponge_width) then + damp_W = peak_damping + elseif (edge_dist < sponge_width) then + damp_W = peak_damping * (sponge_width - edge_dist) / (0.5*sponge_width) + else + damp_W = 0.0 endif - if (G%geoLonT(i,j) > 1400.0) then ; damp_new = 10.0 - elseif (G%geoLonT(i,j) > 1300.0) then - damp_new = 10.0 * (G%geoLonT(i,j)-1300.0)/100.0 - else ; damp_new = 0.0 + edge_dist = (G%len_lon + G%west_lon) - G%geoLonT(i,j) + if (edge_dist < 0.5*sponge_width) then + damp_E = peak_damping + elseif (edge_dist < sponge_width) then + damp_E = peak_damping * (sponge_width - edge_dist) / (0.5*sponge_width) + else + damp_E = 0.0 endif - if (damp <= damp_new) damp = damp_new - damp = US%T_to_s*damp - - ! These will be stretched inside of apply_sponge, so they can be in - ! depth space for Boussinesq or non-Boussinesq models. - eta(i,j,1) = 0.0 - do k=2,nz -! eta(i,j,K) = max(H0(k), -depth_tot(i,j), GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j)) - e_dense = -depth_tot(i,j) - if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense - else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j)) & - eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j) - enddo - eta(i,j,nz+1) = -depth_tot(i,j) - - if (depth_tot(i,j) > min_depth) then - Idamp(i,j) = damp / 86400.0 - else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo + Idamp(i,j) = max(damp_W, damp_E) / (86400.0 * US%s_to_T) + endif ; enddo ; enddo + + e_tgt(1) = 0.0 + do K=2,nz ; e_tgt(K) = -(real(K-1)-0.5)*G%max_depth / real(nz-1) ; enddo + e_tgt(nz+1) = -G%max_depth + eta(:,:,:) = 0.0 + do K=1,nz+1 ; do j=js,je ; do i=is,ie + ! These target interface heights will be rescaled inside of apply_sponge, so + ! they can be in depth space for Boussinesq or non-Boussinesq models. + eta(i,j,K) = max(e_tgt(K), GV%Angstrom_Z*(nz+1-K) - depth_tot(i,j)) + enddo ; enddo ; enddo -! This call sets up the damping rates and interface heights. -! This sets the inverse damping timescale fields in the sponges. ! + ! This call stores the sponge damping rates and target interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) -! Now register all of the fields which are damped in the sponge. ! -! By default, momentum is advected vertically within the sponge, but ! -! momentum is typically not damped within the sponge. ! + ! Now register all of the fields which are damped in the sponge. + ! By default, momentum is advected vertically within the sponge, but + ! momentum is typically not damped within the layer-mode sponge. -! At this point, the DOME configuration is done. The following are here as a +! At this point, the layer-mode DOME configuration is done. The following are here as a ! template for other configurations. -! The remaining calls to set_up_sponge_field can be in any order. ! + ! The remaining calls to set_up_sponge_field can be in any order. if ( associated(tv%T) ) then + temp(:,:,:) = 0.0 call MOM_error(FATAL,"DOME_initialize_sponges is not set up for use with"//& " a temperatures defined.") ! This should use the target values of T in temp. @@ -250,7 +240,7 @@ end subroutine DOME_initialize_sponges subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ocean_OBC_type), pointer :: OBC !< OBC registry. + type(ocean_OBC_type), pointer :: OBC !< OBC registry. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. if (OBC%number_of_segments /= 1) then @@ -259,7 +249,7 @@ subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) ! Store this information for use in setting up the OBC restarts for tracer reservoirs. OBC%ntr = tr_Reg%ntr - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then allocate(OBC%tracer_x_reservoirs_used(OBC%ntr)) allocate(OBC%tracer_y_reservoirs_used(OBC%ntr)) OBC%tracer_x_reservoirs_used(:) = .false. @@ -286,26 +276,34 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. -! Local variables - ! The following variables are used to set the target temperature and salinity. - real :: T0(SZK_(GV)) ! A profile of temperatures [degC] - real :: S0(SZK_(GV)) ! A profile of salinities [ppt] + ! Local variables + real :: T0(SZK_(GV)) ! A profile of target temperatures [degC] + real :: S0(SZK_(GV)) ! A profile of target salinities [ppt] real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! 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 - ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2]. - real :: Def_Rad ! The deformation radius, based on fluid of - ! thickness D_edge, in the same units as lat [m]. + real :: tr_0 ! The total integrated inflow transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: tr_k ! The integrated inflow transport of a layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: v_k ! The velocity of a layer at the edge [L T-1 ~> m s-1] + real :: yt, yb ! The log of these variables gives the fractional velocities at the + ! top and bottom of a layer [nondim] + real :: rst, rsb ! The relative position of the top and bottom of a layer [nondim], + ! with a range from 0 for the densest water to -1 for the lightest + real :: rc ! The relative position of the center of a layer [nondim] + real :: lon_im1 ! An extrapolated value for the longitude of the western edge of a + ! v-velocity face, in the same units as G%geoLon [km] + real :: D_edge ! The thickness [Z ~> m] of the dense fluid at the + ! inner edge of the inflow + real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2] + real :: Def_Rad ! The deformation radius, based on fluid of thickness D_edge, + ! in the same units as G%geoLon [km] real :: Ri_trans ! The shear Richardson number in the transition - ! region of the specified shear profile. + ! region of the specified shear profile [nondim] character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. character(len=32) :: name ! The name of a tracer field. - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, ntherm integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() type(tracer_type), pointer :: tr_ptr => NULL() @@ -333,7 +331,11 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) segment => OBC%segment(1) if (.not. segment%on_pe) return - allocate(segment%field(tr_Reg%ntr)) + ! Set up space for the OBCs to use for all the tracers. + ntherm = 0 + if (associated(tv%S)) ntherm = ntherm + 1 + if (associated(tv%T)) ntherm = ntherm + 1 + allocate(segment%field(ntherm+tr_Reg%ntr)) do k=1,nz rst = -1.0 @@ -344,10 +346,10 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) rc = -1.0 + real(k-1)/real(nz-1) ! These come from assuming geostrophy and a constant Ri profile. - y1 = (2.0*Ri_trans*rst + Ri_trans + 2.0)/(2.0 - Ri_trans) - y2 = (2.0*Ri_trans*rsb + Ri_trans + 2.0)/(2.0 - Ri_trans) + yt = (2.0*Ri_trans*rst + Ri_trans + 2.0)/(2.0 - Ri_trans) + yb = (2.0*Ri_trans*rsb + Ri_trans + 2.0)/(2.0 - Ri_trans) tr_k = tr_0 * (2.0/(Ri_trans*(2.0-Ri_trans))) * & - ((log(y1)+1.0)/y1 - (log(y2)+1.0)/y2) + ((log(yt)+1.0)/yt - (log(yb)+1.0)/yb) v_k = -sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & (2.0 - Ri_trans)) if (k == nz) tr_k = tr_k + tr_0 * (2.0/(Ri_trans*(2.0+Ri_trans))) * & @@ -356,6 +358,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) isd = segment%HI%isd ; ied = segment%HI%ied JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB do J=JsdB,JedB ; do i=isd,ied + ! Here lon_im1 estimates G%geoLonBu(I-1,J), which may not have been set if + ! the symmetric memory mode is not being used. lon_im1 = 2.0*G%geoLonCv(i,J) - G%geoLonBu(I,J) segment%normal_trans(i,J,k) = tr_k * (exp(-2.0*(lon_im1 - 1000.0)/Def_Rad) -& exp(-2.0*(G%geoLonBu(I,J) - 1000.0)/Def_Rad)) @@ -386,7 +390,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo - ! Temperature on tracer 1??? + ! Temperature is tracer 1 for the OBCs. allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied segment%field(1)%buffer_src(i,j,k) = T0(k) @@ -396,18 +400,17 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.true.) endif - ! Dye tracers - fight with T,S??? + ! Set up dye tracers ! First dye - only one with OBC values - ! This field(1) requires tr_D1 to be the first tracer. - allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) + ! This field(ntherm+1) requires tr_D1 to be the first tracer after temperature and salinity. + allocate(segment%field(ntherm+1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%isd,segment%HI%ied - if (k < nz/2) then ; segment%field(1)%buffer_src(i,j,k) = 0.0 - else ; segment%field(1)%buffer_src(i,j,k) = 1.0 ; endif + if (k < nz/2) then ; segment%field(ntherm+1)%buffer_src(i,j,k) = 0.0 + else ; segment%field(ntherm+1)%buffer_src(i,j,k) = 1.0 ; endif enddo ; enddo ; enddo name = 'tr_D1' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, & - OBC%segment(1), OBC_array=.true.) + call register_segment_tracer(tr_ptr, param_file, GV, OBC%segment(1), OBC_array=.true.) ! All tracers but the first have 0 concentration in their inflows. As 0 is the ! default value for the inflow concentrations, the following calls are unnecessary. @@ -415,8 +418,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, & - OBC%segment(1), OBC_scalar=0.0) + call register_segment_tracer(tr_ptr, param_file, GV, OBC%segment(1), OBC_scalar=0.0) enddo end subroutine DOME_set_OBC_data diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 76f60d9b99..7386a008e6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -42,18 +42,17 @@ module ISOMIP_initialization subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. - real :: bmax ! max depth of bedrock topography - real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff - real :: xbar ! characteristic along-flow lenght scale of the bedrock + real :: bmax ! max depth of bedrock topography [Z ~> m] + real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] + real :: xbar ! characteristic along-flow length scale of the bedrock real :: dc ! depth of the trough compared with side walls [Z ~> m]. real :: fc ! characteristic width of the side walls of the channel real :: wc ! half-width of the trough @@ -70,16 +69,14 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) ! The following variables should be transformed into runtime parameters? - bmax = 720.0*m_to_Z ; dc = 500.0*m_to_Z - b0 = -150.0*m_to_Z ; b2 = -728.8*m_to_Z ; b4 = 343.91*m_to_Z ; b6 = -50.57*m_to_Z + bmax = 720.0*US%m_to_Z ; dc = 500.0*US%m_to_Z + b0 = -150.0*US%m_to_Z ; b2 = -728.8*US%m_to_Z ; b4 = 343.91*US%m_to_Z ; b6 = -50.57*US%m_to_Z xbar = 300.0e3 ; fc = 4.0e3 ; wc = 24.0e3 ; ly = 80.0e3 bx = 0.0 ; by = 0.0 ; xtil = 0.0 @@ -128,7 +125,7 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) end subroutine ISOMIP_initialize_topography !> Initialization of thicknesses -subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv, just_read_params) +subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv, just_read) 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 @@ -141,8 +138,8 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields, including !! the eqn. of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. @@ -153,14 +150,11 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv 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 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") @@ -251,7 +245,7 @@ end subroutine ISOMIP_initialize_thickness !> Initial values for temperature and salinity subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, US, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -261,8 +255,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The nominal total bottom-to-top !! depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt @@ -277,7 +271,6 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile real :: rho_tmp - 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_(GV)) ! A profile of temperatures [degC] real :: S0(SZK_(GV)) ! A profile of salinities [ppt] @@ -291,8 +284,6 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pres(:) = 0.0 - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_T_SUR",t_sur, & @@ -446,7 +437,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [ppt] ! real :: RHO(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for RHO [R ~> kg m-3] real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2] - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: TNUDG ! Nudging time scale [T ~> s] real :: S_sur, T_sur ! Surface salinity and temerature in sponge real :: S_bot, T_bot ! Bottom salinity and temerature in sponge @@ -666,7 +657,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! call MOM_mesg(mesg,5) !enddo - ! Set the inverse damping rates so that the model will know where to + ! Set the sponge damping rates so that the model will know where to ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) ! Apply sponge in tracer fields diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 7182fc364a..707a0972f9 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -595,7 +595,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C U_TS = CS%hurr_translation_spd*0.5*cos(transdir) V_TS = CS%hurr_translation_spd*0.5*sin(transdir) - ! Set the surface wind stresses, in [Pa]. A positive taux + ! Set the surface wind stresses, in [R L Z T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index fe5168ab7e..d1c89f14f3 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -119,14 +119,13 @@ end subroutine Kelvin_OBC_end subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D [Z ~> m or m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: PI ! 3.1415... real :: coast_offset1, coast_offset2, coast_angle, right_angle @@ -134,10 +133,8 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", coast_offset1, & default=100.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & @@ -287,7 +284,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB+1,JedB-1 ; do I=IsdB,IedB x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J) @@ -343,7 +340,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB,JedB ; do I=IsdB+1,IedB-1 x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J) diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 277c0423aa..d136d58a19 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -8,20 +8,19 @@ module MOM_controlled_forcing ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : post_data, query_averaging_enabled, enable_averages, disable_averaging use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr -use MOM_domains, only : pass_var, pass_vector, AGRID, To_South, To_West, To_All +use MOM_domains, only : pass_var, pass_vector, AGRID, To_South, To_West, To_All use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe -use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_io, only : vardesc, var_desc -use MOM_restart, only : register_restart_field, MOM_restart_CS -use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_date, set_date -use MOM_time_manager, only : time_type_to_real, real_to_time -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) +use MOM_time_manager, only : get_date, set_date +use MOM_time_manager, only : time_type_to_real, real_to_time +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface implicit none ; private @@ -32,89 +31,103 @@ module MOM_controlled_forcing !> Control structure for MOM_controlled_forcing type, public :: ctrl_forcing_CS ; private - logical :: use_temperature !< If true, temperature and salinity are used as - !! state variables. - logical :: do_integrated !< If true, use time-integrated anomalies to control - !! the surface state. - integer :: num_cycle !< The number of elements in the forcing cycle. - real :: heat_int_rate !< The rate at which heating anomalies accumulate [s-1]. - real :: prec_int_rate !< The rate at which precipitation anomalies accumulate [s-1]. - real :: heat_cyc_rate !< The rate at which cyclical heating anomaliess - !! accumulate [s-1]. - real :: prec_cyc_rate !< The rate at which cyclical precipitation anomaliess - !! accumulate [s-1]. + logical :: use_temperature !< If true, temperature and salinity are used as state variables. + logical :: do_integrated !< If true, use time-integrated anomalies to control the surface state. + integer :: num_cycle !< The number of elements in the forcing cycle. + real :: heat_int_rate !< The rate at which heating anomalies accumulate [T-1 ~> s-1] + real :: prec_int_rate !< The rate at which precipitation anomalies accumulate [T-1 ~> s-1] + real :: heat_cyc_rate !< The rate at which cyclical heating anomalies accumulate [T-1 ~> s-1] + real :: prec_cyc_rate !< The rate at which cyclical precipitation anomalies + !! accumulate [T-1 ~> s-1] real :: Len2 !< The square of the length scale over which the anomalies - !! are smoothed via a Laplacian filter [m2]. + !! are smoothed via a Laplacian filter [L2 ~> m2] real :: lam_heat !< A constant of proportionality between SST anomalies - !! and heat fluxes [W m-2 degC-1]. + !! and heat fluxes [Q R Z T-1 degC-1 ~> W m-2 degC-1] real :: lam_prec !< A constant of proportionality between SSS anomalies - !! (normalised by mean SSS) and precipitation [kg m-2]. + !! (normalised by mean SSS) and precipitation [R Z T-1 ~> kg m-2 s-1] real :: lam_cyc_heat !< A constant of proportionality between cyclical SST - !! anomalies and corrective heat fluxes [W m-2 degC-1]. + !! anomalies and corrective heat fluxes [Q R Z T-1 degC-1 ~> W m-2 degC-1] real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS !! anomalies (normalised by mean SSS) and corrective - !! precipitation [kg m-2]. + !! precipitation [R Z T-1 ~> kg m-2 s-1] - !>@{ Pointers for data. - !! \todo Needs more complete documentation. - real, pointer, dimension(:) :: & - avg_time => NULL() real, pointer, dimension(:,:) :: & - heat_0 => NULL(), & - precip_0 => NULL() + heat_0 => NULL(), & !< The non-periodic integrative corrective heat flux that has been + !! evolved to control mean SST anomalies [Q R Z T-1 ~> W m-2] + precip_0 => NULL() !< The non-periodic integrative corrective precipitation that has been + !! evolved to control mean SSS anomalies [R Z T-1 ~> kg m-2 s-1] + + ! The final dimension of each of the six variables that follow is for the periodic bins. + real, pointer, dimension(:,:,:) :: & + heat_cyc => NULL(), & !< The periodic integrative corrective heat flux that has been evolved + !! to control periodic (seasonal) SST anomalies [Q R Z T-1 ~> W m-2]. + !! The third dimension is the periodic bins. + precip_cyc => NULL() !< The non-periodic integrative corrective precipitation that has been + !! evolved to control periodic (seasonal) SSS anomalies [R Z T-1 ~> kg m-2 s-1]. + !! The third dimension is the periodic bins. + real, pointer, dimension(:) :: & + avg_time => NULL() !< The accumulated averaging time in each part of the cycle [T ~> s] or + !! a negative value to indicate that the variables like avg_SST_anom are + !! the actual averages, and not time integrals. + !! The dimension is the periodic bins. real, pointer, dimension(:,:,:) :: & - heat_cyc => NULL(), & - precip_cyc => NULL(), & - avg_SST_anom => NULL(), & - avg_SSS_anom => NULL(), & - avg_SSS => NULL() - !>@} + avg_SST_anom => NULL(), & !< The time-averaged periodic sea surface temperature anomalies [degC], + !! or (at some points in the code), the time-integrated periodic + !! temperature anomalies [T degC ~> s degC]. + !! The third dimension is the periodic bins. + avg_SSS_anom => NULL(), & !< The time-averaged periodic sea surface salinity anomalies [ppt], + !! or (at some points in the code), the time-integrated periodic + !! salinity anomalies [T ppt ~> s ppt]. + !! The third dimension is the periodic bins. + avg_SSS => NULL() !< The time-averaged periodic sea surface salinities [ppt], or (at + !! some points in the code), the time-integrated periodic + !! salinities [T ppt ~> s ppt]. + !! The third dimension is the periodic bins. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_heat_0 = -1 !< Diagnostic handle + integer :: id_heat_0 = -1 !< Diagnostic handle for the steady heat flux + integer :: id_prec_0 = -1 !< Diagnostic handle for the steady precipitation end type ctrl_forcing_CS contains -!> This subroutine calls any of the other subroutines in this file -!! that are needed to specify the current surface forcing fields. +!> This subroutine determines corrective surface forcing fields using simple control theory. subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_precip, & day_start, dt, G, US, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature - !! anomalies [degC]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_anom !< The sea surface salinity - !! anomlies [ppt]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_mean !< The mean sea surface - !! salinity [ppt]. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature anomalies [degC] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_anom !< The sea surface salinity anomlies [ppt] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_mean !< The mean sea surface salinity [ppt] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: virt_heat !< Virtual (corrective) heat - !! fluxes that are augmented - !! in this subroutine [W m-2]. + !! fluxes that are augmented in this + !! subroutine [Q R Z T-1 ~> W m-2] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: virt_precip !< Virtual (corrective) - !! precipitation fluxes that - !! are augmented in this - !! subroutine [kg m-2 s-1]. - type(time_type), intent(in) :: day_start !< Start time of the fluxes. - real, intent(in) :: dt !< Length of time over which these - !! fluxes will be applied [s]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure - !! returned by a previous call to - !! ctrl_forcing_init. -! + !! precipitation fluxes that are augmented + !! in this subroutine [R Z T-1 ~> kg m-2 s-1] + type(time_type), intent(in) :: day_start !< Start time of the fluxes. + real, intent(in) :: dt !< Length of time over which these fluxes + !! will be applied [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to ctrl_forcing_init. + + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - flux_heat_x, & - flux_prec_x + flux_heat_x, & ! Zonal smoothing flux of the virtual heat fluxes [L2 Q R Z T-1 ~> W] + flux_prec_x ! Zonal smoothing flux of the virtual precipitation [L2 R Z T-1 ~> kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - flux_heat_y, & - flux_prec_y + flux_heat_y, & ! Meridional smoothing flux of the virtual heat fluxes [L2 Q R Z T-1 ~> W] + flux_prec_y ! Meridional smoothing flux of the virtual precipitation [L2 R Z T-1 ~> kg s-1] type(time_type) :: day_end - real :: coef ! A heat-flux coefficient [m2]. - real :: mr_st, mr_end, mr_mid, mr_prev, mr_next - real :: dt_wt, dt_heat_rate, dt_prec_rate - real :: dt1_heat_rate, dt1_prec_rate, dt2_heat_rate, dt2_prec_rate - real :: wt_per1, wt_st, wt_end, wt_mid - integer :: m_st, m_end, m_mid, m_u1, m_u2, m_u3 + real :: coef ! A heat-flux coefficient [L2 ~> m2] + real :: mr_st, mr_end, mr_mid ! Position of various times in the periodic cycle [nondim] + real :: mr_prev, mr_next ! Position of various times in the periodic cycle [nondim] + real :: dt_wt ! The timestep times a fractional weight used to accumulate averages [T ~> s] + real :: dt_heat_rate, dt_prec_rate ! Timestep times the flux accumulation rate [nondim] + real :: dt1_heat_rate, dt1_prec_rate, dt2_heat_rate, dt2_prec_rate ! [nondim] + real :: wt_per1, wt_st, wt_end, wt_mid ! Averaging weights [nondim] + integer :: m_st, m_end, m_mid, m_u1, m_u2, m_u3 ! Indices (nominally months) in the periodic cycle integer :: yr, mon, day, hr, min, sec integer :: i, j, is, ie, js, je @@ -123,7 +136,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + real_to_time(dt) + day_end = day_start + real_to_time(US%T_to_s*dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 @@ -148,12 +161,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_0(i,j) = CS%heat_0(i,j) + dt_heat_rate * ( & -CS%lam_heat*G%mask2dT(i,j)*SST_anom(i,j) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_0(i,j) = CS%precip_0(i,j) + dt_prec_rate * ( & CS%lam_prec * G%mask2dT(i,j)*(SSS_anom(i,j) / SSS_mean(i,j)) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) virt_heat(i,j) = virt_heat(i,j) + CS%heat_0(i,j) @@ -257,6 +270,8 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec ! Accumulate the average anomalies for this period. dt_wt = wt_per1 * dt CS%avg_time(m_mid) = CS%avg_time(m_mid) + dt_wt + ! These loops temporarily change the units of the CS%avg_ variables to [degC T ~> degC s] + ! or [ppt T ~> ppt s]. do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_mid) = CS%avg_SST_anom(i,j,m_mid) + & dt_wt * G%mask2dT(i,j) * SST_anom(i,j) @@ -281,6 +296,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec m_u2 = periodic_int(m_st - 3.0, CS%num_cycle) m_u3 = periodic_int(m_st - 2.0, CS%num_cycle) + ! These loops restore the units of the CS%avg variables to [degC] or [ppt] if (CS%avg_time(m_u1) > 0.0) then do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_u1) = CS%avg_SST_anom(i,j,m_u1) / CS%avg_time(m_u1) @@ -332,13 +348,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u1) = CS%heat_cyc(i,j,m_u1) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u2) - CS%avg_SST_anom(i,j,m_u1)) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u1) = CS%precip_cyc(i,j,m_u1) + dt1_prec_rate * ( & - CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & + CS%lam_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & (0.5*(CS%avg_SSS(i,j,m_u2) + CS%avg_SSS(i,j,m_u1))) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif @@ -357,19 +373,26 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u2) = CS%heat_cyc(i,j,m_u2) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u3) - CS%avg_SST_anom(i,j,m_u2)) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u2) = CS%precip_cyc(i,j,m_u2) + dt1_prec_rate * ( & - CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & + CS%lam_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & (0.5*(CS%avg_SSS(i,j,m_u3) + CS%avg_SSS(i,j,m_u2))) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif endif ! (CS%num_cycle > 0) + if (CS%do_integrated .and. ((CS%id_heat_0 > 0) .or. (CS%id_prec_0 > 0))) then + call enable_averages(dt, day_start + real_to_time(US%T_to_s*dt), CS%diag) + if (CS%id_heat_0 > 0) call post_data(CS%id_heat_0, CS%heat_0, CS%diag) + if (CS%id_prec_0 > 0) call post_data(CS%id_prec_0, CS%precip_0, CS%diag) + call disable_averaging(CS%diag) + endif + end subroutine apply_ctrl_forcing !> This function maps rval into an integer in the range from 1 to num_period. @@ -411,11 +434,10 @@ subroutine register_ctrl_forcing_restarts(G, param_file, CS, restart_CS) !! parameter values. type(ctrl_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct logical :: controlled, use_temperature character (len=8) :: period_str - type(vardesc) :: vd integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -443,47 +465,44 @@ subroutine register_ctrl_forcing_restarts(G, param_file, CS, restart_CS) call read_param(param_file, "CTRL_FORCE_NUM_CYCLE", CS%num_cycle) if (CS%do_integrated) then - call safe_alloc_ptr(CS%heat_0,isd,ied,jsd,jed) ; CS%heat_0(:,:) = 0.0 - call safe_alloc_ptr(CS%precip_0,isd,ied,jsd,jed) ; CS%precip_0(:,:) = 0.0 - vd = var_desc("Ctrl_heat","W m-2","Control Integrative Heating",z_grid='1') - call register_restart_field(CS%heat_0, vd, .false., restart_CS) - vd = var_desc("Ctrl_precip","kg m-2 s-1","Control Integrative Precipitation",z_grid='1') - call register_restart_field(CS%precip_0, vd, .false., restart_CS) + allocate(CS%heat_0(isd:ied,jsd:jed), source=0.0) + allocate(CS%precip_0(isd:ied,jsd:jed), source=0.0) + + call register_restart_field(CS%heat_0, "Ctrl_heat", .false., restart_CS, & + longname="Control Integrative Heating", units="W m-2", z_grid='1') + call register_restart_field(CS%precip_0, "Ctrl_precip", .false., restart_CS, & + longname="Control Integrative Precipitation", units="kg m-2 s-1", z_grid='1') endif if (CS%num_cycle > 0) then + allocate(CS%heat_cyc(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + allocate(CS%precip_cyc(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + allocate(CS%avg_time(CS%num_cycle), source=0.0) + allocate(CS%avg_SST_anom(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + allocate(CS%avg_SSS_anom(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + write (period_str, '(i8)') CS%num_cycle period_str = trim('p ')//trim(adjustl(period_str)) - call safe_alloc_ptr(CS%heat_cyc,isd,ied,jsd,jed,CS%num_cycle) ; CS%heat_cyc(:,:,:) = 0.0 - call safe_alloc_ptr(CS%precip_cyc,isd,ied,jsd,jed,CS%num_cycle) ; CS%precip_cyc(:,:,:) = 0.0 - vd = var_desc("Ctrl_heat_cycle", "W m-2","Cyclical Control Heating",& - z_grid='1', t_grid=period_str) - call register_restart_field(CS%heat_cyc, vd, .false., restart_CS) - vd = var_desc("Ctrl_precip_cycle","kg m-2 s-1","Cyclical Control Precipitation", & - z_grid='1', t_grid=period_str) - call register_restart_field(CS%precip_cyc, vd, .false., restart_CS) - - call safe_alloc_ptr(CS%avg_time,CS%num_cycle) ; CS%avg_time(:) = 0.0 - vd = var_desc("avg_time","sec","Cyclical accumulated averaging time", & - '1',z_grid='1',t_grid=period_str) - call register_restart_field(CS%avg_time, vd, .false., restart_CS) - - call safe_alloc_ptr(CS%avg_SST_anom,isd,ied,jsd,jed,CS%num_cycle) ; CS%avg_SST_anom(:,:,:) = 0.0 - call safe_alloc_ptr(CS%avg_SSS_anom,isd,ied,jsd,jed,CS%num_cycle) ; CS%avg_SSS_anom(:,:,:) = 0.0 - vd = var_desc("avg_SST_anom","deg C","Cyclical average SST Anomaly", & - z_grid='1',t_grid=period_str) - call register_restart_field(CS%avg_SST_anom, vd, .false., restart_CS) - vd = var_desc("avg_SSS_anom","g kg-1","Cyclical average SSS Anomaly", & - z_grid='1',t_grid=period_str) - call register_restart_field(CS%avg_SSS_anom, vd, .false., restart_CS) + + call register_restart_field(CS%heat_cyc, "Ctrl_heat_cycle", .false., restart_CS, & + longname="Cyclical Control Heating", units="W m-2", z_grid='1', t_grid=period_str) + call register_restart_field(CS%precip_cyc, "Ctrl_precip_cycle", .false., restart_CS, & + longname="Cyclical Control Precipitation", units="kg m-2 s-1", z_grid='1', t_grid=period_str) + call register_restart_field(CS%avg_time, "avg_time", .false., restart_CS, & + longname="Cyclical accumulated averaging time", units="sec", z_grid='1', t_grid=period_str) + call register_restart_field(CS%avg_SST_anom, "avg_SST_anom", .false., restart_CS, & + longname="Cyclical average SST Anomaly", units="deg C", z_grid='1', t_grid=period_str) + call register_restart_field(CS%avg_SSS_anom, "avg_SSS_anom", .false., restart_CS, & + longname="Cyclical average SSS Anomaly", units="g kg-1", z_grid='1', t_grid=period_str) endif end subroutine register_ctrl_forcing_restarts !> Set up this modules control structure. -subroutine controlled_forcing_init(Time, G, param_file, diag, CS) +subroutine controlled_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -491,13 +510,20 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) !! diagnostic output. type(ctrl_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - real :: smooth_len + + ! Local variables + real :: smooth_len ! A smoothing lengthscale [L ~> m] + real :: RZ_T_rescale ! Unit conversion factor for precipiation [T kg m-2 s-1 R-1 Z-1 ~> 1] + real :: QRZ_T_rescale ! Unit conversion factor for head fluxes [T W m-2 Q-1 R-1 Z-1 ~> 1] logical :: do_integrated integer :: num_cycle -! This include declares and sets the variable "version". -#include "version_variable.h" + integer :: i, j, isc, iec, jsc, jec, m + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_controlled_forcing" ! This module's name. + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + ! These should have already been called. ! call read_param(param_file, "CTRL_FORCE_INTEGRATED", CS%do_integrated) ! call read_param(param_file, "CTRL_FORCE_NUM_CYCLE", CS%num_cycle) @@ -523,40 +549,96 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag call get_param(param_file, mdl, "CTRL_FORCE_HEAT_INT_RATE", CS%heat_int_rate, & - "The integrated rate at which heat flux anomalies are "//& - "accumulated.", units="s-1", default=0.0) + "The integrated rate at which heat flux anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_PREC_INT_RATE", CS%prec_int_rate, & - "The integrated rate at which precipitation anomalies "//& - "are accumulated.", units="s-1", default=0.0) + "The integrated rate at which precipitation anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_HEAT_CYC_RATE", CS%heat_cyc_rate, & - "The integrated rate at which cyclical heat flux "//& - "anomalies are accumulated.", units="s-1", default=0.0) + "The integrated rate at which cyclical heat flux anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_PREC_CYC_RATE", CS%prec_cyc_rate, & - "The integrated rate at which cyclical precipitation "//& - "anomalies are accumulated.", units="s-1", default=0.0) + "The integrated rate at which cyclical precipitation anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_SMOOTH_LENGTH", smooth_len, & - "The length scales over which controlled forcing "//& - "anomalies are smoothed.", units="m", default=0.0) + "The length scales over which controlled forcing anomalies are smoothed.", & + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_HEAT", CS%lam_heat, & "A constant of proportionality between SST anomalies "//& - "and controlling heat fluxes", "W m-2 K-1", default=0.0) + "and controlling heat fluxes", & + units="W m-2 K-1", default=0.0, scale=US%W_m2_to_QRZ_T) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_PREC", CS%lam_prec, & "A constant of proportionality between SSS anomalies "//& "(normalised by mean SSS) and controlling precipitation.", & - "kg m-2", default=0.0) + units="kg m-2 s-1", default=0.0, scale=US%kg_m2s_to_RZ_T) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_HEAT", CS%lam_cyc_heat, & "A constant of proportionality between SST anomalies "//& - "and cyclical controlling heat fluxes", "W m-2 K-1", default=0.0) + "and cyclical controlling heat fluxes", & + units="W m-2 K-1", default=0.0, scale=US%W_m2_to_QRZ_T) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_PREC", CS%lam_cyc_prec, & "A constant of proportionality between SSS anomalies "//& - "(normalised by mean SSS) and cyclical controlling "//& - "precipitation.", "kg m-2", default=0.0) + "(normalised by mean SSS) and cyclical controlling precipitation.", & + units="kg m-2 s-1", default=0.0, scale=US%kg_m2s_to_RZ_T) CS%Len2 = smooth_len**2 -! ### REPLACE THIS WITH ANY DIAGNOSTICS FROM THIS MODULE. -! CS%id_taux = register_diag_field('ocean_model', 'taux', diag%axesu1, Time, & -! 'Zonal Wind Stress', 'Pascal') + if (CS%do_integrated) then + CS%id_heat_0 = register_diag_field('ocean_model', 'Ctrl_heat', diag%axesT1, Time, & + 'Control Corrective Heating', 'W m-2', conversion=US%QRZ_T_to_W_m2) + CS%id_prec_0 = register_diag_field('ocean_model', 'Ctrl_prec', diag%axesT1, Time, & + 'Control Corrective Precipitation', 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) + endif + + ! Rescale if there are differences between the dimensional scaling of variables in + ! restart files from those in use for this run. + if ((US%J_kg_to_Q_restart*US%kg_m3_to_R_restart*US%m_to_Z_restart*US%s_to_T_restart /= 0.0) .and. & + ((US%J_kg_to_Q * US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) /= & + (US%J_kg_to_Q_restart * US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T)) ) then + ! Redo the scaling of the corrective heat fluxes to [Q R Z T-1 ~> W m-2] + QRZ_T_rescale = (US%J_kg_to_Q * US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) / & + (US%J_kg_to_Q_restart * US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T) + + if (associated(CS%heat_0)) then + do j=jsc,jec ; do i=isc,iec + CS%heat_0(i,j) = QRZ_T_rescale * CS%heat_0(i,j) + enddo ; enddo + endif + + if ((CS%num_cycle > 0) .and. associated(CS%heat_cyc)) then + do m=1,CS%num_cycle ; do j=jsc,jec ; do i=isc,iec + CS%heat_cyc(i,j,m) = QRZ_T_rescale * CS%heat_cyc(i,j,m) + enddo ; enddo ; enddo + endif + endif + + if ((US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T_restart /= 0.0) .and. & + ((US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) /= & + (US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T)) ) then + ! Redo the scaling of the corrective precipitation to [R Z T-1 ~> kg m-2 s-1] + RZ_T_rescale = (US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) / & + (US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T) + + if (associated(CS%precip_0)) then + do j=jsc,jec ; do i=isc,iec + CS%precip_0(i,j) = RZ_T_rescale * CS%precip_0(i,j) + enddo ; enddo + endif + + if ((CS%num_cycle > 0) .and. associated(CS%precip_cyc)) then + do m=1,CS%num_cycle ; do j=jsc,jec ; do i=isc,iec + CS%precip_cyc(i,j,m) = RZ_T_rescale * CS%precip_cyc(i,j,m) + enddo ; enddo ; enddo + endif + endif + + if ((CS%num_cycle > 0) .and. associated(CS%avg_time) .and. & + ((US%s_to_T_restart /= 0.0) .and. ((US%s_to_T_restart) /= US%s_to_T)) ) then + ! Redo the scaling of the accumulated times to [T ~> s] + do m=1,CS%num_cycle + CS%avg_time(m) = (US%s_to_T / US%s_to_T_restart) * CS%avg_time(m) + enddo + endif + end subroutine controlled_forcing_init diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 10c3af7385..a26bca4711 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -434,7 +434,7 @@ subroutine query_wave_properties(CS, NumBands, WaveNumbers, US) integer, optional, intent(out) :: NumBands !< If present, this returns the number of !!< wavenumber partitions in the wave discretization real, dimension(:), optional, intent(out) :: Wavenumbers !< If present this returns the characteristic - !! wavenumbers of the wave discretization [m-1 or Z-1 ~> m-1] + !! wavenumbers of the wave discretization [m-1] or [Z-1 ~> m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type that is used to undo !! the dimensional scaling of the output variables, if present integer :: n @@ -780,7 +780,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isc,G%iec Top = h(ii,jj,1)*GV%H_to_Z call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & - H(ii,jj,:),Override_MA=.false.,WAVES=CS) + h(ii,jj,:), CS, Override_MA=.false.) CS%La_turb(ii,jj) = La enddo enddo @@ -931,29 +931,27 @@ end subroutine Surface_Bands_by_data_override !! Note this can be called with an unallocated Waves pointer, which is okay if we !! want the wind-speed only dependent Langmuir number. Therefore, we need to be !! careful about what we try to access here. -subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & - H, U_H, V_H, Override_MA, Waves ) - 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 - integer, intent(in) :: i !< Meridional index of h-point - integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1]. - real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m]. - logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA - !! calculation. This can be used if diagnostic - !! LA outputs are desired that are different than - !! those used by the dynamical model. - real, dimension(SZK_(GV)), optional, & - intent(in) :: H !< Grid layer thickness [H ~> m or kg m-2] - real, dimension(SZK_(GV)), optional, & - intent(in) :: U_H !< Zonal velocity at H point [L T-1 ~> m s-1] or [m s-1] - real, dimension(SZK_(GV)), optional, & - intent(in) :: V_H !< Meridional velocity at H point [L T-1 ~> m s-1] or [m s-1] - type(Wave_parameters_CS), & - pointer :: Waves !< Surface wave control structure. +subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & + U_H, V_H, Override_MA ) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, intent(out) :: LA !< Langmuir number [nondim] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m] + real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1] + integer, intent(in) :: i !< Meridional index of h-point + integer, intent(in) :: j !< Zonal index of h-point + real, dimension(SZK_(GV)), intent(in) :: h !< Grid layer thickness [H ~> m or kg m-2] + type(Wave_parameters_CS), pointer :: Waves !< Surface wave control structure. + real, dimension(SZK_(GV)), & + optional, intent(in) :: U_H !< Zonal velocity at H point [L T-1 ~> m s-1] or [m s-1] + real, dimension(SZK_(GV)), & + optional, intent(in) :: V_H !< Meridional velocity at H point [L T-1 ~> m s-1] or [m s-1] + logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA + !! calculation. This can be used if diagnostic + !! LA outputs are desired that are different than + !! those used by the dynamical model. - real, intent(out) :: LA !< Langmuir number [nondim] !Local Variables real :: Top, bottom, midpoint ! Positions within each layer [Z ~> m] @@ -975,9 +973,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! If requesting to use misalignment in the Langmuir number compute the Shear Direction if (USE_MA) then - if (.not.(present(H).and.present(U_H).and.present(V_H))) then - call MOM_error(Fatal,'Get_LA_waves requested to consider misalignment.') - endif + if (.not.(present(U_H).and.present(V_H))) call MOM_error(FATAL, & + "Get_LA_waves requested to consider misalignment, but velocities were not provided.") ContinueLoop = .true. bottom = 0.0 do kk = 1,GV%ke @@ -993,30 +990,30 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & if (Waves%WaveMethod==TESTPROF) then do kk = 1,GV%ke - US_H(kk) = 0.5*(WAVES%US_X(I,j,kk)+WAVES%US_X(I-1,j,kk)) - VS_H(kk) = 0.5*(WAVES%US_Y(i,J,kk)+WAVES%US_Y(i,J-1,kk)) + US_H(kk) = 0.5*(Waves%US_X(I,j,kk)+Waves%US_X(I-1,j,kk)) + VS_H(kk) = 0.5*(Waves%US_Y(i,J,kk)+Waves%US_Y(i,J-1,kk)) enddo - call Get_SL_Average_Prof( GV, Dpt_LASL, H, US_H, LA_STKx) - call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY) elseif (Waves%WaveMethod==SURFBANDS) then - allocate(StkBand_X(WAVES%NumBands), StkBand_Y(WAVES%NumBands)) - do bb = 1,WAVES%NumBands - StkBand_X(bb) = 0.5*(WAVES%STKx0(I,j,bb)+WAVES%STKx0(I-1,j,bb)) - StkBand_Y(bb) = 0.5*(WAVES%STKy0(i,J,bb)+WAVES%STKy0(i,J-1,bb)) + allocate(StkBand_X(Waves%NumBands), StkBand_Y(Waves%NumBands)) + do bb = 1,Waves%NumBands + StkBand_X(bb) = 0.5*(Waves%STKx0(I,j,bb)+Waves%STKx0(I-1,j,bb)) + StkBand_Y(bb) = 0.5*(Waves%STKy0(i,J,bb)+Waves%STKy0(i,J-1,bb)) enddo - call Get_SL_Average_Band(GV, Dpt_LASL, WAVES%NumBands, WAVES%WaveNum_Cen, StkBand_X, LA_STKx ) - call Get_SL_Average_Band(GV, Dpt_LASL, WAVES%NumBands, WAVES%WaveNum_Cen, StkBand_Y, LA_STKy ) + call Get_SL_Average_Band(GV, Dpt_LASL, Waves%NumBands, Waves%WaveNum_Cen, StkBand_X, LA_STKx ) + call Get_SL_Average_Band(GV, Dpt_LASL, Waves%NumBands, Waves%WaveNum_Cen, StkBand_Y, LA_STKy ) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) deallocate(StkBand_X, StkBand_Y) elseif (Waves%WaveMethod==DHH85) then ! Temporarily integrating profile rather than spectrum for simplicity do kk = 1,GV%ke - US_H(kk) = 0.5*(WAVES%US_X(I,j,kk)+WAVES%US_X(I-1,j,kk)) - VS_H(kk) = 0.5*(WAVES%US_Y(i,J,kk)+WAVES%US_Y(i,J-1,kk)) + US_H(kk) = 0.5*(Waves%US_X(I,j,kk)+Waves%US_X(I-1,j,kk)) + VS_H(kk) = 0.5*(Waves%US_Y(i,J,kk)+Waves%US_Y(i,J-1,kk)) enddo - call Get_SL_Average_Prof( GV, Dpt_LASL, H, US_H, LA_STKx) - call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (Waves%WaveMethod==LF17) then call get_StokesSL_LiFoxKemper(ustar, hbl*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA) @@ -1034,7 +1031,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! to prevent large enhancements in unconstrained parts of ! the curve fit parameterizations. ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. - LA = max(WAVES%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) + LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) endif if (Use_MA) then @@ -1421,7 +1418,7 @@ end subroutine StokesMixing !! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** !! !! Not accessed in the standard code. -subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) +subroutine CoriolisStokes(G, GV, dt, h, u, v, Waves) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1435,16 +1432,16 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) intent(inout) :: v !< Velocity j-component [L T-1 ~> m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables real :: DVel ! A rescaled velocity change [L T-2 ~> m s-2] - integer :: i,j,k + integer :: i, j, k do k = 1, GV%ke do j = G%jsc, G%jec do I = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & - 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) + DVel = 0.25*(Waves%us_y(i,j+1,k)+Waves%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & + 0.25*(Waves%us_y(i,j,k)+Waves%us_y(i-1,j,k))*G%CoriolisBu(i,j) u(I,j,k) = u(I,j,k) + DVEL*dt enddo enddo @@ -1453,8 +1450,8 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) do k = 1, GV%ke do J = G%jscB, G%jecB do i = G%isc, G%iec - DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & - 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) + DVel = 0.25*(Waves%us_x(i+1,j,k)+Waves%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & + 0.25*(Waves%us_x(i,j,k)+Waves%us_x(i,j-1,k))*G%CoriolisBu(i,j) v(i,J,k) = v(i,j,k) - DVEL*dt enddo enddo diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 3f5b8c8ab2..5d992b572f 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -239,7 +239,7 @@ end function circ_ridge !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, P_ref) +subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, P_ref) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -250,7 +250,6 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. ! Local variables diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 448c86b5fb..db1b512ca9 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -35,7 +35,7 @@ module Phillips_initialization contains !> Initialize the thickness field for the Phillips model test case. -subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read) 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 @@ -45,8 +45,8 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces [Z ~> m] real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m] @@ -56,7 +56,6 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju real :: y_2 ! The y-position relative to the center of the domain [km] real :: half_strat ! The fractional depth where the stratification is centered [nondim] real :: half_depth ! The depth where the stratification is centered [Z ~> m] - logical :: just_read ! If true, just read parameters but set nothing. logical :: reentrant_y ! If true, model is re-entrant in the y direction character(len=40) :: mdl = "Phillips_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -67,8 +66,6 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju eta_im(:,:) = 0.0 - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The fractional depth where the stratification is centered.", & @@ -130,7 +127,7 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju end subroutine Phillips_initialize_thickness !> Initialize the velocity fields for the Phillips model test case -subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) +subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -140,8 +137,8 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u & v. real :: jet_width ! The width of the zonal-mean jet [km] real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] @@ -150,13 +147,10 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p real :: velocity_amplitude ! The amplitude of velocity perturbations [L T-1 ~> m s-1] real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] integer :: i, j, k, is, ie, js, je, nz, m - logical :: just_read ! If true, just read parameters but set nothing. logical :: reentrant_y ! If true, model is re-entrant in the y direction character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & "The magnitude of the initial velocity perturbation.", & @@ -243,7 +237,7 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables. - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m]. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate [T-1 ~> s-1]. real :: damp_rate ! The inverse zonal-mean damping rate [T-1 ~> s-1]. @@ -331,13 +325,12 @@ end function sech subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: PI, Htop, Wtop, Ltop, offset, dist real :: x1, x2, x3, x4, y1, y2 integer :: i,j,is,ie,js,je @@ -346,10 +339,9 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec PI = 4.0*atan(1.0) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & - "The maximum height of the topography.", units="m", scale=m_to_Z, & + "The maximum height of the topography.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) ! Htop=0.375*max_depth ! max height of topog. above max_depth Wtop = 0.5*G%len_lat ! meridional width of drake and mount diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index d051bccc6c..b8eae3c704 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -76,7 +76,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C real :: RHO(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for RHO real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness at h points - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [T-1 ~> s-1]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate at h points [T-1 ~> s-1] real :: TNUDG ! Nudging time scale [T ~> s] real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa] real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, positive upward [m]. @@ -196,7 +196,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C !read eta call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - ! Set the inverse damping rates so that the model will know where to + ! Set the sponge damping rates so that the model will know where to ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index cd87b47621..c35386a2fe 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -36,7 +36,7 @@ module Rossby_front_2d_initialization contains !> Initialization of thicknesses in 2D Rossby front test -subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read) 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 @@ -44,20 +44,17 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read 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 !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: Tz, Dml, eta, stretch, h0 real :: min_thickness, T_range real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("Rossby_front_2d_initialization.F90, Rossby_front_initialize_thickness: setting thickness") @@ -110,29 +107,25 @@ end subroutine Rossby_front_initialize_thickness !> Initialization of temperature and salinity in the Rossby front test subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & - param_file, eqn_of_state, just_read_params) + param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle - 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: T_ref, S_ref ! Reference salinity and temerature within surface layer real :: T_range ! Range of salinities and temperatures over the vertical real :: y, zc, zi, dTdz - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate real :: PI ! 3.1415926... calculated as 4*atan(1) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & @@ -162,7 +155,7 @@ end subroutine Rossby_front_initialize_temperature_salinity !> Initialization of u and v in the Rossby front test -subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) +subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -174,8 +167,8 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call - !! will only read parameters without setting u & v. + logical, intent(in) :: just_read !< If present and true, this call will only + !! read parameters without setting u & v. real :: y ! Non-dimensional coordinate across channel, 0..pi real :: T_range ! Range of salinities and temperatures over the vertical @@ -186,13 +179,10 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 1d426be636..5bbe65b8d8 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -36,8 +36,8 @@ module SCM_CVMix_tests logical :: UseHeatFlux !< True to use heat flux logical :: UseEvaporation !< True to use evaporation logical :: UseDiurnalSW !< True to use diurnal sw radiation - real :: tau_x !< (Constant) Wind stress, X [Pa] - real :: tau_y !< (Constant) Wind stress, Y [Pa] + real :: tau_x !< (Constant) Wind stress, X [R L Z T-2 ~> Pa] + real :: tau_y !< (Constant) Wind stress, Y [R L Z T-2 ~> Pa] real :: surf_HF !< (Constant) Heat flux [degC Z T-1 ~> m degC s-1] real :: surf_evap !< (Constant) Evaporation rate [Z T-1 ~> m s-1] real :: Max_sw !< maximum of diurnal sw radiation [degC Z T-1 ~> degC m s-1] @@ -52,16 +52,16 @@ module SCM_CVMix_tests contains !> Initializes temperature and salinity for the SCM CVMix test example -subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_params) +subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [psu] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure - logical, optional, intent(in) :: just_read_params !< If present and true, this call - !! will only read parameters without changing h. + logical, intent(in) :: just_read !< If present and true, this call + !! will only read parameters without changing T & S. ! Local variables real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness [Z ~> m]. real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness [Z ~> m]. @@ -69,19 +69,15 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) [ppt] real :: LowerLayerTemp !< Temp at top of lower layer [degC] real :: LowerLayerSalt !< Salt at top of lower layer [ppt] - real :: LowerLayerdTdz !< Temp gradient in lower layer [degC / Z ~> degC m-1]. - real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt / Z ~> ppt m-1]. + real :: LowerLayerdTdz !< Temp gradient in lower layer [degC Z-1 ~> degC m-1]. + real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt Z-1 ~> ppt m-1]. real :: LowerLayerMinTemp !< Minimum temperature in lower layer [degC] real :: zC, DZ, top, bottom ! Depths and thicknesses [Z ~> m]. - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "SCM_TEMP_MLD", UpperLayerTempMLD, & 'Initial temp mixed layer depth', & diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index b9f676dc55..934536d1f8 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -32,7 +32,7 @@ module adjustment_initialization contains !> Initializes the layer thicknesses in the adjustment test case -subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read_params) +subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read) 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 @@ -40,8 +40,8 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read 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 !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. @@ -55,7 +55,6 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read real :: adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate ! This include declares and sets the variable "version". # include "version_variable.h" @@ -63,8 +62,6 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("initialize_thickness_uniform: setting thickness") @@ -193,20 +190,18 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to - !! parse for model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T & S. + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: x, y, yy @@ -219,13 +214,10 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, real :: adjustment_width, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym real :: eta1d(SZK_(GV)+1) - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - ! Parameters used by main model initialization call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', do_not_log=just_read) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 22f4d705a1..a214012541 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -28,27 +28,23 @@ module baroclinic_zone_initialization !> Reads the parameters unique to this module subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & - delta_T, dTdx, L_zone, just_read_params) + delta_T, dTdx, L_zone, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle real, intent(out) :: S_ref !< Reference salinity [ppt] real, intent(out) :: dSdz !< Salinity stratification [ppt Z-1 ~> ppt m-1] real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [ppt] - real, intent(out) :: dSdx !< Linear salinity gradient [ppt m-1] + real, intent(out) :: dSdx !< Linear salinity gradient [ppt G%xaxis_units-1] real, intent(out) :: T_ref !< Reference temperature [degC] real, intent(out) :: dTdz !< Temperature stratification [degC Z-1 ~> degC m-1] real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [degC] real, intent(out) :: dTdx !< Linear temperature gradient in [degC G%x_axis_units-1] real, intent(out) :: L_zone !< Width of baroclinic zone in [G%x_axis_units] - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. - logical :: just_read ! If true, just read parameters but set nothing. - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call log_version(param_file, mdl, version, 'Initialization of an analytic baroclinic zone') call openParameterBlock(param_file,'BCZIC') @@ -76,18 +72,22 @@ end subroutine bcz_params !> Initialization of temperature and salinity with the baroclinic zone initial conditions subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, US, param_file, & - just_read_params) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] + just_read) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< Parameter file handle - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T & S. + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution @@ -96,13 +96,11 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, real :: zc, zi ! Depths in depth units [Z ~> m] real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) - logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params call bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & - delta_T, dTdx, L_zone, just_read_params) + delta_T, dTdx, L_zone, just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index d077e0fa6f..d17be912ae 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -34,32 +34,28 @@ module benchmark_initialization subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum ! - ! basin depth MAXIMUM_DEPTH. ! - real :: m_to_Z ! A dimensional rescaling factor. - real :: x, y + real :: min_depth ! The minimum basin depth [Z ~> m] + real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] + real :: x ! Longitude relative to the domain edge, normalized by its extent [nondim] + real :: y ! Latitude relative to the domain edge, normalized by its extent [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_topography" ! This subroutine's name. - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) PI = 4.0*atan(1.0) D0 = max_depth / 0.5 @@ -83,20 +79,20 @@ end subroutine benchmark_initialize_topography !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, & - P_Ref, just_read_params) + P_Ref, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], @@ -118,11 +114,13 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e 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 :: err, derr_dz ! The error between the profile's temperature and the - ! interface temperature for a given z and its derivative. - real :: pi, z - logical :: just_read + ! between SST and the bottom temperature [nondim]. + real :: err ! The normalized error between the profile's temperature and the + ! interface temperature for a given z [nondim] + real :: derr_dz ! The derivative of the normalized error between the profile's + ! temperature and the interface temperature with z [Z-1 ~> m-1] + real :: pi ! 3.1415926... calculated as 4*atan(1) + real :: z ! A work variable for the interface position [Z ~> m] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_thickness" ! This subroutine's name. @@ -130,7 +128,6 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "BENCHMARK_ML_DEPTH_IC", ML_depth, & "Initial mixed layer depth in the benchmark test case.", & @@ -180,9 +177,10 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e do k=1,nz ; e_pert(K) = 0.0 ; enddo ! This sets the initial thickness (in [H ~> m or kg m-2]) of the layers. The thicknesses - ! are set to insure that: 1. each layer is at least Gv%Angstrom_m thick, and - ! 2. the interfaces are where they should be based on the resting depths and interface - ! height perturbations, as long at this doesn't interfere with 1. + ! are set to insure that: + ! 1. each layer is at least GV%Angstrom_H thick, and + ! 2. the interfaces are where they should be based on the resting depths and + ! interface height perturbations, as long at this doesn't interfere with 1. eta1D(nz+1) = -depth_tot(i,j) do k=nz,2,-1 @@ -215,9 +213,9 @@ end subroutine benchmark_initialize_thickness !> Initializes layer temperatures and salinities for benchmark 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. + eqn_of_state, P_Ref, just_read) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature !! that is being initialized [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being @@ -226,29 +224,25 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure [R L2 T-2 ~> Pa]. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! reference pressure [R L2 T-2 ~> Pa] + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. ! Local variables real :: T0(SZK_(GV)) ! A profile of temperatures [degC] real :: S0(SZK_(GV)) ! A profile of salinities [ppt] - real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa]. - real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. - real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: SST ! The initial sea surface temperature [degC]. - real :: lat - logical :: just_read ! If true, just read parameters but set nothing. + real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa] + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3] + real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: SST ! The initial sea surface temperature [degC] character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. k1 = GV%nk_rho_varies + 1 diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 29fb6647b3..3bfdeaa0ff 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -28,7 +28,7 @@ module circle_obcs_initialization contains !> This subroutine initializes layer thicknesses for the circle_obcs experiment. -subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_params) +subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) 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)), & @@ -37,8 +37,8 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. @@ -46,7 +46,6 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus ! positive upward, in depth units [Z ~> m]. real :: IC_amp ! The amplitude of the initial height displacement [H ~> m or kg m-2]. real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset - logical :: just_read ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. @@ -54,8 +53,6 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg(" circle_obcs_initialization.F90, circle_obcs_initialize_thickness: setting thickness", 5) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index c1eb4fa2e7..99836f5ad0 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -95,26 +95,22 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment -subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, just_read_params) +subroutine dense_water_initialize_TS(G, GV, param_file, T, S, h, just_read) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< EOS structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing T & S. ! Local variables real :: mld, S_ref, S_range, T_ref real :: zi, zmid - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, nz nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, & "Depth of unstratified mixed layer as a fraction of the water column.", & units="nondim", default=default_mld, do_not_log=just_read) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 463fe018b0..ac4181d570 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -90,18 +90,18 @@ subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) end subroutine dumbbell_initialize_topography !> Initializes the layer thicknesses to be uniform in the dumbbell test case -subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -113,13 +113,10 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ! This include declares and sets the variable "version". # include "version_variable.h" character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") @@ -209,16 +206,14 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, end subroutine dumbbell_initialize_thickness !> Initial values for temperature and salinity for the dumbbell test case -subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) 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_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. ! Local variables @@ -226,14 +221,11 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file real :: xi0, xi1, dxi, r, S_surf, T_surf, S_range, T_range real :: x, y, dblen real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat - logical :: just_read ! If true, just read parameters but set nothing. logical :: dbrotate ! If true, rotate the domain. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - T_surf = 20.0 call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 693d2b5ceb..a1d8bf4b52 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -52,7 +52,7 @@ subroutine dumbbell_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> 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 @@ -126,7 +126,7 @@ subroutine dumbbell_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) end subroutine dumbbell_buoyancy_forcing !> Dynamic forcing for the dumbbell test case -subroutine dumbbell_dynamic_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine dumbbell_dynamic_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any @@ -134,15 +134,17 @@ subroutine dumbbell_dynamic_forcing(sfc_state, fluxes, day, dt, G, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> 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 integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed integer :: idays, isecs - real :: deg_rad, rdays + real :: deg_rad ! A conversion factor from degrees to radians [nondim] + real :: rdays ! The elapsed time [days] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -178,11 +180,12 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) type(dumbbell_surface_forcing_CS), & pointer :: CS !< A pointer to the control structure for this module ! Local variables - real :: S_surf, S_range - real :: x, y + real :: S_surf ! Initial surface salinity [ppt] + real :: S_range ! Range of the initial vertical distribution of salinity [ppt] + real :: x, y ! Latitude and longitude normalized by the domain size [nondim] integer :: i, j logical :: dbrotate ! If true, rotate the domain. -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "dumbbell_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 317ed4ac21..ff98f16529 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -133,13 +133,14 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) end subroutine dyed_channel_set_OBC_tracer_data !> This subroutine updates the long-channel flow -subroutine dyed_channel_update_flow(OBC, CS, G, GV, Time) +subroutine dyed_channel_update_flow(OBC, CS, G, GV, US, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(dyed_channel_OBC_CS), pointer :: CS !< Dyed channel control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Time !< model time. ! Local variables character(len=40) :: mdl = "dyed_channel_update_flow" ! This subroutine's name. @@ -154,7 +155,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, GV, Time) if (.not.associated(OBC)) call MOM_error(FATAL, 'dyed_channel_initialization.F90: '// & 'dyed_channel_update_flow() was called but OBC type was not initialized!') - time_sec = G%US%s_to_T * time_type_to_real(Time) + time_sec = US%s_to_T * time_type_to_real(Time) PI = 4.0*atan(1.0) do l=1, OBC%number_of_segments diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 9da82cb721..27d0cedded 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -25,7 +25,7 @@ module external_gwave_initialization contains !> This subroutine initializes layer thicknesses for the external_gwave experiment. -subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_read) 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 @@ -33,24 +33,21 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re 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 !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: ssh_anomaly_height ! Vertical height of ssh anomaly [Z ~> m] real :: ssh_anomaly_width ! Lateral width of anomaly [degrees] - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "external_gwave_initialize_thickness" ! This subroutine's name. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz real :: PI, Xnondim is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg(" external_gwave_initialization.F90, external_gwave_initialize_thickness: setting thickness", 5) diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index d56605aa63..a61d07fcc8 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -23,7 +23,7 @@ module lock_exchange_initialization !> This subroutine initializes layer thicknesses for the lock_exchange experiment. ! ----------------------------------------------------------------------------- -subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_read) 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 @@ -31,8 +31,8 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea 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 !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -41,16 +41,13 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea ! positive upward [Z ~> m]. real :: front_displacement ! Vertical displacement acrodd front real :: thermocline_thickness ! Thickness of stratified region - logical :: just_read ! If true, just read parameters but set nothing. -! 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 = "lock_exchange_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg(" lock_exchange_initialization.F90, lock_exchange_initialize_thickness: setting thickness", 5) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 6bfaedc221..3dba7bfe59 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -77,18 +77,18 @@ end subroutine seamount_initialize_topography !> Initialization of thicknesses. !! This subroutine initializes the layer thicknesses to be uniform. -subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -97,13 +97,10 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") @@ -192,29 +189,24 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j end subroutine seamount_initialize_thickness !> Initial values for temperature and salinity -subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, param_file, just_read) 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_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] 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 h. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing T & S. ! Local variables integer :: i, j, k, is, ie, js, je, nz, k_light real :: xi0, xi1, dxi, r, S_surf, T_surf, S_range, T_range real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_DENSITY_PROFILE", density_profile, & diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 041d77d9f9..840f0bf3ed 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -28,8 +28,8 @@ module shelfwave_initialization !> Control structure for shelfwave open boundaries. type, public :: shelfwave_OBC_CS ; private - real :: Lx = 100.0 !< Long-shore length scale of bathymetry. - real :: Ly = 50.0 !< Cross-shore length scale. + real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] + real :: Ly = 50.0 !< Cross-shore length scale [km] real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] real :: jj = 1 !< Cross-shore wave mode. real :: kk !< Parameter. @@ -101,22 +101,19 @@ end subroutine shelfwave_OBC_end subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j real :: y, rLy, Ly, H0 - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & default=50., do_not_log=.true.) call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & - default=10., units="m", scale=m_to_Z, do_not_log=.true.) + default=10., units="m", scale=US%m_to_Z, do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly @@ -161,7 +158,7 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) time_sec = US%s_to_T*time_type_to_real(Time) omega = CS%omega alpha = CS%alpha - my_amp = 1.0*G%US%m_s_to_L_T + my_amp = 1.0*US%m_s_to_L_T jj = CS%jj kk = CS%kk ll = CS%ll diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 1c3334d8b0..3bafdb2d02 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -53,17 +53,17 @@ end subroutine sloshing_initialize_topography !! same thickness but all interfaces (except bottom and sea surface) are !! displaced according to a half-period cosine, with maximum value on the !! left and minimum value on the right. This sets off a regular sloshing motion. -subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. real :: displ(SZK_(GV)+1) ! The interface displacement [Z ~> m]. @@ -74,7 +74,6 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, real :: x1, y1, x2, y2 ! Dimensonless parameters. real :: x, t ! Dimensionless depth coordinates? logical :: use_IC_bug ! If true, set the initial conditions retaining an old bug. - logical :: just_read ! If true, just read parameters but set nothing. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "sloshing_initialization" !< This module's name. @@ -83,7 +82,6 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SLOSHING_IC_AMPLITUDE", a0, & "Initial amplitude of sloshing internal interface height "//& @@ -178,8 +176,7 @@ end subroutine sloshing_initialize_thickness !! reference surface layer salinity and temperature and a specified range. !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). -subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. @@ -188,9 +185,8 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: delta_S, delta_T @@ -201,14 +197,11 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file integer :: kdelta real :: deltah real :: xi0, xi1 - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's ! name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "S_REF", S_ref, 'Reference value for salinity', & default=35.0, units='1e-3', do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_ref, 'Reference value for temperature', & diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 12a31f3a75..b4ceb1905d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -8,8 +8,9 @@ module supercritical_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type -use MOM_verticalGrid, only : verticalGrid_type use MOM_time_manager, only : time_type, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -17,18 +18,16 @@ module supercritical_initialization public supercritical_set_OBC_data -! This include declares and sets the variable "version". -#include "version_variable.h" - contains !> This subroutine sets the properties of flow at open boundary conditions. -subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) +subroutine supercritical_set_OBC_data(OBC, G, GV, US, param_file) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. @@ -42,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & - units="m/s", default=8.57, scale=G%US%m_s_to_L_T) + units="m/s", default=8.57, scale=US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 136e5f9eee..2438b4115a 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -20,7 +20,7 @@ module tidal_bay_initialization #include -public tidal_bay_set_OBC_data, tidal_bay_OBC_end +public tidal_bay_set_OBC_data public register_tidal_bay_OBC !> Control structure for tidal bay open boundaries. @@ -33,20 +33,13 @@ module tidal_bay_initialization !> Add tidal bay to OBC registry. function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. + type(tidal_bay_OBC_CS), intent(inout) :: CS !< tidal bay control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. logical :: register_tidal_bay_OBC character(len=32) :: casename = "tidal bay" !< This case's name. character(len=40) :: mdl = "tidal_bay_initialization" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "register_tidal_bay_OBC called with an "// & - "associated control structure.") - return - endif - allocate(CS) - call get_param(param_file, mdl, "TIDAL_BAY_FLOW", CS%tide_flow, & "Maximum total tidal volume flux.", & units="m3 s-1", default=3.0e6, scale=US%m_s_to_L_T*US%m_to_L*US%m_to_Z) @@ -57,23 +50,15 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) end function register_tidal_bay_OBC -!> Clean up the tidal bay OBC from registry. -subroutine tidal_bay_OBC_end(CS) - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. - - if (associated(CS)) then - deallocate(CS) - endif -end subroutine tidal_bay_OBC_end - !> This subroutine sets the properties of flow at open boundary conditions. -subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) +subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. + type(tidal_bay_OBC_CS), intent(in) :: CS !< tidal bay control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(time_type), intent(in) :: Time !< model time. @@ -100,7 +85,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) allocate(my_area(1:1,js:je)) - flux_scale = GV%H_to_m*G%US%L_to_m + flux_scale = GV%H_to_m*US%L_to_m time_sec = time_type_to_real(Time) cff_eta = 0.1*GV%m_to_H * sin(2.0*PI*time_sec/(12.0*3600.0)) @@ -124,7 +109,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux / (G%US%m_to_Z*G%US%m_to_L*total_area) + segment%normal_vel_bt(:,:) = my_flux / (US%m_to_Z*US%m_to_L*total_area) segment%eta(:,:) = cff_eta enddo ! end segment loop diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 92570e3caa..0308a3b008 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -25,6 +25,7 @@ module user_change_diffusivity !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Kd_add !< The scale of a diffusivity that is added everywhere !! without any filtering or scaling [Z2 T-1 ~> m2 s-1]. real :: lat_range(4) !< 4 values that define the latitude range over which @@ -86,6 +87,9 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i if (.not.associated(CS)) call MOM_error(FATAL,"user_set_diffusivity: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"user_set_diffusivity: "//& + "Module must be initialized before it is used.") + use_EOS = associated(tv%eqn_of_state) if (.not.use_EOS) return store_Kd_add = .false. @@ -214,6 +218,8 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) endif allocate(CS) + CS%initialized = .true. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec CS%diag => diag diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 3338121d9e..d59d271471 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -37,7 +37,7 @@ module user_initialization contains !> Set vertical coordinates. -subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) +subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(GV%ke), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(GV%ke+1), intent(out) :: g_prime !< The reduced gravity at each @@ -46,7 +46,6 @@ subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure call MOM_error(FATAL, & "USER_initialization.F90, USER_set_coord: " // & @@ -62,10 +61,10 @@ end subroutine USER_set_coord subroutine USER_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_topography: " // & @@ -78,24 +77,20 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth, US) end subroutine USER_initialize_topography !> initialize thicknesses. -subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) +subroutine USER_initialize_thickness(h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thicknesses being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. - logical :: just_read ! If true, just read parameters but set nothing. - call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_thickness: " // & "Unmodified user routine called - you must edit the routine to use it") - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. h(:,:,1) = 0.0 ! h should be set [H ~> m or kg m-2]. @@ -105,7 +100,7 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine USER_initialize_thickness !> initialize velocities. -subroutine USER_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] @@ -114,17 +109,13 @@ subroutine USER_initialize_velocity(u, v, G, GV, US, param_file, just_read_param type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. - - logical :: just_read ! If true, just read parameters but set nothing. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing u & v. call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_velocity: " // & "Unmodified user routine called - you must edit the routine to use it") - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. u(:,:,1) = 0.0 @@ -136,7 +127,7 @@ end subroutine USER_initialize_velocity !> This function puts the initial layer temperatures and salinities !! into T(:,:,:) and S(:,:,:). -subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, just_read_params) +subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. @@ -144,18 +135,13 @@ subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - logical, optional, intent(in) :: just_read_params !< If present and true, this call will only + logical, intent(in) :: just_read !< If true, this call will only !! read parameters without changing T & S. - logical :: just_read ! If true, just read parameters but set nothing. - call MOM_error(FATAL, & "USER_initialization.F90, USER_init_temperature_salinity: " // & "Unmodified user routine called - you must edit the routine to use it") - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. T(:,:,1) = 0.0 @@ -229,8 +215,8 @@ subroutine write_user_log(param_file) !! open file to parse for model !! parameter values. -! 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 = "user_initialization" ! This module's name. call log_version(param_file, mdl, version) @@ -253,7 +239,7 @@ end subroutine write_user_log !! - GV%Rlay - Layer potential density (coordinate variable) [R ~> kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature [degC]. -!! - S - Salinity [psu]. +!! - S - Salinity [ppt]. !! If BULKMIXEDLAYER is defined: !! - Rml - Mixed layer and buffer layer potential densities [R ~> kg m-3]. !! If SPONGE is defined: diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index bf31ca02f8..eb9694a091 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -24,9 +24,6 @@ module user_revise_forcing real :: cdrag !< The quadratic bottom drag coefficient. end type user_revise_forcing_CS -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "user_revise_forcing" !< This module's name. contains !> This subroutine sets the surface wind stresses. @@ -41,6 +38,7 @@ subroutine user_alter_forcing(sfc_state, fluxes, day, G, CS) type(user_revise_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! surface_forcing_init. + return end subroutine user_alter_forcing @@ -52,6 +50,10 @@ subroutine user_revise_forcing_init(param_file,CS) !! returned by a previous call to !! surface_forcing_init. + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "user_revise_forcing" !< This module's name. + call log_version(param_file, mdl, version) end subroutine user_revise_forcing_init