From eb9cbc20a46942267f1052e13aecd568a538e62d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 15:12:38 -0400 Subject: [PATCH 001/104] +Rescaled uhtr and vhtr Rescaled the units for the mass fluxes that do tracer transport to [L2 H] for expanded dimensional consistency testing. This required the addition of unit_scale_type arguments to several routines. In addition some commments were added or corrected. All answers are bitwise identical, but there are some minor changes to public interfaces. The offline tracer capability is not being tested in the MOM6-examples test suite, so there is not guarantee that it will pass the dimensional consistency tests, but the cases in the test suite all pass. --- src/core/MOM.F90 | 27 ++++++++++--------- src/core/MOM_dynamics_split_RK2.F90 | 8 +++--- src/core/MOM_dynamics_unsplit.F90 | 12 ++++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 8 +++--- src/diagnostics/MOM_diagnostics.F90 | 18 +++++++------ src/parameterizations/lateral/MOM_MEKE.F90 | 15 ++++++----- .../lateral/MOM_mixed_layer_restrat.F90 | 20 +++++++------- .../lateral/MOM_thickness_diffuse.F90 | 10 +++---- src/tracer/MOM_offline_main.F90 | 19 ++++++++----- src/tracer/MOM_tracer_advect.F90 | 12 +++++---- 10 files changed, 81 insertions(+), 68 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 901b15fd4a..b46c0ff7e4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -157,11 +157,11 @@ module MOM real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & u, & !< zonal velocity component [m s-1] uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - uhtr !< accumulated zonal thickness fluxes to advect tracers [H m2 ~> m3 or kg] + uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & v, & !< meridional velocity [m s-1] vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - vhtr !< accumulated meridional thickness fluxes to advect tracers [H m2 ~> m3 or kg] + vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint !< A running time integral of the sea surface height [s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc @@ -716,7 +716,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (do_advection) then ! Do advective transport and lateral tracer mixing. - call step_MOM_tracer_dyn(CS, G, GV, h, Time_local) + call step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) CS%ndyn_per_adv = 0 if (CS%diabatic_first .and. abs(CS%t_dyn_rel_thermo) > 1e-6*dt) call MOM_error(FATAL, & "step_MOM: Mismatch between the dynamics and diabatic times "//& @@ -1008,7 +1008,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-mixedlayer_restrat uhtr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & @@ -1018,7 +1018,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-mixedlayer_restrat [uv]htr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif endif @@ -1052,10 +1052,11 @@ end subroutine step_MOM_dynamics !> step_MOM_tracer_dyn does tracer advection and lateral diffusion, bringing the !! tracers up to date with the changes in state due to the dynamics. Surface !! sources and sinks and remapping are handled via step_MOM_thermo. -subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) +subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) type(MOM_control_struct), intent(inout) :: CS !< control structure 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(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2] type(time_type), intent(in) :: Time_local !< The model time at the end @@ -1068,7 +1069,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_other) call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) 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, & @@ -1082,7 +1083,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) call enable_averaging(CS%t_dyn_rel_adv, Time_local, CS%diag) - call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, & + call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1090,7 +1091,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) - call post_transport_diagnostics(G, GV, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & + call post_transport_diagnostics(G, GV, US, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%tracer_reg) ! Rebuild the remap grids now that we've posted the fields which rely on thicknesses ! from before the dynamics calls @@ -1177,7 +1178,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2) call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) @@ -1253,7 +1254,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) @@ -2360,7 +2361,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! now register some diagnostics since the tracer registry is now locked call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) call register_diags(Time, G, GV, CS%IDs, CS%diag) - call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag) + call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm) if (CS%use_ALE_algorithm) then @@ -2380,7 +2381,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%offline_tracer_mode) then ! 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) + 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, & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f256df6508..4c9a9de747 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -260,10 +260,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: vhtr !< accumulatated merid volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! 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 !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure @@ -843,10 +843,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uh(I,j,k)*dt enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vh(i,J,k)*dt enddo ; enddo enddo diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 07c4648b87..13cca76616 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -207,9 +207,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass !! transport [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by @@ -289,10 +289,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & v(i,J,k) = v(i,J,k) + dt * US%s_to_T*CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*US%m_to_L**2*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -441,10 +441,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*US%m_to_L**2*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) enddo ; enddo enddo diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 2ad0c50624..bae771a6c2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -218,10 +218,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! transport [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by @@ -418,10 +418,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt*US%m_to_L**2*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt*US%m_to_L**2*vh(i,J,k) enddo ; enddo enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index a35d4edd7a..ed9e805b5b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1335,14 +1335,15 @@ end subroutine post_surface_thermo_diags !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & +subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dyn, & diag, dt_trans, Reg) 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_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. @@ -1360,12 +1361,12 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & ! [H s-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [s-1] real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes - ! [kg m-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. + ! [kg L-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Idt = 1. / dt_trans - H_to_kg_m2_dt = GV%H_to_kg_m2 * Idt + H_to_kg_m2_dt = GV%H_to_kg_m2 * US%L_to_m**2 * Idt call diag_save_grids(diag) call diag_copy_storage_to_diag(diag, diag_pre_dyn) @@ -1792,10 +1793,11 @@ subroutine register_surface_diags(Time, G, IDs, diag, tv) end subroutine register_surface_diags !> Register certain diagnostics related to transports -subroutine register_transport_diags(Time, G, GV, IDs, diag) +subroutine register_transport_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -1812,10 +1814,10 @@ subroutine register_transport_diags(Time, G, GV, IDs, diag) ! Diagnostics related to tracer and mass transport IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg', & - y_cell_method='sum', v_extensive=.true., conversion=H_convert) + y_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg', & - x_cell_method='sum', v_extensive=.true., conversion=H_convert) + x_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_umo = register_diag_field('ocean_model', 'umo', & diag%axesCuL, Time, 'Ocean Mass X Transport', 'kg s-1', & standard_name='ocean_mass_x_transport', y_cell_method='sum', v_extensive=.true.) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 54726fe9fb..0923c33c59 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -109,8 +109,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -132,18 +132,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZIB_(G),SZJ_(G)) :: & MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. - baroHu, & ! Depth integrated zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + baroHu, & ! Depth integrated accumulated zonal mass flux [H m2 ~> m3 or kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at ! u-points [m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. - baroHv, & ! Depth integrated meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + baroHv, & ! Depth integrated accumulated meridional mass flux [H m2 ~> m3 or kg]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at ! v-points [m s-1]. real :: Kh_here, Inv_Kh_max, K4_here real :: cdrag2 - real :: advFac + real :: advFac ! The product of the advection scaling factor and some unit conversion + ! factors divided by the timestep [m H-1 s-1 ~> s-1 or m3 kg-1 s-1] real :: mass_neglect ! A negligible mass [kg m-2]. real :: ldamping ! The MEKE damping rate [s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. @@ -199,7 +200,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) + baroHu(I,j) = US%L_to_m**2*hu(I,j,k) enddo ; enddo enddo do J=js-1,je ; do i=is,ie @@ -207,7 +208,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-1,je ; do i=is,ie - baroHv(i,J) = hv(i,J,k) + baroHv(i,J) = US%L_to_m**2*hv(i,J,k) enddo ; enddo enddo endif diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 546f320136..3f1164fc77 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -94,9 +94,9 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -124,9 +124,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -421,7 +421,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt enddo endif @@ -497,7 +497,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt enddo endif @@ -553,9 +553,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -687,7 +687,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt enddo endif @@ -733,7 +733,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt enddo endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 04d3847e88..2b62a388fb 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -102,9 +102,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [s] type(MEKE_type), pointer :: MEKE !< MEKE control structure @@ -476,11 +476,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhD(I,j,k)*dt if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhD(i,J,k)*dt if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie @@ -499,7 +499,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp call uvchksum("thickness_diffuse [uv]hD", uhD, vhD, & G%HI, haloshift=0, scale=GV%H_to_m) call uvchksum("thickness_diffuse [uv]htr", uhtr, vhtr, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) call hchksum(h, "thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) endif diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 8278e57264..0624f98337 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -33,6 +33,7 @@ module MOM_offline_main use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_column_fns, call_tracer_stocks use MOM_tracer_registry, only : tracer_registry_type, MOM_tracer_chksum, MOM_tracer_chkinv +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -67,6 +68,8 @@ module MOM_offline_main !< 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() @@ -330,7 +333,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call MOM_tracer_chkinv(debug_msg, G, 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, & + 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) @@ -501,7 +504,7 @@ 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, & + 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) @@ -546,7 +549,7 @@ 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, & + 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) @@ -916,7 +919,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, 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, & + 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) ! Done with horizontal so now h_pre should be h_new @@ -933,7 +936,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, 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, & + 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) ! Done with horizontal so now h_pre should be h_new @@ -1268,13 +1271,14 @@ end subroutine insert_offline_main !> Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input -subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) +subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(offline_transport_CS), pointer :: CS !< Offline control structure type(diabatic_CS), intent(in) :: diabatic_CSp !< The diabatic control structure type(ocean_grid_type), target, intent(in) :: G !< ocean grid structure type(verticalGrid_type), target, intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), target, intent(in) :: US !< A dimensional unit scaling type character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method @@ -1296,6 +1300,9 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) 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 + ! 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.) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 201f8aeb6f..1958b60cc8 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -17,6 +17,7 @@ module MOM_tracer_advect use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_open_boundary, only : OBC_segment_type use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -47,18 +48,19 @@ 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, CS, Reg, & +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) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H m2 ~> m3 or kg] + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H m2 ~> m3 or kg] + intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [s] + 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_(G)), & @@ -149,8 +151,8 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & do j = jsd, jed; do i = Isd, Ied; hprev(i,j,k) = 0.0; enddo ; enddo domore_k(k)=1 ! 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 + do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = US%L_to_m**2*uhtr(I,j,k) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = US%L_to_m**2*vhtr(i,J,k) ; enddo ; enddo if (.not. present(h_prev_opt)) then ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful From 40335f4d0586ce508ee7a9e7925e6c3591b24fb1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 17:35:04 -0400 Subject: [PATCH 002/104] +Rescaled uh and vh to [H L2 T-1] Rescaled the units for the mass or volume fluxes in the dynamics to [H L2 T-1] for expanded dimensional consistency testing. This required the addition of unit_scale_type arguments to several routines. All answers are bitwise identical and the cases in the MOM6-examples test suite all pass the dimensional consistency tests, but there are some minor changes to public interfaces. --- src/core/MOM.F90 | 12 +-- src/core/MOM_CoriolisAdv.F90 | 134 +++++++++++++------------- src/core/MOM_barotropic.F90 | 12 +-- src/core/MOM_checksum_packages.F90 | 9 +- src/core/MOM_continuity.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 26 +++-- src/core/MOM_dynamics_split_RK2.F90 | 49 +++++----- src/core/MOM_dynamics_unsplit.F90 | 24 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 18 ++-- src/diagnostics/MOM_diagnostics.F90 | 52 +++++----- 10 files changed, 178 insertions(+), 162 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b46c0ff7e4..91ec256248 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -156,11 +156,11 @@ module MOM S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & u, & !< zonal velocity component [m s-1] - uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] + uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & v, & !< meridional velocity [m s-1] - vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] + vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint !< A running time integral of the sea surface height [s m]. @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -1209,7 +1209,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1236,7 +1236,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index a897e2af13..9baaa42009 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -115,9 +115,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis !! and momentum advection [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis @@ -148,17 +148,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! times the effective areas [H m2 ~> m3 or kg]. KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], ! KEx = d/dx KE. - uh_center ! Transport based on arithmetic mean h at u-points [H m2 s-1 ~> m3 s-1 or kg s-1] + uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H m2 ~> m3 or kg]. KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], ! KEy = d/dy KE. - vh_center ! Transport based on arithmetic mean h at v-points [H m2 s-1 ~> m3 s-1 or kg s-1] + 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)) :: & uh_min, uh_max, & ! The smallest and largest estimates of the volume vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) - ! [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! [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]. real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -189,8 +189,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: temp1, temp2 ! Temporary variables [m2 s-2]. real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. - real :: uhc, vhc ! Centered estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: uhm, vhm ! The input estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + 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 :: Fe_m2 ! Nondimensional temporary variables asssociated with @@ -206,8 +206,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) 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 m2 s-1 ~> m3 s-1 or kg s-1]. - real :: QUHeff,QVHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. + 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]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz ! To work, the following fields must be set outside of the usual @@ -273,10 +273,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo 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 * (US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*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 * (US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -319,9 +319,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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -358,9 +358,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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) endif enddo endif @@ -590,19 +590,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J-1) * (vh_min(i,j-1)+vh_min(i+1,j-1)) endif - CAu(I,j,k) = 0.25 * G%IdxCu(I,j) * (temp1 + temp2) + CAu(I,j,k) = US%L_T_to_m_s*0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.25 * & + CAu(I,j,k) = 0.25 * US%L_T_to_m_s * & (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & - q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.125 * (G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & + CAu(I,j,k) = 0.125 * US%L_T_to_m_s * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & ((vh(i+1,J,k) + vh(i,J,k)) + (vh(i,J-1,k) + vh(i+1,J-1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -610,48 +610,48 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + & + CAu(I,j,k) = US%L_T_to_m_s*((a(I,j) * vh(i+1,J,k) + & c(I,j) * vh(i,J-1,k)) & + (b(I,j) * vh(i,J,k) + & - d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) + d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k)*G%IdxCv(i,J))/(eps_vel+abs(v(i,J,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i,j+1,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k)*G%IdxCv(i,J-1))/(eps_vel+abs(v(i,J-1,k))) - Heff2 = max(Heff2,min(h(i,j-1,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k)*G%IdxCv(i+1,J))/(eps_vel+abs(v(i+1,J,k))) - Heff3 = max(Heff3,min(h(i+1,j,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k)*G%IdxCv(i+1,J-1))/(eps_vel+abs(v(i+1,J-1,k))) - Heff4 = max(Heff4,min(h(i+1,j-1,k),h(i+1,j,k))) - Heff4 = min(Heff4,max(h(i+1,j-1,k),h(i+1,j,k))) + Heff1 = abs(vh(i,J,k) * US%L_to_m*G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) + Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) + Heff2 = abs(vh(i,J-1,k) * US%L_to_m*G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) + Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) + Heff3 = abs(vh(i+1,J,k) * US%L_to_m*G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) + Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) + Heff4 = abs(vh(i+1,J-1,k) * US%L_to_m*G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) + Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) + Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & + CAu(I,j,k) = US%L_T_to_m_s*0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & (vh(i ,J-1,k)+vh(i+1,J ,k)) ) / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then VHeff = ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & (vh(i ,J-1,k)+vh(i+1,J ,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = QVHeff / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + CAu(I,j,k) = US%L_T_to_m_s*QVHeff / & + (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) endif enddo ; enddo endif ! Add in the additonal 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) + & - (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * G%IdxCu(I,j) + CAu(I,j,k) = CAu(I,j,k) + US%L_T_to_m_s * & + (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo ; endif @@ -699,19 +699,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = - 0.25 * G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * US%L_T_to_m_s*US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - 0.25* & + CAv(i,J,k) = - 0.25* US%L_T_to_m_s*& (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) + q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = -0.125 * (G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & + CAv(i,J,k) = -0.125 * US%L_T_to_m_s*(US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & ((uh(I-1,j,k) + uh(I-1,j+1,k)) + (uh(I,j,k) + uh(I,j+1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -719,48 +719,48 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + & + CAv(i,J,k) = - US%L_T_to_m_s*((a(I-1,j) * uh(I-1,j,k) + & c(I,j+1) * uh(I,j+1,k)) & + (b(I,j) * uh(I,j,k) + & - d(I-1,j+1) * uh(I-1,j+1,k))) * G%IdyCv(i,J) + d(I-1,j+1) * uh(I-1,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k)*G%IdyCu(I,j))/(eps_vel+abs(u(I,j,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i+1,j,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k)*G%IdyCu(I-1,j))/(eps_vel+abs(u(I-1,j,k))) - Heff2 = max(Heff2,min(h(i-1,j,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k)*G%IdyCu(I,j+1))/(eps_vel+abs(u(I,j+1,k))) - Heff3 = max(Heff3,min(h(i,j+1,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k)*G%IdyCu(I-1,j+1))/(eps_vel+abs(u(I-1,j+1,k))) - Heff4 = max(Heff4,min(h(i-1,j+1,k),h(i,j+1,k))) - Heff4 = min(Heff4,max(h(i-1,j+1,k),h(i,j+1,k))) + Heff1 = abs(uh(I,j,k) * US%L_to_m*G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) + Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) + Heff2 = abs(uh(I-1,j,k) * US%L_to_m*G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) + Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) + Heff3 = abs(uh(I,j+1,k) * US%L_to_m*G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) + Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) + Heff4 = abs(uh(I-1,j+1,k) * US%L_to_m*G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) + Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) + Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & + CAv(i,J,k) = - 0.5*US%L_T_to_m_s*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then UHeff = ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff & -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) ) - CAv(i,J,k) = - QUHeff / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) + CAv(i,J,k) = - US%L_T_to_m_s*QUHeff / & + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) endif enddo ; enddo endif ! Add in the additonal terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = CAv(i,J,k) + & - (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * G%IdyCv(i,J) + CAv(i,J,k) = CAv(i,J,k) + US%L_T_to_m_s * & + (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo ; endif if (CS%bound_Coriolis) then @@ -788,7 +788,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq,Jeq ; do i=is,ie AD%rv_x_u(i,J,k) = - 0.25* & (q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) + q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif @@ -796,13 +796,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do j=js,je ; do I=Isq,Ieq AD%rv_x_v(I,j,k) = 0.25 * & (q2(I,j) * (vh(i+1,J,k) + vh(i,J,k)) + & - q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo endif else if (associated(AD%rv_x_u)) then do J=Jsq,Jeq ; do i=is,ie - AD%rv_x_u(i,J,k) = -G%IdyCv(i,J) * C1_12 * & + AD%rv_x_u(i,J,k) = -US%L_to_m*G%IdyCv(i,J) * C1_12 * & ((q2(I,J) + q2(I-1,J) + q2(I-1,J-1)) * uh(I-1,j,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * uh(I,j,k) + & (q2(I-1,J) + q2(I,J+1) + q2(I,J)) * uh(I,j+1,k) + & @@ -812,7 +812,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (associated(AD%rv_x_v)) then do j=js,je ; do I=Isq,Ieq - AD%rv_x_v(I,j,k) = G%IdxCu(I,j) * C1_12 * & + AD%rv_x_v(I,j,k) = US%L_to_m*G%IdxCu(I,j) * C1_12 * & ((q2(I+1,J) + q2(I,J) + q2(I,J-1)) * vh(i+1,J,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * vh(i,J,k) + & (q2(I-1,J-1) + q2(I,J) + q2(I,J-1)) * vh(i,J-1,k) + & diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6377dd2d1f..5e08e2ccc2 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -446,10 +446,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor [Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] ! Local variables @@ -1026,23 +1026,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%visc_rem_u_uh0) then !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) enddo ; enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) enddo ; enddo ; enddo endif diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 755cdac2b9..a2731f9a0e 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -39,7 +39,7 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric) character(len=*), & intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -52,10 +52,11 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Volume flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -72,7 +73,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym) call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & - symmetric=sym, scale=GV%H_to_m) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 5bca916ab5..ebb958f6dc 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -54,10 +54,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = - !! v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a55166e7ff..0df954a4f5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -87,9 +87,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: uh !< Zonal volume flux, u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. + 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 [s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -171,7 +171,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -187,7 +187,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -204,7 +204,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) @@ -217,7 +217,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -238,7 +238,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. @@ -348,6 +348,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & uh(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) + ! uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) enddo endif enddo @@ -537,6 +538,12 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif endif ; endif + !### Work this into the code above. + do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh + uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) + enddo ; enddo ; enddo + + end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. @@ -1356,6 +1363,11 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif endif ; endif + !### Work this into the code above. + do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh + vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) + enddo ; enddo ; enddo + end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 4c9a9de747..478a560f52 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -254,10 +254,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! time step [Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & target, intent(inout) :: vh !< merid volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport !! since last tracer advection [H L2 ~> m3 or kg] @@ -290,7 +290,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! 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 @@ -355,7 +355,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -568,11 +568,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, haloshift=2, & + call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) @@ -678,10 +678,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -772,8 +772,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -843,10 +843,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uh(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vh(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt enddo ; enddo enddo @@ -869,10 +869,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI,haloshift=1, symmetric=sym) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") @@ -889,9 +889,9 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/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 m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -973,9 +973,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param intent(inout) :: v !< merid velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< current model time type(param_file_type), intent(in) :: param_file !< parameter file for parsing @@ -1172,8 +1172,11 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo endif - if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - uH_rescale = GV%m_to_H / GV%m_to_H_restart + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then + uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo endif @@ -1190,10 +1193,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration', 'm s-2') diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 13cca76616..39841e8ab2 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -203,9 +203,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass @@ -249,7 +249,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -289,10 +289,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & v(i,J,k) = v(i,J,k) + dt * US%s_to_T*CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*US%m_to_L**2*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -334,7 +334,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -402,7 +402,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -441,10 +441,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*US%m_to_L**2*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) enddo ; enddo enddo @@ -487,7 +487,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -670,10 +670,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration', 'meter second-2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index bae771a6c2..6a0ba7e3dd 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -213,9 +213,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! the surface pressure at the end of !! this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last !! tracer advection [H L2 ~> m3 or kg]. @@ -260,7 +260,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -363,7 +363,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) ! 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) @@ -418,15 +418,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt*US%m_to_L**2*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + US%s_to_T*dt*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt*US%m_to_L**2*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + US%s_to_T*dt*vh(i,J,k) enddo ; enddo enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -629,10 +629,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration', 'meter second-2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ed9e805b5b..d5ae88aeb3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -195,10 +195,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces = u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through meridional faces = v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to @@ -506,13 +506,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%uh_Rlay(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) + CS%uh_Rlay(I,j,k) = US%L_to_m**2*US%s_to_T*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 + CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt + CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt_p enddo ; enddo enddo @@ -528,12 +528,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%vh_Rlay(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) + CS%vh_Rlay(i,J,k) = US%L_to_m**2*US%s_to_T*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 + CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt + CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt_p enddo ; enddo enddo @@ -889,10 +889,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces=u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through merid faces=v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -936,10 +936,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*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) @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -975,14 +975,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*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) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%L_to_m**2*US%s_to_T*(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) @@ -1002,15 +1002,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*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) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%L_to_m**2*US%s_to_T*(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) @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*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) * & From 139c562a886f2b16f88c538dd62b721706507312 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 18:11:04 -0400 Subject: [PATCH 003/104] Cleanup of rescaling factors in energy diagnostics Rearranged some of the dimensional scaling factors in the kinetic energy budget to clean up the code and facilitate later cancellations. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 50 ++++++++++++++--------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index d5ae88aeb3..ee5a4976ac 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -936,10 +936,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%s_to_T*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) @@ -947,7 +947,7 @@ 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%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & + CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*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 @@ -957,15 +957,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * G%IareaT(i,j) * & + CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*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 @@ -975,19 +975,19 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%s_to_T*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) * & - US%L_to_m**2*US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*G%IareaT(i,j) * & + US%s_to_T*(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) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & + CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*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 @@ -1002,20 +1002,20 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%s_to_T*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) * & - US%L_to_m**2*US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*G%IareaT(i,j) * & + US%s_to_T*(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) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & + CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*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 @@ -1025,15 +1025,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * G%IareaT(i,j) * & + CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * US%L_to_m**2*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 @@ -1043,15 +1043,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * G%IareaT(i,j) * & + CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*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 @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%s_to_T*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) * & @@ -1073,7 +1073,7 @@ 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_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * G%IareaT(i,j) * & + CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*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 From 0efc11895cab1561a836ed0531801c29fa45ce45 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 18:11:40 -0400 Subject: [PATCH 004/104] Corrected chksum scaling for vertvisc_CS%h_u Corrected the dimensional scaling in the chksum call for vertvisc_CS%h_u and vertvisc_CS%h_v. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 82456b0e58..4c1de70024 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1004,13 +1004,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) enddo ! end of v-point j loop if (CS%debug) then - call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & - CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m*US%s_to_T) - call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) + call uvchksum("vertvisc_coef h_[uv]", CS%h_u, CS%h_v, G%HI, haloshift=0, scale=GV%H_to_m) + call uvchksum("vertvisc_coef a_[uv]", CS%a_u, CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) if (allocated(hML_u) .and. allocated(hML_v)) & - call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & - G%HI, haloshift=0, scale=GV%H_to_m) + call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, G%HI, haloshift=0, scale=GV%H_to_m) endif ! Offer diagnostic fields for averaging. From 6c0f9f72165ce76fe702c535032921564aa7bb9c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 06:20:59 -0400 Subject: [PATCH 005/104] +Changed the units of uhbt and vhbt to [H L2 T-1] Changed the units of uhbt and vhbt as shared between the barotropic solver and the continuity solver from [H m2 s-1] to [H L2 T-1] for greater dimensional consistency testing. Also commented out 4 unused optional "_aux" arguments to continuity that were left over from an older split time stepping argument that was dropped four years ago in preparation for their elimination from continuity_ppm. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 19 +++++---- src/core/MOM_continuity.F90 | 56 +++++++++++++-------------- src/core/MOM_continuity_PPM.F90 | 36 +++++++++-------- src/core/MOM_dynamics_split_RK2.F90 | 14 +++---- src/core/MOM_dynamics_unsplit.F90 | 9 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 9 ++--- 6 files changed, 68 insertions(+), 75 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5e08e2ccc2..c753fe2f9d 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -331,13 +331,13 @@ module MOM_barotropic !> A desciption 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 m ~> m2 or kg m-1]. + !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real :: FA_v_N0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north [H m ~> m2 or kg m-1]. + !! drawing from nearby to the north [H L ~> m2 or kg m-1]. real :: FA_v_S0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south [H m ~> m2 or kg m-1]. + !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real :: FA_v_SS !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south [H m ~> m2 or kg m-1]. + !! drawing from locations far to the south [H L ~> m2 or kg m-1]. real :: 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 :: vBT_NN !< vBT_NN is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal @@ -384,8 +384,7 @@ 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, OBC, & - BT_cont, eta_PF_start, & + visc_rem_u, visc_rem_v, etaav, OBC, BT_cont, eta_PF_start, & taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -419,10 +418,10 @@ 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 m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 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 m2 s-1 ~> m3 or kg s-1]. + !! [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. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum @@ -2087,7 +2086,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do j=js,je ; do I=is-1,ie CS%ubtav(I,j) = ubt_sum(I,j) * I_sum_wt_trans - uhbtav(I,j) = US%s_to_T*US%L_to_m**2*uhbt_sum(I,j) * I_sum_wt_trans + uhbtav(I,j) = uhbt_sum(I,j) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel ubt_wtd(I,j) = ubt_wtd(I,j) * I_sum_wt_vel @@ -2095,7 +2094,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is,ie CS%vbtav(i,J) = vbt_sum(i,J) * I_sum_wt_trans - vhbtav(i,J) = US%s_to_T*US%L_to_m**2*vhbt_sum(i,J) * I_sum_wt_trans + vhbtav(i,J) = vhbt_sum(i,J) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### v_accel_bt(i,J) = v_accel_bt(i,J) * I_sum_wt_accel vbt_wtd(i,J) = vbt_wtd(i,J) * I_sum_wt_vel diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index ebb958f6dc..a8c90d6668 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -40,8 +40,8 @@ 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, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) +! uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -63,10 +63,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume - !! flux through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! 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 m2 s-1 ~> m3 s-1 or kg s-1]. + !! 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_(G)), & @@ -85,18 +85,18 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux !< A second summed zonal - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux !< A second summed meridional - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(inout) :: u_cor_aux !< The zonal velocities - !! that give uhbt_aux as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(inout) :: v_cor_aux !< The meridional velocities - !! that give vhbt_aux as the depth-integrated transport [m s-1]. +! real, dimension(SZIB_(G),SZJ_(G)), & +! optional, intent(in) :: uhbt_aux !< A second summed zonal +! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. +! real, dimension(SZI_(G),SZJB_(G)), & +! optional, intent(in) :: vhbt_aux !< A second summed meridional +! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. +! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & +! optional, intent(inout) :: u_cor_aux !< The zonal velocities +! !! that give uhbt_aux as the depth-integrated transport [m s-1]. +! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & +! optional, intent(inout) :: v_cor_aux !< The meridional velocities +! !! that give vhbt_aux 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. @@ -107,21 +107,21 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, if (present(u_cor) .neqv. present(v_cor)) call MOM_error(FATAL, & "MOM_continuity: Either both u_cor and v_cor or neither"// & " one must be present in call to continuity.") - if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & - " provided, and uhbt_aux has no other purpose. Include both arguments"//& - " or neither.") +! if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & +! "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & +! " one must be present in call to continuity.") +! if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & +! "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & +! " one must be present in call to continuity.") +! if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & +! "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & +! " provided, and uhbt_aux has no other purpose. Include both arguments"//& +! " or neither.") 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, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) +! Eliminate 4 unused optional arguments: ( uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 0df954a4f5..b5c62dad62 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -95,10 +95,10 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [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 m2 s-1 ~> m3 s-1 or kg s-1]. + !! [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_(G)), & @@ -253,7 +253,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! 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 m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -449,7 +449,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif if (present(uhbt)) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, & + call zonal_flux_adjust(u, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*uhbt(:,j), uh_tot_0, & duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & CS, visc_rem, j, ish, ieh, do_I, .true., uh, OBC=OBC) @@ -501,7 +501,14 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ! set_BT_cont endif ! present(uhbt) or do_aux or set_BT_cont + + !### Work this into the code above. + do k=1,nz ; do I=ish-1,ieh + uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) + enddo ; enddo + enddo ! j-loop + if (local_open_BC .and. set_BT_cont) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then @@ -538,12 +545,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif endif ; endif - !### Work this into the code above. - do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) - enddo ; enddo ; enddo - - end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. @@ -1080,7 +1081,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! 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 m2 s-1 ~> m3 s-1 or kg s-1]. + !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1273,7 +1274,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif if (present(vhbt)) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, & + call meridional_flux_adjust(v, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*vhbt(:,J), vh_tot_0, & dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & CS, visc_rem, j, ish, ieh, do_I, .true., vh, OBC=OBC) @@ -1325,6 +1326,12 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ! set_BT_cont endif ! present(vhbt) or do_aux or set_BT_cont + + !### Work this into the code above. + do k=1,nz ; do i=ish,ieh + vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) + enddo ; enddo + enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -1363,11 +1370,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif endif ; endif - !### Work this into the code above. - do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) - enddo ; enddo ; enddo - end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 478a560f52..d2004d8d90 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -114,10 +114,10 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and !! PFv [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! uhbt is roughly equal to the vertical sum of uh. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! vhbt is roughly equal to vertical sum of vh. real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height @@ -518,9 +518,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, 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, OBC=CS%OBC, & + visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -811,9 +810,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, 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%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 39841e8ab2..2ea32a5495 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -263,8 +263,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, & - OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -355,8 +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, OBC=CS%OBC) 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) @@ -419,8 +417,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, OBC=CS%OBC) 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) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 6a0ba7e3dd..85f1145ecb 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -279,8 +279,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, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -351,8 +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, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -409,8 +407,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, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) From 15438e8c6419e8160e6dfdffe93dcfd0000889a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 06:55:33 -0400 Subject: [PATCH 006/104] +Eliminated uhbt_aux args from continuity_PPM Eliminated the unused optional arguments uhbt_aux, vhbt_aux, v_cor_aux and u_cor_aux from continuity_PPM. All answers are bitwise identical, but there are public interface changes in the form of eliminated optional arguments. --- src/core/MOM_continuity.F90 | 24 -------- src/core/MOM_continuity_PPM.F90 | 104 ++++++-------------------------- 2 files changed, 20 insertions(+), 108 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index a8c90d6668..2a0c844932 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -41,7 +41,6 @@ module MOM_continuity !! based on Lin (1994). subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) -! uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -85,18 +84,6 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport [m s-1]. -! real, dimension(SZIB_(G),SZJ_(G)), & -! optional, intent(in) :: uhbt_aux !< A second summed zonal -! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. -! real, dimension(SZI_(G),SZJB_(G)), & -! optional, intent(in) :: vhbt_aux !< A second summed meridional -! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. -! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & -! optional, intent(inout) :: u_cor_aux !< The zonal velocities -! !! that give uhbt_aux as the depth-integrated transport [m s-1]. -! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & -! optional, intent(inout) :: v_cor_aux !< The meridional velocities -! !! that give vhbt_aux 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. @@ -107,21 +94,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, if (present(u_cor) .neqv. present(v_cor)) call MOM_error(FATAL, & "MOM_continuity: Either both u_cor and v_cor or neither"// & " one must be present in call to continuity.") -! if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & -! "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & -! " one must be present in call to continuity.") -! if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & -! "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & -! " one must be present in call to continuity.") -! if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & -! "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & -! " provided, and uhbt_aux has no other purpose. Include both arguments"//& -! " or neither.") 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, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) -! Eliminate 4 unused optional arguments: ( uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index b5c62dad62..d876b624a4 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -74,8 +74,7 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -121,22 +120,6 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities that give uhbt_aux as the depth-integrated - !! transports [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities that give vhbt_aux as the depth-integrated - !! transports [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. @@ -165,8 +148,7 @@ 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, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -181,8 +163,7 @@ 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, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -198,8 +179,7 @@ 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, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -211,8 +191,7 @@ 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, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -229,7 +208,7 @@ 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, & - visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) + 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. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -254,17 +233,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & 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)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, m s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports [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. @@ -290,11 +262,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(uhbt_aux) .and. present(u_cor_aux)) use_visc_rem = present(visc_rem_u) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -328,8 +299,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,G,GV,CS,local_specified_BC,OBC,uhbt,do_aux,set_BT_cont, & -!$OMP CFL_dt,I_dt,u_cor,uhbt_aux,u_cor_aux,BT_cont, local_Flather_OBC) & +!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & +!$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC) & !$OMP private(do_I,duhdu,du,du_max_CFL,du_min_CFL,uh_tot_0,duhdu_tot_0, & !$OMP is_simple,FAuI,visc_rem_max,I_vrm,du_lim,dx_E,dx_W,any_simple_OBC ) & !$OMP firstprivate(visc_rem) @@ -357,7 +328,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_max(I) = 1.0 enddo ; endif - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then ! Set limits on du that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do I=ish-1,ieh @@ -437,7 +408,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & ! Up to this point, everything is shared between uhbt and uhbt_aux. any_simple_OBC = .false. - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do I=ish-1,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_u(I,j))%specified @@ -463,20 +434,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif - if (do_aux) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt_aux(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do I=ish-1,ieh ; u_cor_aux(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo - if (local_specified_BC) then ; do I=ish-1,ieh - if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor_aux(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) - enddo ; endif - enddo - endif ! do_aux - 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, US, CS, visc_rem, & @@ -500,7 +457,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif endif ! set_BT_cont - endif ! present(uhbt) or do_aux or set_BT_cont + endif ! present(uhbt) or set_BT_cont !### Work this into the code above. do k=1,nz ; do I=ish-1,ieh @@ -1060,7 +1017,7 @@ 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, & - visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont) + 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_(G)), intent(in) :: v !< Meridional velocity [m s-1]. @@ -1082,16 +1039,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! 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]. - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes - !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) !! that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities (v with a barotropic correction) - !! that give vhbt_aux as the depth-integrated transports [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. ! Local variables @@ -1118,11 +1069,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(vhbt_aux) .and. present(v_cor_aux)) use_visc_rem = present(visc_rem_v) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -1156,9 +1106,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,G,GV,CS,local_specified_BC,OBC,vhbt,do_aux, & -!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,vhbt_aux, & -!$OMP v_cor_aux,BT_cont, local_Flather_OBC ) & +!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt, & +!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC ) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & !$OMP is_simple,FAvi,dy_S,any_simple_OBC ) & @@ -1185,7 +1134,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_max(i) = 1.0 enddo ; endif - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then ! Set limits on dv that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do i=ish,ieh @@ -1262,7 +1211,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & ! Up to this point, everything is shared between vhbt and vhbt_aux. any_simple_OBC = .false. - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do i=ish,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_v(i,J))%specified @@ -1287,20 +1236,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif ! v-corrected endif - if (do_aux) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt_aux(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do i=ish,ieh ; v_cor_aux(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo - if (local_specified_BC) then ; do i=ish,ieh - if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor_aux(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) - enddo ; endif - enddo - endif ! do_aux - 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, US, CS, visc_rem, & @@ -1325,7 +1260,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif endif ! set_BT_cont - endif ! present(vhbt) or do_aux or set_BT_cont + endif ! present(vhbt) or set_BT_cont !### Work this into the code above. do k=1,nz ; do i=ish,ieh @@ -2303,6 +2238,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & default=0.5*G%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 "//& From 89c9522531d47fbec26a5dca654298719919b99e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 11:22:44 -0400 Subject: [PATCH 007/104] Dimensional rescaling inside continuity_PPM.F90 Applied dimensional rescaling to numerous internal variables and minor code restructuring in MOM_continuity_PPM.F90. All answers are bitwise identical. --- src/core/MOM_continuity_PPM.F90 | 273 +++++++++++++++----------------- 1 file changed, 128 insertions(+), 145 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d876b624a4..1a2733bbea 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -153,7 +153,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -196,7 +196,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -241,19 +241,19 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity [m s-1]. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. - uh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + duhdu_tot_0, & ! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> 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. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. - real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H m ~> m2 or kg m-1]. + 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 :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by @@ -314,12 +314,11 @@ 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, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - uh(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) - ! uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) + uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) enddo endif enddo @@ -405,8 +404,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & du_min_CFL(I) = min(du_min_CFL(I),0.0) enddo - ! Up to this point, everything is shared between uhbt and uhbt_aux. - any_simple_OBC = .false. if (present(uhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do I=ish-1,ieh @@ -420,9 +417,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif if (present(uhbt)) then - call zonal_flux_adjust(u, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*uhbt(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., uh, OBC=OBC) + 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, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., 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 @@ -441,17 +438,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (any_simple_OBC) then do I=ish-1,ieh do_I(I) = OBC%segment(OBC%segnum_u(I,j))%specified - if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) + if (do_I(I)) FAuI(I) = GV%H_subroundoff*US%m_to_L*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_u(I,j))%specified)) & - FAuI(I) = FAuI(I) + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & - OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + FAuI(I) = FAuI(I) + US%m_to_L*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & + OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo do I=ish-1,ieh ; if (do_I(I)) then - BT_cont%FA_u_W0(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_E0(I,j) = US%m_to_L*FAuI(I) - BT_cont%FA_u_WW(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAuI(I) + BT_cont%FA_u_W0(I,j) = FAuI(I) ; BT_cont%FA_u_E0(I,j) = FAuI(I) + BT_cont%FA_u_WW(I,j) = FAuI(I) ; BT_cont%FA_u_EE(I,j) = FAuI(I) BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 endif ; enddo endif @@ -459,11 +456,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ! present(uhbt) or set_BT_cont - !### Work this into the code above. - do k=1,nz ; do I=ish-1,ieh - uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) - enddo ; enddo - enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -505,7 +497,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. @@ -518,10 +510,11 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & 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]. real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume - !! transport [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u [H m ~> m2 or kg m-1]. + !! with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -548,32 +541,32 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, 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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*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) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then do I=ish-1,ieh ; if (do_I(I)) then if (OBC%segment(OBC%segnum_u(I,j))%open) then if (OBC%segment(OBC%segnum_u(I,j))%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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i) + duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * 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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i+1) + duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) endif endif endif ; enddo @@ -688,7 +681,7 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. @@ -704,19 +697,20 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! experiences after viscosity is applied. !! Non-dimensional 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 m2 s-1 ~> m3 s-1 or kg s-1]. + !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< !! The barotropic velocity adjustment [m s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -727,17 +721,17 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< - !! Volume flux through zonal faces = u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! 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_(G)) :: & - uh_aux, & ! An auxiliary zonal volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. + duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & - uh_err, & ! Difference between uhbt and the summed uh [H m2 s-1 ~> m3 s-1 or kg s-1]. - uh_err_best, & ! The smallest value of uh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. + uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. u_new, & ! The velocity with the correction added [m s-1]. - duhdu_tot,&! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. + duhdu_tot,&! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits du_max ! and previous iterations [m s-1]. real :: du_prev ! The previous value of du [m s-1]. @@ -783,8 +777,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or.& + if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -822,7 +816,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, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -864,9 +858,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable @@ -894,17 +888,17 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic u_0, & ! transport (u_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the westerly - FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + duhdu_L, & ! The effective layer marginal face areas with the westerly + duhdu_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test + duhdu_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), - uh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_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]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and - uhtot_R ! and easterly (uhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [m H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [m H ~> m2 or kg m], nominally given by + 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 ! the realized transport divided by the barotropic velocity. 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 @@ -924,9 +918,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo - call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, & - duhdu_tot_0, du0, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + 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, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently ! negative velocity correction for the easterly-flux, and a sufficiently @@ -966,19 +960,16 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_R(I) = u(I,j,k) + duR(I) * visc_rem(I,k) 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, & - FA_marg_0, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, & - FA_marg_L, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, & - FA_marg_R, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) + 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) + 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) + 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) do I=ish-1,ieh ; if (do_I(I)) then - FAmt_0(I) = FAmt_0(I) + FA_marg_0(I) - FAmt_L(I) = FAmt_L(I) + FA_marg_L(I) - FAmt_R(I) = FAmt_R(I) + FA_marg_R(I) + FAmt_0(I) = FAmt_0(I) + US%L_T_to_m_s*duhdu_0(I) + FAmt_L(I) = FAmt_L(I) + US%L_T_to_m_s*duhdu_L(I) + FAmt_R(I) = FAmt_R(I) + US%L_T_to_m_s*duhdu_R(I) uhtot_L(I) = uhtot_L(I) + uh_L(I) uhtot_R(I) = uhtot_R(I) + uh_R(I) endif ; enddo @@ -986,11 +977,11 @@ 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 ; if (do_I(I)) then FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duL(I) - du0(I)) /= 0.0) & - FA_avg = uhtot_L(I) / (duL(I) - du0(I)) + FA_avg = US%L_T_to_m_s*uhtot_L(I) / (duL(I) - du0(I)) if (FA_avg > max(FA_0, FAmt_L(I))) then ; FA_avg = max(FA_0, FAmt_L(I)) elseif (FA_avg < min(FA_0, FAmt_L(I))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_u_W0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_WW(I,j) = US%m_to_L*FAmt_L(I) + BT_cont%FA_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = FAmt_L(I) if (abs(FA_0-FAmt_L(I)) <= 1e-12*FA_0) then ; BT_cont%uBT_WW(I,j) = 0.0 ; else BT_cont%uBT_WW(I,j) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * & ((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0)) @@ -998,11 +989,11 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duR(I) - du0(I)) /= 0.0) & - FA_avg = uhtot_R(I) / (duR(I) - du0(I)) + FA_avg = US%L_T_to_m_s*uhtot_R(I) / (duR(I) - du0(I)) if (FA_avg > max(FA_0, FAmt_R(I))) then ; FA_avg = max(FA_0, FAmt_R(I)) elseif (FA_avg < min(FA_0, FAmt_R(I))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_u_E0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAmt_R(I) + BT_cont%FA_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = FAmt_R(I) if (abs(FAmt_R(I) - FA_0) <= 1e-12*FA_0) then ; BT_cont%uBT_EE(I,j) = 0.0 ; else BT_cont%uBT_EE(I,j) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * & ((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0)) @@ -1047,18 +1038,18 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! the effective open face areas as a function of barotropic flow. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. + dvhdv ! Partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dv, & ! Corrective barotropic change in the velocity [m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v [H m ~> m2 or kg m-1]. - vh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. + vh_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. logical, dimension(SZI_(G)) :: do_I - real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H m ~> m2 or kg m-1]. + 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, dimension(SZI_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. @@ -1122,11 +1113,11 @@ 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, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - vh(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) + vh(i,J,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) enddo endif enddo ! k-loop @@ -1208,8 +1199,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & dv_min_CFL(i) = min(dv_min_CFL(i),0.0) enddo - ! Up to this point, everything is shared between vhbt and vhbt_aux. - any_simple_OBC = .false. if (present(vhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do i=ish,ieh @@ -1223,9 +1212,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif if (present(vhbt)) then - call meridional_flux_adjust(v, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*vhbt(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., vh, OBC=OBC) + 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, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., 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 @@ -1243,18 +1232,18 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (any_simple_OBC) then do i=ish,ieh do_I(i) = (OBC%segment(OBC%segnum_v(i,J))%specified) - if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) + if (do_I(i)) FAvi(i) = GV%H_subroundoff*US%m_to_L*G%dx_Cv(i,J) enddo do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + & + FAvi(i) = FAvi(i) + US%m_to_L * & OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo do i=ish,ieh ; if (do_I(i)) then - BT_cont%FA_v_S0(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_N0(i,J) = US%m_to_L*FAvi(i) - BT_cont%FA_v_SS(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAvi(i) + BT_cont%FA_v_S0(i,J) = FAvi(i) ; BT_cont%FA_v_N0(i,J) = FAvi(i) + BT_cont%FA_v_SS(i,J) = FAvi(i) ; BT_cont%FA_v_NN(i,J) = FAvi(i) BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 endif ; enddo endif @@ -1262,11 +1251,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ! present(vhbt) or set_BT_cont - !### Work this into the code above. - do k=1,nz ; do i=ish,ieh - vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) - enddo ; enddo - enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -1308,7 +1292,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & 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, J, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. @@ -1324,10 +1308,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v - !! [H m ~> m2 or kg m-1]. + !! [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1353,7 +1338,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, 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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*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)) @@ -1361,7 +1346,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, 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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*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)) @@ -1369,18 +1354,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, 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) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then do i=ish,ieh ; if (do_I(i)) then if (OBC%segment(OBC%segnum_v(i,J))%open) then if (OBC%segment(OBC%segnum_v(i,J))%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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j) + dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j+1) + dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) endif endif endif ; enddo @@ -1496,7 +1481,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, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1515,15 +1500,16 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! 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 m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment [H m ~> m2 or kg m-1]. + !! dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [m s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1534,17 +1520,17 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! iterate. The default is .true. (more accurate). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(inout) :: vh_3d !< 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 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_(G)) :: & - vh_aux, & ! An auxiliary meridional volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + 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]. real, dimension(SZI_(G)) :: & - vh_err, & ! Difference between vhbt and the summed vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - vh_err_best, & ! The smallest value of vh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. + 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]. v_new, & ! The velocity with the correction added [m s-1]. - dvhdv_tot,&! Summed partial derivative of vh with u [H m ~> m2 or kg m-1]. + dvhdv_tot,&! Summed partial derivative of vh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits dv_max ! and previous iterations [m s-1]. real :: dv_prev ! The previous value of dv [m s-1]. @@ -1590,8 +1576,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or.& + if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -1629,7 +1615,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, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1671,9 +1657,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. real, intent(in) :: dt !< Time increment [s]. @@ -1699,17 +1685,17 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic v_0, & ! transport (v_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the southerly - FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + dvhdv_L, & ! The effective layer marginal face areas with the southerly + dvhdv_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test + dvhdv_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-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]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and - vhtot_R ! and northerly (vhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [H m ~> m2 or kg m-1]. - real :: FA_avg ! The average effective face area [H m ~> m2 or kg m-1], nominally given by + 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]. + real :: FA_avg ! The average effective face area [H L ~> 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 ! limiting is necessary to keep the inverse of visc_rem @@ -1729,9 +1715,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo - call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, & - dvhdv_tot_0, dv0, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + 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, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently ! negative velocity correction for the northerly-flux, and a sufficiently @@ -1771,19 +1757,16 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_R(i) = v(I,j,k) + dvR(i) * visc_rem(i,k) 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, & - FA_marg_0, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, & - FA_marg_L, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, & - FA_marg_R, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) + 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) + 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) + 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) do i=ish,ieh ; if (do_I(i)) then - FAmt_0(i) = FAmt_0(i) + FA_marg_0(i) - FAmt_L(i) = FAmt_L(i) + FA_marg_L(i) - FAmt_R(i) = FAmt_R(i) + FA_marg_R(i) + FAmt_0(i) = FAmt_0(i) + US%L_T_to_m_s*dvhdv_0(i) + FAmt_L(i) = FAmt_L(i) + US%L_T_to_m_s*dvhdv_L(i) + FAmt_R(i) = FAmt_R(i) + US%L_T_to_m_s*dvhdv_R(i) vhtot_L(i) = vhtot_L(i) + vh_L(i) vhtot_R(i) = vhtot_R(i) + vh_R(i) endif ; enddo @@ -1791,10 +1774,10 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, do i=ish,ieh ; if (do_I(i)) then FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvL(i) - dv0(i)) /= 0.0) & - FA_avg = vhtot_L(i) / (dvL(i) - dv0(i)) + FA_avg = US%L_T_to_m_s*vhtot_L(i) / (dvL(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_L(i))) then ; FA_avg = max(FA_0, FAmt_L(i)) elseif (FA_avg < min(FA_0, FAmt_L(i))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_v_S0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_SS(i,J) = US%m_to_L*FAmt_L(i) + BT_cont%FA_v_S0(i,J) = FA_0 ; BT_cont%FA_v_SS(i,J) = FAmt_L(i) if (abs(FA_0-FAmt_L(i)) <= 1e-12*FA_0) then ; BT_cont%vBT_SS(i,J) = 0.0 ; else BT_cont%vBT_SS(i,J) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * & ((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0)) @@ -1802,10 +1785,10 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvR(i) - dv0(i)) /= 0.0) & - FA_avg = vhtot_R(i) / (dvR(i) - dv0(i)) + FA_avg = US%L_T_to_m_s*vhtot_R(i) / (dvR(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_R(i))) then ; FA_avg = max(FA_0, FAmt_R(i)) elseif (FA_avg < min(FA_0, FAmt_R(i))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_v_N0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAmt_R(i) + BT_cont%FA_v_N0(i,J) = FA_0 ; BT_cont%FA_v_NN(i,J) = FAmt_R(i) if (abs(FAmt_R(i) - FA_0) <= 1e-12*FA_0) then ; BT_cont%vBT_NN(i,J) = 0.0 ; else BT_cont%vBT_NN(i,J) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * & ((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0)) From 20108b58c70452e5e6774ec1b758328df3b5c3f7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 14:48:48 -0400 Subject: [PATCH 008/104] +Rescaled accelerations returned from btstep Applied dimensional rescaling of the accelerations, accel_layer_u and accel_layer_v, that are returned by btstep, into [L T-2]. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_barotropic.F90 | 32 ++++++++++++++--------------- src/core/MOM_checksum_packages.F90 | 9 ++++---- src/core/MOM_dynamics_split_RK2.F90 | 12 +++++------ src/core/MOM_variables.F90 | 10 ++++----- src/diagnostics/MOM_PointAccel.F90 | 12 +++++------ 5 files changed, 38 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c753fe2f9d..6f27206645 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -411,9 +411,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! calculate the Coriolis terms in bc_accel_u [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due - !! to the barotropic calculation [m s-2]. + !! to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer - !! due to the barotropic calculation [m s-2]. + !! due to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! 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 @@ -481,7 +481,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the ! barotropic calculation and BT_force_u [L T-2 ~> m s-2]. - uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -514,7 +514,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the ! barotropic calculation and BT_force_v [L T-2 ~> m s-2]. - vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -619,7 +619,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1]. real :: Htot ! The total thickness [H ~> m or kg m-2]. real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. - real :: accel_underflow ! An acceleration that is so small it should be zeroed out. + real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2]. 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 @@ -649,7 +649,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw dt_in_T = US%s_to_T*dt Idt = 1.0 / dt_in_T - accel_underflow = US%L_T_to_m_s*CS%vel_underflow * US%s_to_T*Idt + accel_underflow = CS%vel_underflow * Idt use_BT_cont = .false. if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) @@ -2116,13 +2116,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=is-1,ie - accel_layer_u(I,j,k) = US%L_T2_to_m_s2 * (u_accel_bt(I,j) - & + accel_layer_u(I,j,k) = (u_accel_bt(I,j) - & ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) ) if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0 enddo ; enddo do J=js-1,je ; do i=is,ie - accel_layer_v(i,J,k) = US%L_T2_to_m_s2 * (v_accel_bt(i,J) - & + accel_layer_v(i,J,k) = (v_accel_bt(i,J) - & ((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1) - & (pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j)) * CS%IdyCv(i,J) ) if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0 @@ -2135,13 +2135,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt_in_T - do k=1,nz ; accel_layer_u(I,j,k) = US%L_T2_to_m_s2*u_accel_bt(I,j) ; enddo + do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo endif enddo ; enddo ; endif if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt_in_T - do k=1,nz ; accel_layer_v(i,J,k) = US%L_T2_to_m_s2*v_accel_bt(i,J) ; enddo + do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif endif @@ -2379,12 +2379,12 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in !! transport [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in !! transports [m s-1]. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -2564,9 +2564,9 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points - !! [L m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points - !! [L m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -3394,12 +3394,12 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vbt !< The linearization meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. 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)), & diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index a2731f9a0e..c43bd45501 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -187,13 +187,13 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the - !! barotropic solver [m s-2]. + !! barotropic solver [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in - !! the barotropic solver [m s-2]. + !! the barotropic solver [L T-2 ~> m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -212,7 +212,8 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p if (present(pbce)) & call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) if (present(u_accel_bt) .and. present(v_accel_bt)) & - call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym) + call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym, & + scale=US%L_T2_to_m_s2) end subroutine MOM_accel_chksum ! ============================================================================= diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d2004d8d90..6d95f9999e 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -554,11 +554,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,nz do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt_pred * & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt_pred * & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -758,11 +758,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,nz do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt * & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt * & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -1211,9 +1211,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Barotropic-step Averaged Meridional Velocity', 'm s-1') CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration', 'm s-1') + 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration', 'm s-1') + 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) 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_variables.F90 b/src/core/MOM_variables.F90 index 2dd459ba91..cef3c41a52 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -131,8 +131,8 @@ module MOM_variables v => NULL(), & !< Pointer to the meridional velocity [m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL() !< Pointer to meridional transports [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL() !< Pointer to meridional transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] @@ -141,9 +141,9 @@ module MOM_variables diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement - !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2] - u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [m s-2] - v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [m s-2] + !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2] + u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: & u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index d488171fc5..471dcc3cef 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -53,8 +53,8 @@ module MOM_PointAccel v_prev => NULL(), & !< Previous v-velocity [m s-1]. T => NULL(), & !< Temperature [degC]. S => NULL(), & !< Salinity [ppt]. - u_accel_bt => NULL(), & !< Barotropic u-acclerations [m s-2] - v_accel_bt => NULL() !< Barotropic v-acclerations [m s-2] + 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]. @@ -230,7 +230,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%u_accel_bt(I,j,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif @@ -383,7 +383,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo endif endif @@ -565,7 +565,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%v_accel_bt(i,J,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif @@ -713,7 +713,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo endif endif From 767c09df3f827dd6134ae5d479783715799fb9ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 16:36:55 -0400 Subject: [PATCH 009/104] +Rescaled accelerations passed to btstep Applied dimensional rescaling of the accelerations, u_accel_bc and v_accel_bc, that are passed into btstep, into [L T-2]. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_barotropic.F90 | 8 ++++---- src/core/MOM_dynamics_split_RK2.F90 | 30 ++++++++++++++--------------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6f27206645..230a5439ef 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -396,7 +396,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, intent(in) :: dt !< The time increment to integrate over. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, - !! [m s-2]. + !! [L T-2 ~> m s-2]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies @@ -1008,11 +1008,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! non-symmetric computational domain. !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=Isq,Ieq - BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * US%m_to_L*US%T_to_s**2*bc_accel_u(I,j,k) + BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * bc_accel_u(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * US%m_to_L*US%T_to_s**2*bc_accel_v(i,J,k) + BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * bc_accel_v(i,J,k) enddo ; enddo ; enddo ! Determine the difference between the sum of the layer fluxes and the @@ -1467,7 +1467,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif call uvchksum("BT wt_[uv]", wt_u, wt_v, G%HI, 0, .true., .true.) call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) - call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0) + call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0, scale=US%L_T2_to_m_s2) call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=US%m_to_Z) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=1) endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 6d95f9999e..51fb21eb2f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -285,7 +285,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [m s-2]. + ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in @@ -449,10 +449,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k)) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -474,10 +474,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) enddo ; enddo enddo @@ -553,12 +553,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt_pred * & - (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt_pred * & - (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -707,10 +707,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k)) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -757,12 +757,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt * & - (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) + u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt * & - (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) + v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) From e49b1fd76e8427e23f1ec570cca369b510228d99 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 18:04:19 -0400 Subject: [PATCH 010/104] +Rescaled Coriolis accelerations Applied dimensional rescaling to the Coriolis accelerations, CAu and CAv, that are returned from CorAdCalc, into [L T-2]. This change also includes rescaling of several related diagnostics. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_CoriolisAdv.F90 | 132 +++++++++++++------------- src/core/MOM_checksum_packages.F90 | 6 +- src/core/MOM_dynamics_split_RK2.F90 | 22 +++-- src/core/MOM_dynamics_unsplit.F90 | 22 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 24 ++--- src/core/MOM_variables.F90 | 12 +-- src/diagnostics/MOM_PointAccel.F90 | 24 ++--- src/diagnostics/MOM_diagnostics.F90 | 8 +- 8 files changed, 126 insertions(+), 124 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 9baaa42009..a5be221f63 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -119,9 +119,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. 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 @@ -129,14 +129,14 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - q, & ! Layer potential vorticity [m-1 s-1]. + q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities ! surrounding an h grid point. At small scales, a = q/4, - ! b = q/4, etc. All are in [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1], + ! b = q/4, etc. All are in [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1], ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -146,13 +146,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points ! times the effective areas [H m2 ~> m3 or kg]. - KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], + KEx, & ! The zonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEx = d/dx KE. uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H m2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], + KEy, & ! The meridonal 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)) :: & @@ -163,30 +163,30 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! discretization [H-1 s-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 [m2 s-1] - abs_vort, & ! Absolute vorticity at q-points [s-1]. - q2, & ! Relative vorticity over thickness [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. - max_fvq, & ! The maximum or minimum of the - min_fvq, & ! adjacent values of (-u) or v times - max_fuq, & ! the absolute vorticity [m s-2]. - min_fuq ! All are defined at q points. + abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. + q2, & ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + max_fvq, & ! The maximum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + min_fvq, & ! The minimum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + max_fuq, & ! The maximum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. + min_fuq ! The minimum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - PV, & ! A diagnostic array of the potential vorticities [m-1 s-1]. - RV ! A diagnostic array of the relative vorticities [s-1]. - real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [m s-2]. + PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. + real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [L T-2 ~> m s-2]. real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis - real :: min_fv, min_fu ! accelerations [m s-2], i.e. max(min)_fu(v)q. + real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. real, parameter :: C1_12=1.0/12.0 ! C1_12 = 1/12 real, parameter :: C1_24=1.0/24.0 ! C1_24 = 1/24 - real :: absolute_vorticity ! Absolute vorticity [s-1]. - real :: relative_vorticity ! Relative vorticity [s-1]. + real :: absolute_vorticity ! Absolute vorticity [T-1 ~> s-1]. + real :: relative_vorticity ! Relative vorticity [T-1 ~> s-1]. real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells ! surrounding a q point [H m2 ~> m3 or kg]. 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 :: temp1, temp2 ! Temporary variables [m2 s-2]. + real :: temp1, temp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -406,13 +406,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then - relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * & + relative_vorticity = (2.0-G%mask2dBu(I,J)) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & G%IareaBu(I,J) else - relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * & + relative_vorticity = G%mask2dBu(I,J) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & G%IareaBu(I,J) endif - absolute_vorticity = US%s_to_T*G%CoriolisBu(I,J) + relative_vorticity + absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 if (Area_q(i,j) > 0.0) then hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) @@ -423,10 +423,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Ih_q(I,J) = Ih if (CS%bound_Coriolis) then - fv1 = absolute_vorticity*v(i+1,J,k) - fv2 = absolute_vorticity*v(i,J,k) - fu1 = -absolute_vorticity*u(I,j+1,k) - fu2 = -absolute_vorticity*u(I,j,k) + fv1 = absolute_vorticity * US%m_s_to_L_T*v(i+1,J,k) + fv2 = absolute_vorticity * US%m_s_to_L_T*v(i,J,k) + fu1 = -absolute_vorticity * US%m_s_to_L_T*u(I,j+1,k) + fu2 = -absolute_vorticity * US%m_s_to_L_T*u(I,j,k) if (fv1 > fv2) then max_fvq(I,J) = fv1 ; min_fvq(I,J) = fv2 else @@ -565,7 +565,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif ! Calculate KE and the gradient of KE - call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) + call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! Calculate the tendencies of zonal velocity due to the Coriolis ! force and momentum advection. On a Cartesian grid, this is @@ -590,19 +590,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J-1) * (vh_min(i,j-1)+vh_min(i+1,j-1)) endif - CAu(I,j,k) = US%L_T_to_m_s*0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) + CAu(I,j,k) = 0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.25 * US%L_T_to_m_s * & + CAu(I,j,k) = 0.25 * & (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.125 * US%L_T_to_m_s * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & + CAu(I,j,k) = 0.125 * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & ((vh(i+1,J,k) + vh(i,J,k)) + (vh(i,J-1,k) + vh(i+1,J-1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -610,10 +610,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = US%L_T_to_m_s*((a(I,j) * vh(i+1,J,k) + & - c(I,j) * vh(i,J-1,k)) & - + (b(I,j) * vh(i,J,k) + & - d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + & + (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers @@ -633,32 +631,29 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAu(I,j,k) = US%L_T_to_m_s*0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & - ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & + ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) / & + (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then - VHeff = ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) + VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = US%L_T_to_m_s*QVHeff / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * US%L_to_m*G%IdxCu(I,j) endif enddo ; enddo endif ! Add in the additonal 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) + US%L_T_to_m_s * & + CAu(I,j,k) = CAu(I,j,k) + & (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo ; endif if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq - max_fv = MAX(max_fvq(I,J),max_fvq(I,J-1)) - min_fv = MIN(min_fvq(I,J),min_fvq(I,J-1)) + max_fv = MAX(max_fvq(I,J), max_fvq(I,J-1)) + min_fv = MIN(min_fvq(I,J), min_fvq(I,J-1)) ! CAu(I,j,k) = min( CAu(I,j,k), max_fv ) ! CAu(I,j,k) = max( CAu(I,j,k), min_fv ) if (CAu(I,j,k) > max_fv) then @@ -699,19 +694,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = -0.25 * US%L_T_to_m_s*US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - 0.25* US%L_T_to_m_s*& + CAv(i,J,k) = - 0.25* & (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = -0.125 * US%L_T_to_m_s*(US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & + CAv(i,J,k) = -0.125 * (US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & ((uh(I-1,j,k) + uh(I-1,j+1,k)) + (uh(I,j,k) + uh(I,j+1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -719,7 +714,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - US%L_T_to_m_s*((a(I-1,j) * uh(I-1,j,k) + & + CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + & c(I,j+1) * uh(I,j+1,k)) & + (b(I,j) * uh(I,j,k) + & d(I-1,j+1) * uh(I-1,j+1,k))) * US%L_to_m*G%IdyCv(i,J) @@ -742,7 +737,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAv(i,J,k) = - 0.5*US%L_T_to_m_s*(abs_vort(I,J)+abs_vort(I-1,J)) * & + CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) / & (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) @@ -751,7 +746,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (uh(I-1,j ,k)+uh(I ,j+1,k)) ) QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff & -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) ) - CAv(i,J,k) = - US%L_T_to_m_s*QUHeff / & + CAv(i,J,k) = - QUHeff / & (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) endif enddo ; enddo @@ -759,7 +754,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Add in the additonal terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = CAv(i,J,k) + US%L_T_to_m_s * & + CAv(i,J,k) = CAv(i,J,k) + & (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo ; endif @@ -838,18 +833,19 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. -subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) +subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy [m2 s-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] 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 ! Local variables real :: um, up, vm, vp ! Temporary variables [m s-1]. @@ -897,12 +893,12 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = (KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) + KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = (KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) + KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo if (associated(OBC)) then @@ -922,9 +918,11 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) end subroutine gradKE !> Initializes the control structure for coriolisadv_cs -subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) +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(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 @@ -937,7 +935,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) character(len=400) :: mesg integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 @@ -1068,25 +1066,25 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) end select CS%id_rv = register_diag_field('ocean_model', 'RV', diag%axesBL, Time, & - 'Relative Vorticity', 's-1') + 'Relative Vorticity', 's-1', conversion=US%s_to_T) CS%id_PV = register_diag_field('ocean_model', 'PV', diag%axesBL, Time, & - 'Potential Vorticity', 'm-1 s-1') + 'Potential Vorticity', 'm-1 s-1', conversion=GV%m_to_H*US%s_to_T) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & - 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 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-1 s-2') + 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 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-1 s-2') + 'Meridional Acceleration from Relative Vorticity', 'm-1 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-1 s-2') + 'Zonal Acceleration from Relative Vorticity', 'm-1 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) end subroutine CoriolisAdv_init diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index c43bd45501..662ac963c0 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -167,10 +167,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients !! (equal to -dM/dx) [m s-2]. @@ -206,7 +206,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! 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. - call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym) + call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%s_to_T) if (present(pbce)) & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 51fb21eb2f..b4f064ed41 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -69,12 +69,12 @@ module MOM_dynamics_split_RK2 !> MOM_dynamics_split_RK2 module control structure type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2] + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] PFu, & !< PFu = -dM/dx [m s-2] diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2] + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] PFv, & !< PFv = -dM/dy [m s-2] diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] @@ -449,10 +449,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%CAu(I,j,k) + CS%PFu(I,j,k)) + & + US%s_to_T*CS%diffu(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%CAv(i,J,k) + CS%PFv(i,J,k)) + & + US%s_to_T*CS%diffv(i,J,k)) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -707,10 +709,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%Cau(I,j,k) + CS%PFu(I,j,k)) + & + US%s_to_T*CS%diffu(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%Cav(i,J,k) + CS%PFv(i,J,k)) + & + US%s_to_T*CS%diffv(i,J,k)) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -1104,7 +1108,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_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) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -1197,9 +1201,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'm s-2') + 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'm s-2') + 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & 'Zonal Pressure Force Acceleration', 'm s-2') CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 2ea32a5495..3c146b7b62 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -107,12 +107,12 @@ module MOM_dynamics_unsplit !> MOM_dynamics_unsplit module control structure type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. PFu, & !< PFu = -dM/dx [m s-2]. diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> mm s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. @@ -324,11 +324,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -391,11 +391,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -468,11 +468,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u @@ -648,7 +648,7 @@ 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, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_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) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -672,9 +672,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2, conversion=US%L_T2_to_m_s2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & 'Zonal Pressure Force Acceleration', 'meter second-2') CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 85f1145ecb..b3094d12b5 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -26,7 +26,7 @@ module MOM_dynamics_unsplit_RK2 !* The subroutine step_MOM_dyn_unsplit_RK2 actually does the time * !* stepping, while register_restarts_dyn_unsplit_RK2 sets the fields * !* that are found in a full restart file with this scheme, and * -!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * * +!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * !* used in this module. For largely historical reasons, this module * !* does not have its own control structure, but shares the same * !* control structure with MOM.F90 and the other MOM_dynamics_... * @@ -104,12 +104,12 @@ module MOM_dynamics_unsplit_RK2 !> MOM_dynamics_unsplit_RK2 module control structure type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. PFu, & !< PFu = -dM/dx [m s-2]. diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. @@ -322,11 +322,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_pred * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_pred * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -378,15 +378,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up @@ -608,7 +608,7 @@ 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, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_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) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -631,9 +631,9 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & 'Zonal Pressure Force Acceleration', 'meter second-2') CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index cef3c41a52..477a68aa3f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -158,8 +158,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] - CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [m s-2] - CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [m s-2] + CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] + CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] @@ -174,10 +174,10 @@ module MOM_variables !! not due to any explicit accelerations [m s-1]. ! These accelerations are sub-terms included in the accelerations above. - real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [m s-2] - real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [m s-2] - real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [m s-2] - real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [m s-2] + real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [L T-2 ~> m s-2] + real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [L T-2 ~> m s-2] + 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] end type accel_diag_ptrs diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 471dcc3cef..f21303e0a8 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -188,7 +188,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ((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*ADp%CAu(I,j,k)); enddo + 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 write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFu(I,j,k)); enddo write(file,'(/,"diffu: ",$)') @@ -197,12 +197,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEu(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*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*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') @@ -350,7 +350,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)*Inorm(k)); enddo write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & @@ -363,12 +363,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*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*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(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: ",$)') @@ -520,7 +520,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAv(i,J,k)); enddo + 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 write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo @@ -531,12 +531,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEv(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*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*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') @@ -682,7 +682,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ((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*ADp%CAv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo @@ -693,12 +693,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*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*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(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: ",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ee5a4976ac..1505d3dc8f 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -975,10 +975,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*G%IareaT(i,j) * & @@ -1002,11 +1002,11 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*G%IareaT(i,j) * & From 636a09d261ef43d29c5c10451679cf6b7c39ecb4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 18:35:43 -0400 Subject: [PATCH 011/104] Rescaled pressure gradient accelerations Applied dimensional rescaling to the pressure gradient accelerations, PFu and PFv, that are returned from PressureForce, into [L T-2]. For now the rescaling is done at the end of PressureForce, and not inside the various routines that it selects among. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_PressureForce.F90 | 17 +++++++++++++++-- src/core/MOM_checksum_packages.F90 | 6 +++--- src/core/MOM_dynamics_split_RK2.F90 | 18 +++++++----------- src/core/MOM_dynamics_unsplit.F90 | 18 +++++++++--------- src/core/MOM_dynamics_unsplit_RK2.F90 | 18 +++++++++--------- src/core/MOM_variables.F90 | 8 ++++---- src/diagnostics/MOM_PointAccel.F90 | 8 ++++---- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- 8 files changed, 53 insertions(+), 44 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 183817bf42..6b223c8ca8 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -52,9 +52,9 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu !< Zonal pressure force acceleration [m s-2] + intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv !< Meridional pressure force acceleration [m s-2] + intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & @@ -67,6 +67,11 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, !! [H ~> m or kg m-2], with any tidal contributions. + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: i, j, k + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then call PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, & @@ -93,6 +98,14 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e endif endif + !### Move this into the various routines above. + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + PFu(I,j,k) = US%m_to_L*US%T_to_s**2 * PFu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + PFv(i,J,k) = US%m_to_L*US%T_to_s**2 * PFv(i,J,k) + enddo ; enddo ; enddo + end subroutine Pressureforce !> Initialize the pressure force control structure diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 662ac963c0..195b4061d7 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -173,10 +173,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the !! along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. @@ -207,7 +207,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) - call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) + call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%s_to_T) if (present(pbce)) & call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b4f064ed41..d219433380 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -75,7 +75,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] - PFv, & !< PFv = -dM/dy [m s-2] + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u @@ -449,12 +449,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%CAu(I,j,k) + CS%PFu(I,j,k)) + & - US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + US%m_s_to_L_T*CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%CAv(i,J,k) + CS%PFv(i,J,k)) + & - US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + US%m_s_to_L_T*CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -709,12 +707,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%Cau(I,j,k) + CS%PFu(I,j,k)) + & - US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%m_s_to_L_T*CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%Cav(i,J,k) + CS%PFv(i,J,k)) + & - US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%m_s_to_L_T*CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -1205,9 +1201,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'm s-2') + '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') + 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & 'Barotropic-step Averaged Zonal Velocity', 'm s-1') diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 3c146b7b62..6588bd0154 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -113,7 +113,7 @@ module MOM_dynamics_unsplit real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) @@ -324,11 +324,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & - (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) + US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & - (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) + US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -391,11 +391,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) + US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) + US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -468,11 +468,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) + US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) + US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u @@ -676,9 +676,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + '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') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) 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 b3094d12b5..65413be92d 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -110,7 +110,7 @@ module MOM_dynamics_unsplit_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) @@ -322,11 +322,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_pred * & - ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_pred * & - ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -378,15 +378,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & - ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & - ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & - ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & - ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up @@ -635,9 +635,9 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + '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') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) 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_variables.F90 b/src/core/MOM_variables.F90 index 477a68aa3f..5ee7cd9056 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -136,8 +136,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] - PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [m s-2] - PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [m s-2] + PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [L T-2 ~> m s-2] + PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [L T-2 ~> m s-2] diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement @@ -160,8 +160,8 @@ module MOM_variables diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] - PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] - PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] + PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] + PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index f21303e0a8..6dce366ab5 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -190,7 +190,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFu(I,j,k)); enddo + 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 write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffu(I,j,k)); enddo @@ -354,7 +354,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)*Inorm(k)); enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & @@ -523,7 +523,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo + 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 write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffv(i,J,k)); enddo @@ -685,7 +685,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*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%s_to_T*ADp%diffv(i,J,k)*Inorm(k)); enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1505d3dc8f..dd9e1b3bb4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) From 3db3085d8520e1b0382854451658bc809b6bd6b6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Aug 2019 07:19:21 -0400 Subject: [PATCH 012/104] +Relocated rescaling of pressure gradient terms Moved rescaling of pressure gradient accelerations into the 6 separate PressureForce subroutines, including rescaling of the Montgomery potential. All answers are bitwise identical, but the dimensions of the pressure gradient acceleration have been rescaled. --- src/core/MOM_PressureForce.F90 | 13 --- src/core/MOM_PressureForce_Montgomery.F90 | 93 +++++++++++----------- src/core/MOM_PressureForce_analytic_FV.F90 | 52 ++++++------ src/core/MOM_PressureForce_blocked_AFV.F90 | 44 +++++----- 4 files changed, 95 insertions(+), 107 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 6b223c8ca8..5579b2311f 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -67,11 +67,6 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, !! [H ~> m or kg m-2], with any tidal contributions. - integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then call PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, & @@ -98,14 +93,6 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e endif endif - !### Move this into the various routines above. - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = US%m_to_L*US%T_to_s**2 * PFu(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = US%m_to_L*US%T_to_s**2 * PFv(i,J,k) - enddo ; enddo ; enddo - end subroutine Pressureforce !> Initialize the pressure force control structure diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 2c143baab1..05ac089c34 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -40,9 +40,10 @@ 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() !< Accelerations due to pressure - real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density - !! gradients within layers [m s-2]. + real, pointer :: PFu_bc(:,:,:) => NULL() !< 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 + !! 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 !!@} @@ -67,9 +68,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)), 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_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (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 !! atmosphere-ocean [Pa]. @@ -81,7 +82,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. alpha_star, & ! Compression adjusted specific volume [m3 kg-1]. dz_geo ! The change in geopotential across a layer [m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. @@ -106,12 +107,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, - ! including any tidal contributions [m2 s-2]. + ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] + ! compensated density gradients [L T-2 ~> m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -206,12 +207,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -258,20 +259,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_star(i,j,nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) enddo ; enddo enddo else ! not use_EOS !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * dalpha_int(K+1) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -294,11 +295,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enddo ; enddo ! if (use_EOS) then ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) ! enddo ; enddo ; enddo ! else ! not use_EOS ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * dalpha_int(K) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * dalpha_int(K) ! enddo ; enddo ; enddo ! endif ! use_EOS @@ -319,17 +320,17 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & ((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 + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (US%L_to_m*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 + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop @@ -337,10 +338,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS @@ -365,9 +366,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s2]. + !! (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 !! atmosphere-ocean [Pa]. @@ -377,7 +378,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + 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]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. @@ -400,10 +401,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] -! real :: dr ! Temporary variables. + ! compensated density gradients [L T-2 ~> m s-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -435,7 +435,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -520,7 +520,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + (rho_star(i,j,k) - rho_star(i,j,k-1)) * e(i,j,K) @@ -530,11 +530,11 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(1) * e(i,j,1) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + M(i,j,1) = GV%g_prime(1) * e(i,j,1) + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k-1) + US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) * e(i,j,K) + M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) enddo ; enddo enddo endif ! use_EOS @@ -552,17 +552,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect enddo ; enddo do j=js,je ; do I=Isq,Ieq - PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & ((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 + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (US%L_to_m*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 + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop @@ -570,10 +570,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS @@ -619,7 +619,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0 [m2 Z-1 s-2 ~> m s-2]. + !! compensated), times g/rho_0 [L2 Z-1 T-2 ~> m s-2]. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. @@ -650,10 +650,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = GFS_scale * US%m_s_to_L_T**2*rho_star(i,j,1) * GV%H_to_Z + pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 - pbce(i,j,k) = pbce(i,j,k-1) + US%m_s_to_L_T**2*(rho_star(i,j,k)-rho_star(i,j,k-1)) * & + pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop @@ -825,10 +825,11 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ 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 + ! Local variables logical :: use_temperature, use_EOS -! 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 ! This module's name. if (associated(CS)) then @@ -857,9 +858,9 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ if (use_EOS) then CS%id_PFu_bc = register_diag_field('ocean_model', 'PFu_bc', diag%axesCuL, Time, & - 'Density Gradient Zonal Pressure Force Accel.', "meter second-2") + '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") + '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,G%ke) CS%PFu_bc(:,:,:) = 0.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index d23b343cf4..e4710a42a8 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: 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 @@ -105,8 +105,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg/m2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: 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 @@ -140,7 +140,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the ! interface atop a layer [m2 s-2]. @@ -341,14 +341,14 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif @@ -384,8 +384,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp(i,j) + dp(i+1,j)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie @@ -394,19 +394,19 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp(i,j) + dp(i,j+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif enddo @@ -448,8 +448,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: 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 @@ -466,7 +466,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. @@ -502,8 +502,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 in [L2 m5 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -531,9 +531,9 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = g_Earth_z/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -722,7 +722,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) enddo ; enddo @@ -733,7 +733,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) enddo ; enddo @@ -747,11 +747,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at do k=1,nz !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif @@ -791,8 +791,8 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c9e1b2707c..c3972a0ffe 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: 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 @@ -105,8 +105,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), 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_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [Pa]. @@ -307,14 +307,14 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -365,8 +365,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk i = ib+ioff_bk ; J = Jb+joff_bk @@ -375,17 +375,17 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif enddo @@ -429,8 +429,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: 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 @@ -447,7 +447,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. @@ -482,7 +482,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. @@ -515,9 +515,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = g_Earth_z / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -716,7 +716,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) enddo ; enddo @@ -727,7 +727,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) enddo ; enddo @@ -739,10 +739,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (CS%GFS_scale < 1.0) then do k=1,nz do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif From 7e29087446dd2fb1b6f2812a2fecdf61a166fd9e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Aug 2019 10:25:51 -0400 Subject: [PATCH 013/104] Rescaled variables in advect_tracer Applied dimensional rescaling to numerous internal variables in MOM_tracer_advect.F90 for expanded dimensional consistency testing. All answers are bitwise identical, but the dimensions of the pressure gradient acceleration have been rescaled. --- src/tracer/MOM_tracer_advect.F90 | 164 +++++++++++++++---------------- 1 file changed, 81 insertions(+), 83 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 1958b60cc8..ced1916a7a 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -1,5 +1,4 @@ -!> This program contains the subroutines that advect tracers -!! along coordinate surfaces. +!> This module contains the subroutines that advect tracers along coordinate surfaces. module MOM_tracer_advect ! This file is part of MOM6. See LICENSE.md for the license. @@ -60,7 +59,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [s] - 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(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_(G)), & @@ -70,25 +69,25 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !! first in the x- or y-direction. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - hprev ! cell volume at the end of previous tracer change [H m2 ~> m3 or kg] + hprev ! cell volume at the end of previous tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - uhr ! The remaining zonal thickness flux [H m2 ~> m3 or kg] + uhr ! The remaining zonal thickness flux [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - vhr ! The remaining meridional thickness fluxes [H m2 ~> m3 or kg] + vhr ! The remaining meridional thickness fluxes [H L2 ~> m3 or kg] real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that - ! can be simply discarded [H m2 ~> m3 or kg]. + ! can be simply discarded [H L2 ~> m3 or kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume [H m2 ~> m3 or kg]. + real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> m3 or kg]. real :: Idt ! 1/dt [s-1]. logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding @@ -145,27 +144,27 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! calculations on them, even though they are never used. !$OMP do - do k = 1, nz - do j = jsd, jed; do i = IsdB, IedB; uhr(i,j,k) = 0.0; enddo ; enddo - do j = jsdB, jedB; do i = Isd, Ied; vhr(i,j,k) = 0.0; enddo ; enddo - do j = jsd, jed; do i = Isd, Ied; hprev(i,j,k) = 0.0; enddo ; enddo + do k=1,nz + do j=jsd,jed ; do I=IsdB,IedB ; uhr(I,j,k) = 0.0 ; enddo ; enddo + do J=jsdB,jedB ; do i=Isd,Ied ; vhr(i,J,k) = 0.0 ; enddo ; enddo + do j=jsd,jed ; do i=Isd,Ied ; hprev(i,j,k) = 0.0 ; enddo ; enddo domore_k(k)=1 ! Put the remaining (total) thickness fluxes into uhr and vhr. - do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = US%L_to_m**2*uhtr(I,j,k) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = US%L_to_m**2*vhtr(i,J,k) ; enddo ; enddo + 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 ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & - ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) + do i=is,ie ; do j=js,je + hprev(i,j,k) = max(0.0, US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k) + & + ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers - hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) - enddo ; enddo + hprev(i,j,k) = hprev(i,j,k) + & + max(0.0, 1.0e-13*hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k)) + enddo ; enddo else do i=is,ie ; do j=js,je hprev(i,j,k) = h_prev_opt(i,j,k) @@ -176,11 +175,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect(I,j) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i+1,j)) enddo ; enddo !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect(i,J) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i,j+1)) enddo ; enddo !$OMP do @@ -266,11 +265,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv-stencil, jev+stencil, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv-stencil,jev+stencil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -280,11 +279,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv-stencil, iev+stencil, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -327,16 +326,16 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !! the zonal face [H m2 ~> m3 or kg] + !! the zonal face [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row @@ -347,6 +346,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -354,18 +354,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & - flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -431,7 +431,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = 0.0 CFL(I) = 0.0 elseif (uhr(I,j,k) < 0.0) then - hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h + hup = hprev(i+1,j,k) - US%m_to_L**2*G%areaT(i+1,j)*min_h hlos = MAX(0.0,uhr(I+1,j,k)) if ((((hup - hlos) + uhr(I,j,k)) < 0.0) .and. & ((0.5*hup + uhr(I,j,k)) < 0.0)) then @@ -443,7 +443,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h hlos = MAX(0.0,-uhr(I-1,j,k)) if ((((hup - hlos) - uhr(I,j,k)) < 0.0) .and. & ((0.5*hup - uhr(I,j,k)) < 0.0)) then @@ -568,18 +568,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index idir=1 ! idir switches the sign of the flow so that positive is into the reservoir if (segment%direction == OBC_DIRECTION_W) then - ishift=1 - idir=-1 + ishift = 1 + idir = -1 endif ! update the reservoir tracer concentration implicitly ! using Backward-Euler timestep do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then - uhh(I)=uhr(I,j,k) - u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) - u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(u_L_in-u_L_out) - segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + uhh(I) = uhr(I,j,k) + u_L_in = max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) + u_L_out = min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) + fac1 = 1.0+dt*(u_L_in-u_L_out) + segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) endif @@ -612,9 +612,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = hprev(i,j,k) - (uhh(I) - uhh(I-1)) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else do_i(i) = .false. @@ -632,17 +632,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,m)*Idt + Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,m)*Idt + Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif ! diagnose convergence of flux_x (do not use the Ihnew(i) part of the logic). ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & + Idt * US%L_to_m**2*G%IareaT(i,j) endif ; enddo endif @@ -655,16 +656,16 @@ end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face [H m2 ~> m3 or kg] + !! the meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row @@ -675,6 +676,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -682,18 +684,18 @@ 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 :: 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 - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -771,7 +773,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & vhh(i,J) = 0.0 CFL(i) = 0.0 elseif (vhr(i,J,k) < 0.0) then - hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h + hup = hprev(i,j+1,k) - US%m_to_L**2*G%areaT(i,j+1)*min_h hlos = MAX(0.0,vhr(i,J+1,k)) if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & ((0.5*hup + vhr(i,J,k)) < 0.0)) then @@ -783,7 +785,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h hlos = MAX(0.0,-vhr(i,J-1,k)) if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & ((0.5*hup - vhr(i,J,k)) < 0.0)) then @@ -902,13 +904,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & segment=>OBC%segment(n) if (segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle - if (segment%is_N_or_S .and. & - (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then - jshift=0 - jdir=1 + if (segment%is_N_or_S .and. (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then + jshift = 0 ; jdir = 1 if (segment%direction == OBC_DIRECTION_S) then - jshift=1 - jdir=-1 + jshift = 1 ; jdir = -1 endif do i=segment%HI%isd,segment%HI%ied ! update the reservoir tracer concentration implicitly @@ -916,10 +915,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then vhh(i,J)=vhr(i,J,k) - v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(v_L_in-v_L_out) - segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + v_L_in = max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) + v_L_out = min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) + fac1 = 1.0 + dt*(v_L_in-v_L_out) + segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) endif @@ -959,9 +958,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = max(hprev(i,j,k) - (vhh(i,J) - vhh(i,J-1)), 0.0) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else ; do_i(i) = .false. ; endif enddo @@ -975,25 +974,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt + Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif ! diagnose convergence of flux_y and add to convergence of flux_x. ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & + US%L_to_m**2*G%IareaT(i,j) endif ; enddo endif - enddo endif ; enddo ! End of j-loop. - end subroutine advect_y !> Initialize lateral tracer advection module @@ -1006,8 +1004,8 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) integer, save :: init_calls = 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) :: mdl = "MOM_tracer_advect" ! This module's name. character(len=256) :: mesg ! Message for error messages. From 9d75ae98c6d47b8f6df3a9cf348a6cb88daab989 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Aug 2019 18:36:46 -0400 Subject: [PATCH 014/104] +Rescaled continuity internal calculations Applied dimensional rescaling to all of the velocities used inside of continuity_PPM or passed to continuity_PPM from continuity to work in units of [L T-1]. Also rearranged the dimensional scaling factors that will align with the grid spacing to facilitate later cancellations. This required the addition of unit_scale_type arguments to the continuity initialization routines. All answers are bitwise identical, but the units of the arguments to a public routine that is wrapped inside of another have changed, and there is a new argument to publicly called routines. --- src/core/MOM_continuity.F90 | 30 +- src/core/MOM_continuity_PPM.F90 | 421 +++++++++++++------------- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- 5 files changed, 244 insertions(+), 213 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 2a0c844932..47dcf3d365 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -88,6 +88,15 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. + ! Local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_tmp ! Rescaled version of u [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_tmp ! Rescaled version of V [L T-1 ~> m s-1] + integer :: is, ie, js, je, nz, stencil + integer :: i, j, k + + logical :: x_first + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & "MOM_continuity: Either both visc_rem_u and visc_rem_v or neither"// & " one must be present in call to continuity.") @@ -96,8 +105,22 @@ 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, & + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_tmp(I,j,k) = US%m_s_to_L_T * u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_tmp(i,J,k) = US%m_s_to_L_T * v(i,J,k) + enddo ; enddo ; enddo + + call continuity_PPM(u_tmp, v_tmp, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) + + if (present(u_cor)) then ; do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_cor(I,j,k) = US%L_T_to_m_s * u_cor(I,j,k) + enddo ; enddo ; enddo ; endif + if (present(v_cor)) then ; do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_cor(i,J,k) = US%L_T_to_m_s * v_cor(i,J,k) + enddo ; enddo ; enddo ; endif else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif @@ -105,10 +128,11 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, end subroutine continuity !> Initializes continuity_cs -subroutine continuity_init(Time, G, GV, param_file, diag, CS) +subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(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 !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. @@ -144,7 +168,7 @@ subroutine continuity_init(Time, G, GV, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) endif end subroutine continuity_init diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 1a2733bbea..c40fcb86f4 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -39,7 +39,7 @@ module MOM_continuity_PPM !! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses [m s-1]. + !! 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 @@ -78,9 +78,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -116,10 +116,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport [m s-1]. + !< The zonal velocities that give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. + !< The meridional velocities 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. @@ -148,7 +149,7 @@ 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, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -163,7 +164,7 @@ 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, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -179,7 +180,7 @@ 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, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -191,7 +192,7 @@ 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, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -207,18 +208,18 @@ 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_in_T, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -241,13 +242,13 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & - du, & ! Corrective barotropic change in the velocity [m s-1]. + 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 - duhdu_tot_0, & ! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-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. logical, dimension(SZIB_(G)) :: do_I @@ -257,10 +258,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real :: FA_u ! A sum of zonal face areas [H m ~> 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 [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: du_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple @@ -277,8 +278,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -314,7 +315,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_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & @@ -334,9 +335,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm uh_tot_0(I) = 0.0 ; duhdu_tot_0(I) = 0.0 @@ -349,9 +350,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) if (du_max_CFL(I) * visc_rem(I,k) > du_lim) & @@ -364,9 +365,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & du_max_CFL(I) = (dx_W*CFL_dt - u(I,j,k)) / visc_rem(I,k) @@ -378,9 +379,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & ((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) ) @@ -390,9 +391,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) du_min_CFL(I) = MAX(du_min_CFL(I), -(dx_E*CFL_dt + u(I,j,k))) @@ -418,14 +419,14 @@ 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, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true., 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 if (local_specified_BC) then ; do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + u_cor(I,j,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) enddo ; endif enddo ; endif ! u-corrected @@ -433,7 +434,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, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -486,10 +487,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, LB, & + call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) else - call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) endif endif ; endif @@ -497,10 +498,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + 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 @@ -512,8 +513,8 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! with u [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -538,35 +539,35 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * & + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * & + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) 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) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then do I=ish-1,ieh ; if (do_I(I)) then if (OBC%segment(OBC%segnum_u(I,j))%open) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i) - duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i) + duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) else - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i+1) - duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i+1) + duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) endif endif endif ; enddo @@ -574,10 +575,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & end subroutine zonal_flux_layer !> Sets the effective interface thickness at each zonal velocity point. -subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & +subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_u, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -585,7 +586,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. @@ -612,14 +614,14 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -681,10 +683,10 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -700,16 +702,16 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< - !! The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. @@ -726,18 +728,18 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. - duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-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]. uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. - u_new, & ! The velocity with the correction added [m s-1]. - duhdu_tot,&! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + u_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + duhdu_tot,&! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits - du_max ! and previous iterations [m s-1]. - real :: du_prev ! The previous value of du [m s-1]. - real :: ddu ! The change in du from the previous iteration [m s-1]. + du_max ! and previous iterations [L T-1 ~> m s-1]. + real :: du_prev ! The previous value of du [L T-1 ~> m s-1]. + real :: ddu ! The change in du from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZIB_(G)) @@ -777,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -816,7 +818,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -845,10 +847,10 @@ end subroutine zonal_flux_adjust !> Sets a structure that describes the zonal barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -860,12 +862,12 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! value of du [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -881,16 +883,16 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! which I values to work on. ! Local variables real, dimension(SZIB_(G)) :: & - du0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. duL, duR, & ! The barotropic velocity increments that give the westerly - ! (duL) and easterly (duR) test velocities. + ! (duL) and easterly (duR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + du_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic - u_0, & ! transport (u_0) layer test velocities [m s-1]. + u_0, & ! transport (u_0) layer test velocities [L T-1 ~> m s-1]. duhdu_L, & ! The effective layer marginal face areas with the westerly duhdu_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - duhdu_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. + duhdu_0, & ! velocities [H L ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), uh_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 @@ -909,17 +911,17 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! 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] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0 / (dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently @@ -928,7 +930,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, domore = .false. do I=ish-1,ieh if (do_I(I)) domore = .true. - du_CFL(I) = (CFL_min * Idt) * G%dxCu(I,j) + du_CFL(I) = (CFL_min * Idt) * US%m_to_L*G%dxCu(I,j) duR(I) = min(0.0,du0(I) - du_CFL(I)) duL(I) = max(0.0,du0(I) + du_CFL(I)) FAmt_L(I) = 0.0 ; FAmt_R(I) = 0.0 ; FAmt_0(I) = 0.0 @@ -961,15 +963,15 @@ 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_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) do I=ish-1,ieh ; if (do_I(I)) then - FAmt_0(I) = FAmt_0(I) + US%L_T_to_m_s*duhdu_0(I) - FAmt_L(I) = FAmt_L(I) + US%L_T_to_m_s*duhdu_L(I) - FAmt_R(I) = FAmt_R(I) + US%L_T_to_m_s*duhdu_R(I) + FAmt_0(I) = FAmt_0(I) + duhdu_0(I) + FAmt_L(I) = FAmt_L(I) + duhdu_L(I) + FAmt_R(I) = FAmt_R(I) + duhdu_R(I) uhtot_L(I) = uhtot_L(I) + uh_L(I) uhtot_R(I) = uhtot_R(I) + uh_R(I) endif ; enddo @@ -977,25 +979,25 @@ 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 ; if (do_I(I)) then FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duL(I) - du0(I)) /= 0.0) & - FA_avg = US%L_T_to_m_s*uhtot_L(I) / (duL(I) - du0(I)) + FA_avg = uhtot_L(I) / (duL(I) - du0(I)) if (FA_avg > max(FA_0, FAmt_L(I))) then ; FA_avg = max(FA_0, FAmt_L(I)) elseif (FA_avg < min(FA_0, FAmt_L(I))) then ; FA_0 = FA_avg ; endif BT_cont%FA_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = FAmt_L(I) if (abs(FA_0-FAmt_L(I)) <= 1e-12*FA_0) then ; BT_cont%uBT_WW(I,j) = 0.0 ; else - BT_cont%uBT_WW(I,j) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * & + BT_cont%uBT_WW(I,j) = (1.5 * (duL(I) - du0(I))) * & ((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0)) endif FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duR(I) - du0(I)) /= 0.0) & - FA_avg = US%L_T_to_m_s*uhtot_R(I) / (duR(I) - du0(I)) + FA_avg = uhtot_R(I) / (duR(I) - du0(I)) if (FA_avg > max(FA_0, FAmt_R(I))) then ; FA_avg = max(FA_0, FAmt_R(I)) elseif (FA_avg < min(FA_0, FAmt_R(I))) then ; FA_0 = FA_avg ; endif BT_cont%FA_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = FAmt_R(I) if (abs(FAmt_R(I) - FA_0) <= 1e-12*FA_0) then ; BT_cont%uBT_EE(I,j) = 0.0 ; else - BT_cont%uBT_EE(I,j) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * & + BT_cont%uBT_EE(I,j) = (1.5 * (duR(I) - du0(I))) * & ((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0)) endif else @@ -1007,18 +1009,18 @@ 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_in_T, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< 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), pointer :: 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 !! specifies whether, where, and what open boundary conditions are used. @@ -1033,19 +1035,19 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) - !! that give vhbt as the depth-integrated transport [m s-1]. + !! 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. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. + dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & - dv, & ! Corrective barotropic change in the velocity [m s-1]. + dv, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L ~> m2 or kg m-1]. vh_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. logical, dimension(SZI_(G)) :: do_I @@ -1055,10 +1057,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & 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. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: dv_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC @@ -1075,8 +1077,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -1113,7 +1115,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_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & @@ -1132,9 +1134,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm vh_tot_0(i) = 0.0 ; dvhdv_tot_0(i) = 0.0 @@ -1148,9 +1150,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & dv_max_CFL(i) = dv_lim / visc_rem(i,k) @@ -1162,9 +1164,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)) & @@ -1175,9 +1177,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) dv_min_CFL(i) = max(dv_min_CFL(i), 0.499 * & @@ -1186,9 +1188,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) enddo ; enddo @@ -1213,21 +1215,21 @@ 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, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true., 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 if (local_specified_BC) then ; do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + v_cor(i,J,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) enddo ; endif enddo ; endif ! v-corrected endif 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, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1281,10 +1283,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, LB, & + call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) else - call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) endif endif ; endif @@ -1292,10 +1294,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & 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, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + 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 @@ -1310,8 +1312,8 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v - !! [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1335,18 +1337,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - 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 + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * ( h_R(i,j) + CFL * & + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt_in_T * US%L_to_m*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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * ( h_L(i,j+1) + CFL * & + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) 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)) @@ -1354,18 +1356,18 @@ 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) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then do i=ish,ieh ; if (do_I(i)) then if (OBC%segment(OBC%segnum_v(i,J))%open) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j) - dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j) + dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) else - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j+1) - dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j+1) + dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) endif endif endif ; enddo @@ -1373,10 +1375,10 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & end subroutine merid_flux_layer !> Sets the effective interface thickness at each meridional velocity point. -subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & +subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1385,8 +1387,9 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the marginal @@ -1401,7 +1404,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. + ! with the same units as h [H ~> m or kg m-2] . real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC @@ -1411,15 +1414,15 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & @@ -1481,11 +1484,11 @@ 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, US, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& @@ -1501,14 +1504,14 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 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]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. @@ -1529,14 +1532,14 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 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]. - v_new, & ! The velocity with the correction added [m s-1]. - dvhdv_tot,&! Summed partial derivative of vh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + v_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + dvhdv_tot,&! Summed partial derivative of vh with u [H L ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits - dv_max ! and previous iterations [m s-1]. - real :: dv_prev ! The previous value of dv [m s-1]. - real :: ddv ! The change in dv from the previous iteration [m s-1]. + dv_max ! and previous iterations [L T-1 ~> m s-1]. + real :: dv_prev ! The previous value of dv [L T-1 ~> m s-1]. + real :: ddv ! The change in dv from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZI_(G)) @@ -1576,7 +1579,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1615,7 +1618,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_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1644,10 +1647,10 @@ end subroutine meridional_flux_adjust !> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1659,10 +1662,12 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! of du_err with dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -1678,18 +1683,18 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! which I values to work on. ! Local variables real, dimension(SZI_(G)) :: & - dv0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. dvL, dvR, & ! The barotropic velocity increments that give the southerly - ! (dvL) and northerly (dvR) test velocities. + ! (dvL) and northerly (dvR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + dv_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic - v_0, & ! transport (v_0) layer test velocities [m s-1]. + v_0, & ! transport (v_0) layer test velocities [L T-1 ~> m s-1]. dvhdv_L, & ! The effective layer marginal face areas with the southerly dvhdv_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - dvhdv_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. + dvhdv_0, & ! velocities [H L ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) - vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + 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]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and @@ -1706,17 +1711,17 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! 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] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0/(dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently @@ -1725,7 +1730,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, domore = .false. do i=ish,ieh ; if (do_I(i)) then domore = .true. - dv_CFL(i) = (CFL_min * Idt) * G%dyCv(i,J) + dv_CFL(i) = (CFL_min * Idt) * US%m_to_L*G%dyCv(i,J) dvR(i) = min(0.0,dv0(i) - dv_CFL(i)) dvL(i) = max(0.0,dv0(i) + dv_CFL(i)) FAmt_L(i) = 0.0 ; FAmt_R(i) = 0.0 ; FAmt_0(i) = 0.0 @@ -1758,15 +1763,15 @@ 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_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) do i=ish,ieh ; if (do_I(i)) then - FAmt_0(i) = FAmt_0(i) + US%L_T_to_m_s*dvhdv_0(i) - FAmt_L(i) = FAmt_L(i) + US%L_T_to_m_s*dvhdv_L(i) - FAmt_R(i) = FAmt_R(i) + US%L_T_to_m_s*dvhdv_R(i) + FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) + FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) + FAmt_R(i) = FAmt_R(i) + dvhdv_R(i) vhtot_L(i) = vhtot_L(i) + vh_L(i) vhtot_R(i) = vhtot_R(i) + vh_R(i) endif ; enddo @@ -1774,23 +1779,23 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, do i=ish,ieh ; if (do_I(i)) then FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvL(i) - dv0(i)) /= 0.0) & - FA_avg = US%L_T_to_m_s*vhtot_L(i) / (dvL(i) - dv0(i)) + FA_avg = vhtot_L(i) / (dvL(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_L(i))) then ; FA_avg = max(FA_0, FAmt_L(i)) elseif (FA_avg < min(FA_0, FAmt_L(i))) then ; FA_0 = FA_avg ; endif BT_cont%FA_v_S0(i,J) = FA_0 ; BT_cont%FA_v_SS(i,J) = FAmt_L(i) if (abs(FA_0-FAmt_L(i)) <= 1e-12*FA_0) then ; BT_cont%vBT_SS(i,J) = 0.0 ; else - BT_cont%vBT_SS(i,J) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * & + BT_cont%vBT_SS(i,J) = (1.5 * (dvL(i) - dv0(i))) * & ((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0)) endif FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvR(i) - dv0(i)) /= 0.0) & - FA_avg = US%L_T_to_m_s*vhtot_R(i) / (dvR(i) - dv0(i)) + FA_avg = vhtot_R(i) / (dvR(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_R(i))) then ; FA_avg = max(FA_0, FAmt_R(i)) elseif (FA_avg < min(FA_0, FAmt_R(i))) then ; FA_0 = FA_avg ; endif BT_cont%FA_v_N0(i,J) = FA_0 ; BT_cont%FA_v_NN(i,J) = FAmt_R(i) if (abs(FAmt_R(i) - FA_0) <= 1e-12*FA_0) then ; BT_cont%vBT_NN(i,J) = 0.0 ; else - BT_cont%vBT_NN(i,J) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * & + BT_cont%vBT_NN(i,J) = (1.5 * (dvR(i) - dv0(i))) * & ((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0)) endif else @@ -2173,10 +2178,11 @@ function ratio_max(a, b, maxrat) result(ratio) end function ratio_max !> Initializes continuity_ppm_cs -subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< Time increment [s]. +subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) + type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< 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 indicating !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to @@ -2232,7 +2238,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) 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 "//& - "layer thicknesses.", units="m s-1", default=3.0e8) ! The speed of light is the default. + "layer thicknesses.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) + ! The speed of light is the default. call get_param(param_file, mdl, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& "If true, allow the adjusted velocities to have a "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d219433380..d97cdf06a9 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1103,7 +1103,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6588bd0154..e4f902c9e0 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -647,7 +647,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 65413be92d..e4c92b9783 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -607,7 +607,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & From 065225913c7b44409ba25844ba99efbeca747eb7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Aug 2019 10:23:37 -0400 Subject: [PATCH 015/104] Add parentheses around grid metric arrays Added parentheses around grid metric arrays in denominators and where they are raised to powers to enable the quasi-automated unit conversion of these grid metrics. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 6 ++--- config_src/mct_driver/MOM_surface_forcing.F90 | 4 +-- .../nuopc_driver/MOM_surface_forcing.F90 | 4 +-- src/core/MOM.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/initialization/MOM_grid_initialize.F90 | 6 ++--- .../MOM_shared_initialization.F90 | 14 +++++----- .../MOM_state_initialization.F90 | 18 ++++++------- .../lateral/MOM_hor_visc.F90 | 26 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 16 ++++++------ .../lateral/MOM_mixed_layer_restrat.F90 | 8 +++--- src/tracer/MOM_offline_aux.F90 | 2 +- src/tracer/MOM_offline_main.F90 | 8 +++--- src/user/DOME2d_initialization.F90 | 2 +- 14 files changed, 59 insertions(+), 59 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bb6270c177..1dfe0662a4 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -230,7 +230,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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 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] open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria [nondim] @@ -522,13 +522,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) enddo ; enddo 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) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5d30f3c9cb..9653a27a4b 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -514,13 +514,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) enddo; enddo 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) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 01cd79acb9..d91a9bfdac 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -542,13 +542,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) enddo ; enddo 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) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 91ec256248..acf6cc4351 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2208,7 +2208,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index bc3f8323f0..a753f273aa 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1511,7 +1511,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (G%areaT(i,j)) enddo ; enddo ; endif if (CS%debug) then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 305087dc44..2dc74c144b 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -857,7 +857,7 @@ subroutine set_grid_metrics_mercator(G, param_file) 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) + G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -867,7 +867,7 @@ subroutine set_grid_metrics_mercator(G, param_file) 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) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -903,7 +903,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo endif diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 42e99f2ef6..419d71461c 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -715,7 +715,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -729,7 +729,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -780,7 +780,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -794,7 +794,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -992,7 +992,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1021,7 +1021,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then @@ -1147,7 +1147,7 @@ subroutine compute_global_grid_integrals(G) call MOM_error(FATAL, "compute_global_grid_integrals: "//& "zero ocean area (check topography?)") - G%IareaT_global = 1. / G%areaT_global + G%IareaT_global = 1.0 / (G%areaT_global) end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 60d8c4b0d0..e8f42bc6d1 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1385,12 +1385,12 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) do k=1,nz ; do j=js,je ; do I=Isq,Ieq psi1 = my_psi(I,j) psi2 = my_psi(I,j-1) - u(I,j,k) = (psi1-psi2)/G%dy_Cu(I,j)! *(circular_max_u*G%len_lon/(2.0*dpi)) + u(I,j,k) = (psi1-psi2) / (G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie psi1 = my_psi(i,J) psi2 = my_psi(i-1,J) - v(i,J,k) = (psi2-psi1)/G%dx_Cv(i,J)! *(circular_max_u*G%len_lon/(2.0*dpi)) + v(i,J,k) = (psi2-psi1) / (G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo contains @@ -1402,12 +1402,12 @@ real function my_psi(ig,jg) ! Local variables real :: x, y, r - x = 2.0*(G%geoLonBu(ig,jg)-G%west_lon)/G%len_lon-1.0 ! -1 This subroutine sets the 4 bottom depths at velocity points to be the @@ -2156,7 +2156,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) enddo ; enddo ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 5d871921a9..0f620a1b39 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -66,7 +66,7 @@ module MOM_hor_visc !! scales quadratically with the velocity shears. logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file. real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal - !! viscosity [m2 T-1 ~> m2 s-1]. The default is 0.0 + !! viscosity [m2 T-1 ~> m2 s-1]. The default is 0.0. logical :: use_land_mask !< 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. @@ -102,7 +102,7 @@ module MOM_hor_visc !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx !< The amount by which stresses through h points are reduced - !! due to partial barriers. Nondimensional. + !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. @@ -746,7 +746,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -1263,9 +1263,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & - CS%DY2h(i+1,j)*str_xx(i+1,j)) + & + CS%DY2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & - CS%DX2q(I,J) *str_xy(I,J))) * & + CS%DX2q(I,J) *str_xy(I,J))) * & G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo @@ -1853,32 +1853,32 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%reduction_xx(i,j) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / G%dyCu(I-1,j) + CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / G%dxCv(i,J-1) + CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / G%dyCu(I,j+1) + CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / G%dxCv(i+1,J) + CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 70b80b38cb..7a88529b03 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1118,9 +1118,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif do J=js-1,Jeq ; do I=is-1,Ieq - CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & + CS%f2_dx2_q(I,J) = ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) - CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (sqrt(0.5 * & + CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1128,9 +1128,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & + CS%f2_dx2_u(I,j) = ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) - CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -1139,9 +1139,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & + CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) - CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * (sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -1162,11 +1162,11 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 - CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & + CS%f2_dx2_h(i,j) = ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * & max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((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 + & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 3f1164fc77..5df2b2d166 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -360,7 +360,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -436,7 +436,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -663,7 +663,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -710,7 +710,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 37f66987c0..e8d4424e15 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -73,7 +73,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) enddo ; enddo enddo diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0624f98337..f43a7d4e05 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -322,7 +322,7 @@ 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%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 @@ -342,7 +342,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! 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%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -517,7 +517,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) 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%areaT(i,j) + h_new(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 @@ -562,7 +562,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) 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%areaT(i,j) + h_new(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 diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a9a5be3d42..ddffbab1be 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -471,7 +471,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) z = -G%bathyT(i,j) do k = nz,1,-1 z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k - S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) + S(i,j,k) = 34.0 - 1.0 * (z / (G%max_depth)) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k From 4cd8641f4ab9a0d6d7513bb6686034a55bc68e92 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Aug 2019 16:59:12 -0400 Subject: [PATCH 016/104] +Rescaled the units of G%Iarea arrays Rescaled the units of the various G%I_area arrays throughout the MOM6 code to units of [L-2]. In debugging these changes, several new chksums were added to the mom_hor_visc_code, and these were retained. In addition several new unit_scale_type arguments were added to subroutines throughout the code. All answers are bitwise identical, but interfaces have changed. Note that the line-length limits have been temporarily exceeded with these changes. --- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- .../ice_solo_driver/MOM_surface_forcing.F90 | 4 +- config_src/mct_driver/MOM_ocean_model.F90 | 4 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 4 +- config_src/solo_driver/MOM_driver.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 4 +- src/core/MOM.F90 | 14 ++-- src/core/MOM_CoriolisAdv.F90 | 8 +-- src/core/MOM_barotropic.F90 | 18 ++--- src/core/MOM_continuity_PPM.F90 | 28 ++++---- src/core/MOM_grid.F90 | 22 ++++--- src/core/MOM_transcribe_grid.F90 | 11 ++-- src/diagnostics/MOM_PointAccel.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 18 ++--- src/diagnostics/MOM_sum_output.F90 | 8 +-- src/framework/MOM_dyn_horgrid.F90 | 20 +++--- src/ice_shelf/MOM_ice_shelf.F90 | 27 ++++---- .../MOM_fixed_initialization.F90 | 6 +- src/initialization/MOM_grid_initialize.F90 | 66 ++++++++++++------- .../MOM_shared_initialization.F90 | 19 ++++-- src/ocean_data_assim/MOM_oda_driver.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 18 ++--- .../lateral/MOM_hor_visc.F90 | 62 ++++++++++++----- .../lateral/MOM_internal_tides.F90 | 42 ++++++------ .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 20 +++--- .../vertical/MOM_diabatic_aux.F90 | 7 +- .../vertical/MOM_diabatic_driver.F90 | 20 +++--- .../vertical/MOM_set_diffusivity.F90 | 8 +-- .../vertical/MOM_vert_friction.F90 | 24 +++---- src/tracer/MOM_neutral_diffusion.F90 | 8 ++- src/tracer/MOM_tracer_advect.F90 | 4 +- src/tracer/MOM_tracer_hor_diff.F90 | 10 +-- src/user/MOM_controlled_forcing.F90 | 16 +++-- 34 files changed, 311 insertions(+), 229 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index f9b84a97e1..3aa63ab733 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -505,7 +505,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, & OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) if (OS%use_ice_shelf) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) if (OS%icebergs_alter_ocean) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index efacc07dc5..ad2352d460 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -693,12 +693,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_w", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_s", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo ! Read the SST and SSS fields for damping. diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 8bb3346021..0d5c9a7b87 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -497,7 +497,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif ! GMM, check ocean_model_MOM.F90 to enable the following option @@ -521,7 +521,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif ! GMM, check ocean_model_MOM.F90 to enable the following option diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index abe583ffcc..05232b8d0c 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -520,7 +520,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -551,7 +551,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 6fba8efdee..b057e06f9e 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -488,7 +488,7 @@ program MOM_main if (use_ice_shelf) then call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) - call add_shelf_forces(grid, Ice_shelf_CSp, forces) + call add_shelf_forces(grid, US, Ice_shelf_CSp, forces) endif fluxes%fluxes_used = .false. fluxes%dt_buoy_accum = dt_forcing diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 4d9458a1c9..442047f03c 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -909,12 +909,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) call MOM_read_data(CS%runoff_file, CS%lrunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index acf6cc4351..b667bcfae8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1085,7 +1085,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) @@ -1399,7 +1399,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1424,7 +1424,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1459,7 +1459,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif @@ -2135,7 +2135,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! The next line would be needed if G%Domain had not already been init'd above: ! call clone_MOM_domain(dG%Domain, G%Domain) call MOM_grid_init(G, param_file, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G) + call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) ! Set a few remaining fields that are specific to the ocean grid type. @@ -2165,8 +2165,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call clone_MOM_domain(G%Domain, CS%G%Domain) call MOM_grid_init(CS%G, param_file) - call copy_MOM_grid_to_dyngrid(G, dg) - call copy_dyngrid_to_MOM_grid(dg, CS%G) + call copy_MOM_grid_to_dyngrid(G, dg, US) + call copy_dyngrid_to_MOM_grid(dg, CS%G, US) call destroy_dyn_horgrid(dG) call MOM_grid_end(G) ; deallocate(G) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index a5be221f63..7f901f213d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -407,10 +407,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then relative_vorticity = (2.0-G%mask2dBu(I,J)) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + US%m_to_L**2*G%IareaBu(I,J) else relative_vorticity = G%mask2dBu(I,J) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + US%m_to_L**2*G%IareaBu(I,J) endif absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 @@ -867,7 +867,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) +G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & +( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & - )*0.25*G%IareaT(i,j) + )*0.25*US%m_to_L**2*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 @@ -887,7 +887,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) - KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*G%IareaT(i,j) + KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 230a5439ef..4247a2aa5c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1392,7 +1392,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! This estimate of the maximum stable time step is pretty accurate for ! gravity waves, but it is a conservative estimate since it ignores the ! stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & ((gtot_E(i,j) * (Datu(I,j)*US%L_to_m*G%IdxCu(I,j)) + & gtot_W(i,j) * (Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j))) + & (gtot_N(i,j) * (Datv(i,J)*US%L_to_m*G%IdyCv(i,J)) + & @@ -1400,7 +1400,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) H_eff_dx2 = max(H_min_dyn * ((US%L_to_m*G%IdxT(i,j))**2 + (US%L_to_m*G%IdyT(i,j))**2), & - US%L_to_m**2*G%IareaT(i,j) * & + US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & @@ -1544,19 +1544,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. ubt(I,j) = (-0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. ubt(I,j) = (0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. vbt(i,J) = (-0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. vbt(i,J) = (0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) endif @@ -2350,7 +2350,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) do j=js,je ; do i=is,ie ! This is pretty accurate for gravity waves, but it is a conservative ! estimate since it ignores the stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & ((gtot_E(i,j)*Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & (gtot_N(i,j)*Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & @@ -4078,7 +4078,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0 do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%IareaT(i,j) = US%L_to_m**2*G%IareaT(i,j) + CS%IareaT(i,j) = US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo @@ -4344,7 +4344,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) do j=js,je ; do i=is,ie - CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & + CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & ((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1))) enddo ; enddo endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index c40fcb86f4..4117a2b5a9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -154,7 +154,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -169,7 +169,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -185,7 +185,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) @@ -197,7 +197,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -539,14 +539,14 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & @@ -614,13 +614,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) @@ -779,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1337,7 +1337,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & @@ -1345,7 +1345,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i) * dt_in_T * US%L_to_m*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) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & @@ -1414,14 +1414,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) @@ -1579,7 +1579,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index b66aecd261..0679c23efa 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -8,6 +8,7 @@ module MOM_grid use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -81,7 +82,7 @@ module MOM_grid dyT, & !< dyT is delta y at h points [m]. IdyT, & !< IdyT is 1/dyT [m-1]. areaT, & !< The area of an h-cell [m2]. - IareaT, & !< 1/areaT [m-2]. + IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. cos_rot !< The cosine of the angular rotation between the local model grid's northward @@ -96,7 +97,7 @@ module MOM_grid dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & @@ -108,7 +109,7 @@ module MOM_grid dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & @@ -120,7 +121,7 @@ module MOM_grid dyBu, & !< dyBu is delta y at q points [m]. IdyBu, & !< 1/dyBu [m-1]. areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: & gridLatT => NULL(), & !< The latitude of T points for the purpose of labeling the output axes. @@ -155,9 +156,9 @@ module MOM_grid df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] - real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m2]. + real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2]. ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE @@ -402,8 +403,9 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) end subroutine rescale_grid_bathymetry !> set_derived_metrics calculates metric terms that are derived from other metrics. -subroutine set_derived_metrics(G) - type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure +subroutine set_derived_metrics(G, US) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. integer :: i, j, isd, ied, jsd, jed @@ -417,7 +419,7 @@ subroutine set_derived_metrics(G) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -442,7 +444,7 @@ subroutine set_derived_metrics(G) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) + G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 62ac6e1ea4..045fc9261c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -9,6 +9,7 @@ module MOM_transcribe_grid 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 implicit none ; private @@ -18,9 +19,10 @@ module MOM_transcribe_grid !> Copies information from a dynamic (shared) horizontal grid type into an !! ocean_grid_type. -subroutine copy_dyngrid_to_MOM_grid(dG, oG) +subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) type(dyn_horgrid_type), intent(in) :: dG !< Common horizontal grid type type(ocean_grid_type), intent(inout) :: oG !< Ocean grid type + 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. @@ -154,16 +156,17 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%Dopen_u, oG%Dopen_v, oG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_metrics(oG) + call set_derived_metrics(oG, US) end subroutine copy_dyngrid_to_MOM_grid !> Copies information from an ocean_grid_type into a dynamic (shared) !! horizontal grid type. -subroutine copy_MOM_grid_to_dyngrid(oG, dG) +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 integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -298,7 +301,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%Dopen_u, dG%Dopen_v, dG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_dyn_horgrid(dG) + call set_derived_dyn_horgrid(dG, US) end subroutine copy_MOM_grid_to_dyngrid diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 6dce366ab5..a13003a826 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -174,8 +174,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then 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 + if (um(I,j,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i+1,j) + else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') @@ -505,8 +505,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then 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 + if (vm(i,J,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j+1) + else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index dd9e1b3bb4..74e5e41a09 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -947,7 +947,7 @@ 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%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*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 @@ -965,7 +965,7 @@ 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) = GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*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 @@ -981,13 +981,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & US%s_to_T*(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) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*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 @@ -1009,13 +1009,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & US%s_to_T*(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) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*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 @@ -1033,7 +1033,7 @@ 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) = GV%H_to_m * (0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * US%L_to_m**2*US%m_to_L**2*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 @@ -1051,7 +1051,7 @@ 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) = GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*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 @@ -1073,7 +1073,7 @@ 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_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*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 diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 73dc411fa5..c30dd3d52b 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -713,9 +713,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) @@ -723,9 +723,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 0a83ef983e..9bee061016 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -7,6 +7,7 @@ module MOM_dyn_horgrid use MOM_hor_index, only : hor_index_type use MOM_domains, only : MOM_domain_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -74,7 +75,7 @@ module MOM_dyn_horgrid IdxT, & !< 1/dxT [m-1]. dyT, & !< dyT is delta y at h points [m]. IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. + areaT, & !< The area of an h-cell [L-2 ~> m-2]. IareaT !< 1/areaT [m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward @@ -92,7 +93,7 @@ module MOM_dyn_horgrid dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. real, allocatable, dimension(:,:) :: & @@ -104,7 +105,7 @@ module MOM_dyn_horgrid dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. real, allocatable, dimension(:,:) :: & @@ -115,7 +116,7 @@ module MOM_dyn_horgrid IdxBu, & !< 1/dxBu [m-1]. dyBu, & !< dyBu is delta y at q points [m]. IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] + areaBu, & !< areaBu is the area of a q-cell [L-2 ~> m-2] IareaBu !< IareaBu = 1/areaBu [m-2]. real, pointer, dimension(:) :: gridLatT => NULL() @@ -153,7 +154,7 @@ module MOM_dyn_horgrid df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2] @@ -312,12 +313,15 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) end subroutine rescale_dyn_horgrid_bathymetry !> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics. -subroutine set_derived_dyn_horgrid(G) +subroutine set_derived_dyn_horgrid(G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + 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] 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -327,7 +331,7 @@ subroutine set_derived_dyn_horgrid(G) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -352,7 +356,7 @@ subroutine set_derived_dyn_horgrid(G) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) + G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_dyn_horgrid diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a753f273aa..271ff5cb4b 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -652,7 +652,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) - call add_shelf_flux(G, CS, state, fluxes) + call add_shelf_flux(G, US, CS, state, fluxes) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities @@ -686,7 +686,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call disable_averaging(CS%diag) if (present(forces)) then - call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & + call add_shelf_forces(G, US, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & CS%override_shelf_movement)) endif @@ -750,8 +750,9 @@ end subroutine change_thickness_using_melt !> This subroutine adds the mechanical forcing fields and perhaps shelf areas, based on !! the ice state in ice_shelf_CS. -subroutine add_shelf_forces(G, CS, forces, do_shelf_area) +subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) 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(ice_shelf_CS), pointer :: CS !< This module's control structure. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. @@ -793,7 +794,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied - press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) + press_ice = (ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice @@ -830,8 +831,9 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) end subroutine add_shelf_forces !> This subroutine adds the ice shelf pressure to the fluxes type. -subroutine add_shelf_pressure(G, CS, fluxes) +subroutine add_shelf_pressure(G, US, CS, fluxes) 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(ice_shelf_CS), intent(in) :: CS !< This module's control structure. type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. @@ -844,7 +846,7 @@ subroutine add_shelf_pressure(G, CS, fluxes) call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") do j=js,je ; do i=is,ie - press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) + press_ice = (CS%ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice @@ -858,8 +860,9 @@ subroutine add_shelf_pressure(G, CS, fluxes) end subroutine add_shelf_pressure !> Updates surface fluxes that are influenced by sub-ice-shelf melting -subroutine add_shelf_flux(G, CS, state, fluxes) +subroutine add_shelf_flux(G, US, CS, state, fluxes) 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(ice_shelf_CS), pointer :: CS !< This module's control structure. type(surface), intent(inout) :: state!< Surface ocean state type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. @@ -903,7 +906,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ISS => CS%ISS - call add_shelf_pressure(G, CS, fluxes) + call add_shelf_pressure(G, US, CS, fluxes) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -942,7 +945,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) + fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif @@ -1396,7 +1399,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the Coriolis parameter, G%f, usually analytically. call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file, US) ! This copies grid elements, including bathyT and CoriolisBu from dG to CS%grid. - call copy_dyngrid_to_MOM_grid(dG, CS%grid) + call copy_dyngrid_to_MOM_grid(dG, CS%grid, US) call destroy_dyn_horgrid(dG) @@ -1519,9 +1522,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(forces)) & - call add_shelf_forces(G, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) + call add_shelf_forces(G, US, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) - if (present(fluxes)) call add_shelf_pressure(G, CS, fluxes) + if (present(fluxes)) call add_shelf_pressure(G, US, CS, fluxes) if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then ISS%water_flux(:,:) = 0.0 diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 71d9c4f90b..893bd87a75 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -124,9 +124,9 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) default="none") select case ( trim(config) ) case ("none") - case ("list") ; call reset_face_lengths_list(G, PF) - case ("file") ; call reset_face_lengths_file(G, PF) - case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config)) + case ("list") ; call reset_face_lengths_list(G, PF, US) + case ("file") ; call reset_face_lengths_file(G, PF, US) + case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config), US) case default ; call MOM_error(FATAL, "MOM_initialize_fixed: "// & "Unrecognized channel configuration "//trim(config)) end select diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 2dc74c144b..2867783c2a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -87,10 +87,10 @@ 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" select case (trim(config)) - case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file) - case ("cartesian"); call set_grid_metrics_cartesian(G, param_file) - case ("spherical"); call set_grid_metrics_spherical(G, param_file) - case ("mercator"); call set_grid_metrics_mercator(G, param_file) + case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) + case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) + case ("spherical"); call set_grid_metrics_spherical(G, param_file, US) + case ("mercator"); call set_grid_metrics_mercator(G, param_file, US) case ("file"); call MOM_error(FATAL, "MOM_grid_init: set_grid_metrics "//& 'GRID_CONFIG "file" is no longer a supported option. Use a '//& 'mosaic file ("mosaic") or one of the analytic forms instead.') @@ -100,10 +100,10 @@ subroutine set_grid_metrics(G, param_file, US) ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") - call set_derived_dyn_horgrid(G) + call set_derived_dyn_horgrid(G, US) call callTree_leave("set_derived_metrics()") - if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics',G) + if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics', G, US) call callTree_leave("set_grid_metrics()") end subroutine set_grid_metrics @@ -112,11 +112,14 @@ end subroutine set_grid_metrics !> grid_metrics_chksum performs a set of checksums on metrics on the grid for !! debugging. -subroutine grid_metrics_chksum(parent, G) - character(len=*), intent(in) :: parent !< A string identifying the caller +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 + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: halo + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L halo = min(G%ied-G%iec, G%jed-G%jec, 1) @@ -146,8 +149,8 @@ subroutine grid_metrics_chksum(parent, G) call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo) call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo) + 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%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -166,9 +169,10 @@ end subroutine grid_metrics_chksum ! ------------------------------------------------------------------------------ !> Sets the grid metrics from a mosaic file. -subroutine set_grid_metrics_from_mosaic(G, param_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 ! 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 @@ -186,6 +190,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) 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" integer :: err=0, ni, nj, global_indices(4) @@ -198,6 +203,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) 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.) @@ -415,17 +421,20 @@ end subroutine set_grid_metrics_from_mosaic !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_cartesian(G, param_file) +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 ! 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 in m. - real :: I_dx, I_dy ! Inverse grid spacings in m. + real :: dx_everywhere, dy_everywhere ! Grid spacings [m]. + real :: I_dx, I_dy ! Inverse grid spacings [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" @@ -436,6 +445,8 @@ subroutine set_grid_metrics_cartesian(G, param_file) 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, & @@ -512,14 +523,14 @@ subroutine set_grid_metrics_cartesian(G, param_file) 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 + G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*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) = 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 + G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -548,9 +559,10 @@ end subroutine set_grid_metrics_cartesian !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_spherical(G, param_file) +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 ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -559,6 +571,7 @@ subroutine set_grid_metrics_spherical(G, param_file) 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 @@ -568,6 +581,7 @@ subroutine set_grid_metrics_spherical(G, param_file) 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. @@ -684,9 +698,10 @@ end subroutine set_grid_metrics_spherical !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_mercator(G, param_file) +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 ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -706,6 +721,7 @@ subroutine set_grid_metrics_mercator(G, param_file) 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 @@ -724,6 +740,7 @@ subroutine set_grid_metrics_mercator(G, param_file) 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 @@ -857,7 +874,7 @@ subroutine set_grid_metrics_mercator(G, param_file) 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)) + G%IareaBu(I,J) = 1.0 / (m_to_L**2*G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -867,7 +884,7 @@ subroutine set_grid_metrics_mercator(G, param_file) 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)) + G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -903,7 +920,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) + G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) enddo ; enddo endif @@ -1227,6 +1244,7 @@ subroutine initialize_masks(G, PF, US) type(unit_scale_type), optional, 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 :: Dmin ! 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]. @@ -1235,6 +1253,8 @@ subroutine initialize_masks(G, PF, US) 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. "//& @@ -1291,13 +1311,13 @@ subroutine initialize_masks(G, PF, US) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) - G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) + G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) - G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) + G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(m_to_L**2*G%areaCv(i,J)) enddo ; enddo call callTree_leave("initialize_masks()") diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 419d71461c..218ee56353 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -623,6 +623,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 integer :: option = -1 @@ -637,6 +638,8 @@ subroutine reset_face_lengths_named(G, param_file, name, US) "Unrecognized channel configuration name "//trim(name)) end select + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + 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)) @@ -715,7 +718,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -729,7 +732,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -747,12 +750,14 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path + real :: m_to_L ! A unit conversion factor [L m-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 call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -780,7 +785,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -794,7 +799,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -818,6 +823,7 @@ subroutine reset_face_lengths_list(G, param_file, US) u_lat => NULL(), u_lon => NULL(), v_lat => NULL(), v_lon => NULL() real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] 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. @@ -833,6 +839,7 @@ subroutine reset_face_lengths_list(G, param_file, US) 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 call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -992,7 +999,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1021,7 +1028,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 27dde7f69d..74afd4868a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -222,8 +222,8 @@ subroutine init_oda(Time, G, GV, CS) dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) - call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV) - call copy_dyngrid_to_MOM_grid(dG, CS%Grid) + 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 CS%Grid%ke = CS%GV%ke CS%nk = CS%GV%ke diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 0923c33c59..003a84d2f4 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -237,7 +237,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + drag_rate_visc(i,j) = (0.25*US%m_to_L**2*G%IareaT(i,j) * & ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & G%areaCu(I,j)*drag_vel_u(I,j)) + & (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & @@ -381,9 +381,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - del2MEKE(i,j) = G%IareaT(i,j) * & + del2MEKE(i,j) = US%m_to_L**2*G%IareaT(i,j) * & ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) - ! del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & + ! del2MEKE(i,j) = (US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j)) * & ! ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) enddo ; enddo @@ -393,7 +393,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))))**2 + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & @@ -404,7 +404,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))))**2 + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & @@ -414,7 +414,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Store tendency arising from the bi-harmonic in del4MEKE !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - del4MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + del4MEKE(i,j) = (sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo @@ -432,7 +432,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(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)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))) + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here @@ -447,7 +447,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(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))) + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here @@ -476,7 +476,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0f620a1b39..f96dc7ae7f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -3,6 +3,7 @@ module MOM_hor_visc ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_checksums, only : hchksum, Bchksum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, CORNER, pass_vector @@ -29,6 +30,7 @@ module MOM_hor_visc type, public :: hor_visc_CS ; private 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. logical :: no_slip !< If true, no slip boundary conditions are used. !! Otherwise free slip boundary conditions are assumed. !! The implementation of the free slip boundary @@ -282,6 +284,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] + sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] vort_xy_q, & ! vertical vorticity at corner points [s-1] GME_coeff_q !< GME coeff. at q-points [m2 T-1 ~> m2 s-1] @@ -293,6 +296,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points [m4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] + sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [s-1] diss_rate, & ! MKE dissipated by parameterized shear production [m2 s-3] max_diss_rate, & ! maximum possible energy dissipated by lateral friction [m2 s-3] target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated @@ -365,6 +369,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah_h(:,:,:) = 0.0 Kh_h(:,:,:) = 0.0 + if (CS%debug) then + sh_xx_3d(:,:,:) = 0.0 ; sh_xy_3d(:,:,:) = 0.0 + Kh_q(:,:,:) = 0.0 ; Ah_q(:,:,:) = 0.0 + endif + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally apply_OBC = .true. @@ -746,7 +755,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -898,8 +907,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh + if ((CS%id_Kh_h>0) .or. find_FrictWork .or. CS%debug) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) + if (CS%debug) sh_xx_3d(i,j,k) = sh_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian @@ -940,7 +950,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif - if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah + if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & @@ -1064,8 +1074,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh + if (CS%id_Kh_q>0 .or. CS%debug) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) + if (CS%debug) sh_xy_3d(I,J,k) = sh_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -1109,7 +1120,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif - if (CS%id_Ah_q>0) Ah_q(I,J,k) = Ah + if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx(I,J) + dudy(I,J) ) @@ -1266,7 +1277,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, CS%DY2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & CS%DX2q(I,J) *str_xy(I,J))) * & - G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) + US%m_to_L**2*G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo if (apply_OBC) then @@ -1288,7 +1299,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, CS%DY2q(I,J) *str_xy(I,J)) - & G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & - G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) + US%m_to_L**2*G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo if (apply_OBC) then ! This is not the right boundary condition. If all the masking of tendencies are done @@ -1408,6 +1419,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_GME_coeff_h > 0) call post_data(CS%id_GME_coeff_h, GME_coeff_h, CS%diag) if (CS%id_GME_coeff_q > 0) call post_data(CS%id_GME_coeff_q, GME_coeff_q, CS%diag) + if (CS%debug) then + if (CS%Laplacian) then + call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0) + call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0) + endif + if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) + endif + if (CS%id_FrictWorkIntz > 0) then do j=js,je do i=is,ie ; FrictWorkIntz(i,j) = FrictWork(i,j,1) ; enddo @@ -1527,6 +1549,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) @@ -2012,9 +2036,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & (CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & - max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & (CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & - max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * Idt / denom @@ -2022,13 +2046,17 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & - max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & - max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo + if (CS%debug) then + call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + endif endif ! The biharmonic bounds should avoid overshoots when CS%bound_coef < 0.5, but @@ -2063,11 +2091,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) (CS%DY2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & - max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & (CS%DX2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & - max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*G%IareaCv(i,J-1)) ) ) CS%Ah_Max_xx(I,J) = 0.0 if (denom > 0.0) & CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * Idt / denom @@ -2078,15 +2106,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) (CS%DX2q(I,J) * & (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & - max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & (CS%DY2q(I,J) * & (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & - max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*G%IareaCv(i+1,J)) ) ) CS%Ah_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo + if (CS%debug) then + call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + endif endif ! Register fields for output from this module. diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fb35d5b45c..e3db9b90a6 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1052,7 +1052,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1063,7 +1063,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') @@ -1335,7 +1335,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1349,6 +1349,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1381,7 +1382,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt, G, j, ish, ieh, CS%vol_CFL) + dt, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo @@ -1392,7 +1393,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! test with old (take out later) !do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) + ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) !enddo ; enddo enddo ! a-loop @@ -1408,17 +1409,17 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging + ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(FATAL, "propagate_x: OutFlux>Available") ! endif !enddo - En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) + En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1432,6 +1433,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1465,14 +1467,14 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt, G, J, ish, ieh, CS%vol_CFL) + dt, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + !if ((En(i,j,a) + US%m_to_L**2*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), & ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a)) @@ -1482,7 +1484,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) ! test with old (take out later) !do j=jsh,jeh ; do i=ish,ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) + ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) !enddo ; enddo enddo ! a-loop @@ -1498,17 +1500,17 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.) ! endif !enddo - En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) + En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) +subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes @@ -1519,6 +1521,7 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) !! [J m-2]. real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1533,13 +1536,13 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & @@ -1551,7 +1554,7 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) +subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the @@ -1562,6 +1565,7 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) !! reconstruction [J m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1576,13 +1580,13 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 5df2b2d166..286ac580c4 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -507,7 +507,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -743,7 +743,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 2b62a388fb..cf19c54e93 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -484,7 +484,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt * US%m_to_L**2*G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -1269,7 +1269,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 if (find_work) then ; do j=js,je ; do i=is,ie ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. - Work_h = 0.5 * G%IareaT(i,j) * & + Work_h = 0.5 * US%m_to_L**2*G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) 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) + & @@ -1526,7 +1526,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((G%IareaT(i+1,j) + G%IareaT(i,j))*G%dy_Cu(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1551,7 +1551,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((G%IareaT(i,j+1) + G%IareaT(i,j))*G%dx_Cv(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom @@ -1684,14 +1684,14 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) -! if (abs(uh_here(k))*min(G%IareaT(i,j), G%IareaT(i+1,j)) > & +! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & ! "Corrective u-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(k)) - & -! (h(i+1,j,k) + 4.0*dt*G%IareaT(i+1,j)*uh_here(k))) * & +! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(k)) - & +! (h(i+1,j,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i+1,j)*uh_here(k))) * & ! (h(i,j,k) - h(i+1,j,k)) < 0.0) then ! call MOM_error(WARNING, & ! "Corrective u-transport is too large.", .true.) @@ -1704,14 +1704,14 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) ! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) -! if (abs(uh_here(K))*min(G%IareaT(i,j), G%IareaT(i,j+1)) > & +! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(K)) - & -! (h(i,j+1,k) + 4.0*dt*G%IareaT(i,j+1)*uh_here(K))) * & +! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(K)) - & +! (h(i,j+1,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i,j+1)*uh_here(K))) * & ! (h(i,j,k) - h(i,j+1,k)) < 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is too large.", .true.) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ca6185aa5d..88714fb1f6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -551,9 +551,10 @@ end subroutine triDiagTS !> This subroutine calculates u_h and v_h (velocities at thickness !! points), optionally using the entrainment amounts passed in as arguments. -subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) +subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -599,7 +600,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) do i=is,ie s = G%areaCu(I-1,j)+G%areaCu(I,j) if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) + Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) a_w(i) = G%areaCu(I-1,j)*Idenom a_e(i) = G%areaCu(I,j)*Idenom else @@ -608,7 +609,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) s = G%areaCv(i,J-1)+G%areaCv(i,J) if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) + Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) a_s(i) = G%areaCv(i,J-1)*Idenom a_n(i) = G%areaCv(i,J)*Idenom else diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e0df2f3c3f..a0def608fd 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -595,13 +595,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -842,7 +842,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) endif - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) @@ -1380,13 +1380,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -1572,7 +1572,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) endif - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) @@ -2077,7 +2077,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Monin-Obukhov depth or minimum mixed layer depth. ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then @@ -2117,13 +2117,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eaml, ebml) if (CS%debug) then call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -2469,7 +2469,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits the buffer layer into two isopycnal layers. - call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) + call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index dee3422a7a..8d2dd41257 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1262,7 +1262,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & US%m_to_Z**2 * US%T_to_s**2 * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & @@ -1444,7 +1444,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & US%m_to_Z**2 * US%T_to_s**2 * & - 0.5*CS%BBL_effic * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1759,7 +1759,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) endif ; enddo do i=is,ie - visc%ustar_BBL(i,j) = sqrt(0.5*G%IareaT(i,j) * & + visc%ustar_BBL(i,j) = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j) * & ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & @@ -1768,7 +1768,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) enddo enddo !$OMP end parallel diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4c1de70024..c63748c97e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1395,9 +1395,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,10 +1421,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif @@ -1441,10 +1441,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif @@ -1480,9 +1480,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,10 +1506,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif @@ -1526,10 +1526,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index deeb9529ee..f1f6191c74 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -22,6 +22,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : extract_member_remapping_CS, build_reconstructions_1d use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -407,7 +408,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) end subroutine neutral_diffusion_calc_coeffs !> Update tracer concentration due to neutral diffusion; layer thickness unchanged by this update. -subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) +subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) 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_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -416,6 +417,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables @@ -495,12 +497,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) enddo do k = 1, GV%ke tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & - ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + ( US%m_to_L**2*G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) enddo if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then do k = 1, GV%ke - tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt + tendency(i,j,k) = dTracer(k) * US%m_to_L**2*G%IareaT(i,j) * Idt enddo endif diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index ced1916a7a..969d237ec0 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -643,7 +643,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & - Idt * US%L_to_m**2*G%IareaT(i,j) + Idt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) endif ; enddo endif @@ -985,7 +985,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & - US%L_to_m**2*G%IareaT(i,j) + US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) endif ; enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 261d8d1315..29b5cde89a 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -23,6 +23,7 @@ module MOM_tracer_hor_diff use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_neutral_diffusion, only : neutral_diffusion_calc_coeffs, neutral_diffusion use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -94,7 +95,7 @@ module MOM_tracer_hor_diff !! using the diffusivity in CS%KhTr, or using space-dependent diffusivity. !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. -subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) +subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -103,6 +104,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(tracer_hor_diff_CS), pointer :: CS !< module control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_registry_type), pointer :: Reg !< registered tracers type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields, including potential temp and @@ -342,7 +344,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla max_CFL = 0.0 do j=js,je ; do i=is,ie CFL(i,j) = 2.0*((khdt_x(I-1,j) + khdt_x(I,j)) + & - (khdt_y(i,J-1) + khdt_y(i,J))) * G%IareaT(i,j) + (khdt_y(i,J-1) + khdt_y(i,J))) * US%m_to_L**2*G%IareaT(i,j) if (max_CFL < CFL(i,j)) max_CFL = CFL(i,j) enddo ; enddo call cpu_clock_begin(id_clock_sync) @@ -401,7 +403,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (itt>1) then ! Update halos for subsequent iterations call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) endif - call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, CS%neutral_diffusion_CSp) + call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, US, CS%neutral_diffusion_CSp) enddo ! itt else ! following if not using neutral diffusion, but instead along-surface diffusion @@ -432,7 +434,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla enddo do i=is,ie - Ihdxdy(i,j) = G%IareaT(i,j) / (h(i,j,k)+h_neglect) + Ihdxdy(i,j) = US%m_to_L**2*G%IareaT(i,j) / (h(i,j,k)+h_neglect) enddo enddo diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 3ba4f0c376..cbfce62f39 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -20,6 +20,7 @@ module MOM_controlled_forcing 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 @@ -78,7 +79,7 @@ module MOM_controlled_forcing !> This subroutine calls any of the other subroutines in this file !! that are needed to specify the current surface forcing fields. subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_precip, & - day_start, dt, G, CS) + 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]. @@ -96,6 +97,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec 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. @@ -146,12 +148,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) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*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)) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*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) @@ -330,13 +332,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)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*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)) / & (0.5*(CS%avg_SSS(i,j,m_u2) + CS%avg_SSS(i,j,m_u1))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*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 @@ -355,13 +357,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_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)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*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)) / & (0.5*(CS%avg_SSS(i,j,m_u3) + CS%avg_SSS(i,j,m_u2))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*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 From 0772696675568881fd57c3d36f88f8a207e7e4b6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Aug 2019 17:16:19 -0400 Subject: [PATCH 017/104] Simplified some G%Iarea unit-scaling expressions Simplified some unit-scaling expressions for G%Iarea arrays. With these changes, all lines are one again shorter than 120 characters. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 18 ++++++------ src/core/MOM_continuity_PPM.F90 | 28 +++++++++---------- src/diagnostics/MOM_diagnostics.F90 | 18 ++++++------ .../lateral/MOM_hor_visc.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 4 +-- 5 files changed, 35 insertions(+), 35 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 4247a2aa5c..d98022204c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1392,7 +1392,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! This estimate of the maximum stable time step is pretty accurate for ! gravity waves, but it is a conservative estimate since it ignores the ! stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (G%IareaT(i,j) * & ((gtot_E(i,j) * (Datu(I,j)*US%L_to_m*G%IdxCu(I,j)) + & gtot_W(i,j) * (Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j))) + & (gtot_N(i,j) * (Datv(i,J)*US%L_to_m*G%IdyCv(i,J)) + & @@ -1400,7 +1400,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) H_eff_dx2 = max(H_min_dyn * ((US%L_to_m*G%IdxT(i,j))**2 + (US%L_to_m*G%IdyT(i,j))**2), & - US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + G%IareaT(i,j) * & ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & @@ -1544,19 +1544,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. ubt(I,j) = (-0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. ubt(I,j) = (0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. vbt(i,J) = (-0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. vbt(i,J) = (0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) endif @@ -2350,7 +2350,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) do j=js,je ; do i=is,ie ! This is pretty accurate for gravity waves, but it is a conservative ! estimate since it ignores the stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & ((gtot_E(i,j)*Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & (gtot_N(i,j)*Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & @@ -4078,7 +4078,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0 do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%IareaT(i,j) = US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) + CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo @@ -4344,7 +4344,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) do j=js,je ; do i=is,ie - CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & + CS%eta_cor_bound(i,j) = GV%m_to_H * G%IareaT(i,j) * 0.1 * CS%maxvel * & ((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1))) enddo ; enddo endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4117a2b5a9..e9e55d9c4c 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -154,7 +154,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -169,7 +169,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -185,7 +185,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) @@ -197,7 +197,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -539,14 +539,14 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & @@ -614,13 +614,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) @@ -779,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1337,7 +1337,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & @@ -1345,7 +1345,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i) * dt_in_T * US%L_to_m*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) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & @@ -1414,14 +1414,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) @@ -1579,7 +1579,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 74e5e41a09..9e56e700a7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -947,7 +947,7 @@ 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%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%dKE_dt(i,j,k) = GV%H_to_m * (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 @@ -965,7 +965,7 @@ 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) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%PE_to_KE(i,j,k) = GV%H_to_m * 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 @@ -981,13 +981,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & US%s_to_T*(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) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_CorAdv(i,j,k) = GV%H_to_m * (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 @@ -1009,13 +1009,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & US%s_to_T*(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) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_adv(i,j,k) = GV%H_to_m * (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 @@ -1033,7 +1033,7 @@ 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) = GV%H_to_m * (0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_visc(i,j,k) = GV%H_to_m * (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 @@ -1051,7 +1051,7 @@ 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) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_horvisc(i,j,k) = GV%H_to_m * 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 @@ -1073,7 +1073,7 @@ 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_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 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 diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f96dc7ae7f..509ce21959 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1427,7 +1427,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0) endif if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%s_to_T) - if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) endif if (CS%id_FrictWorkIntz > 0) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 969d237ec0..af5cb3495d 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -643,7 +643,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & - Idt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) + Idt * G%IareaT(i,j) endif ; enddo endif @@ -985,7 +985,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & - US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) + G%IareaT(i,j) endif ; enddo endif From 9b25e9e90fdddb86f53f6309f2b0f4438439e0a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 06:00:29 -0400 Subject: [PATCH 018/104] +Add G%US and rescale the units of G%area arrays Rescaled the units of the various G%area arrays throughout the MOM6 code to units of [L2] and added a new pointer (G%US) to a unit_scale_type to the MOM_grid_type. In addition several new unit_scale_type arguments were added to subroutines throughout the code. All answers are bitwise identical, but interfaces and a public type have changed. --- .../coupled_driver/MOM_surface_forcing.F90 | 15 +++---- config_src/coupled_driver/ocean_model_MOM.F90 | 17 ++++---- config_src/mct_driver/MOM_ocean_model.F90 | 13 +++--- config_src/mct_driver/MOM_surface_forcing.F90 | 15 +++---- config_src/mct_driver/ocn_comp_mct.F90 | 8 ++-- config_src/nuopc_driver/MOM_ocean_model.F90 | 15 +++---- .../nuopc_driver/MOM_surface_forcing.F90 | 15 +++---- config_src/nuopc_driver/mom_cap.F90 | 2 +- src/core/MOM.F90 | 6 +-- src/core/MOM_CoriolisAdv.F90 | 18 ++++----- src/core/MOM_barotropic.F90 | 8 ++-- src/core/MOM_checksum_packages.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 40 +++++++++---------- src/core/MOM_grid.F90 | 14 +++++-- src/core/MOM_open_boundary.F90 | 19 ++++----- src/diagnostics/MOM_diagnostics.F90 | 14 +++---- src/diagnostics/MOM_sum_output.F90 | 28 ++++++------- src/framework/MOM_diag_mediator.F90 | 6 +-- src/framework/MOM_diag_remap.F90 | 18 ++++----- src/framework/MOM_dyn_horgrid.F90 | 8 ++-- src/framework/MOM_spatial_means.F90 | 16 ++++---- src/ice_shelf/MOM_ice_shelf.F90 | 18 ++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 32 ++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 8 ++-- src/ice_shelf/MOM_marine_ice.F90 | 12 +++--- src/ice_shelf/user_shelf_init.F90 | 4 +- .../MOM_fixed_initialization.F90 | 4 +- src/initialization/MOM_grid_initialize.F90 | 40 ++++++++++--------- .../MOM_shared_initialization.F90 | 24 +++++------ .../MOM_state_initialization.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 16 ++++---- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 12 +++--- .../vertical/MOM_set_diffusivity.F90 | 32 +++++++-------- .../vertical/MOM_vert_friction.F90 | 16 ++++---- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 4 +- src/tracer/MOM_offline_aux.F90 | 22 +++++----- src/tracer/MOM_offline_main.F90 | 20 +++++----- src/tracer/MOM_tracer_advect.F90 | 28 ++++++------- src/tracer/MOM_tracer_hor_diff.F90 | 18 ++++----- src/tracer/MOM_tracer_registry.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 6 +-- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- 51 files changed, 333 insertions(+), 314 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 1dfe0662a4..9241e69ebd 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -327,7 +327,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -359,7 +359,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -380,7 +380,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -512,7 +512,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable ! salinity or the sea-ice is completely fresh. @@ -520,15 +520,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! is constant. ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & + net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * US%L_to_m**2*G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo 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) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 3aa63ab733..96366a78e9 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -393,7 +393,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -659,9 +659,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif ! Translate state into Ocean. -! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & +! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + 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) @@ -817,7 +817,7 @@ end subroutine initialize_ocean_public_type !! 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. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +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. type(ocean_public_type), & @@ -825,6 +825,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! 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]. @@ -871,12 +872,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -938,7 +939,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1036,7 +1037,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 0d5c9a7b87..c146dc5894 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -391,7 +391,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i if (present(gas_fields_ocn)) then call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif call close_param_file(param_file) @@ -575,7 +575,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call callTree_leave("update_ocean_model()") @@ -760,10 +760,11 @@ end subroutine initialize_ocean_public_type !> Translates the coupler's ocean_data_type into MOM6's surface state variable. !! This may eventually be folded into the MOM6's code that calculates the !! surface state in the first place. -subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: state type(ocean_public_type), target, intent(inout) :: Ocean_sfc !< Ocean surface state 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(:,:) !< Atmospheric pressure. real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric !! pressure to z? @@ -810,7 +811,7 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) if (present(patm)) & Ocean_sfc%sea_lev(i,j) = Ocean_sfc%sea_lev(i,j) + patm(i,j) * press_to_z if (associated(state%frazil)) & @@ -869,7 +870,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc ! @@ -968,7 +969,7 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 9653a27a4b..389f504c73 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -317,7 +317,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -349,7 +349,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -370,7 +370,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -501,7 +501,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable ! salinity or the sea-ice is completely fresh. @@ -511,16 +511,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & + net_FW(i,j) = net_FW(i,j) + US%L_to_m**2*G%areaT(i,j) * & (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo; enddo 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) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5698335b6f..215b0f6ac1 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -638,7 +638,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) integer, pointer :: idata(:) integer :: i,j,k real(kind=SHR_REAL_R8), pointer :: data(:) - real(kind=SHR_REAL_R8) :: m2_to_rad2 + real(kind=SHR_REAL_R8) :: L2_to_rad2 type(ocean_grid_type), pointer :: grid => NULL() ! A pointer to a grid structure grid => glb%grid ! for convenience @@ -683,11 +683,11 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - m2_to_rad2 = 1./grid%Rad_Earth**2 + L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex - data(k) = grid%AreaT(i,j) * m2_to_rad2 + data(k) = grid%AreaT(i,j) * L2_to_rad2 enddo enddo call mct_gGrid_importRattr(dom_ocn,"area",data,lsize) @@ -745,7 +745,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 05232b8d0c..f44f0a419d 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -409,7 +409,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -672,7 +672,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") @@ -846,7 +846,7 @@ end subroutine initialize_ocean_public_type !! 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. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +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. type(ocean_public_type), & @@ -854,6 +854,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! 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, in Pa. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. @@ -900,12 +901,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -979,7 +980,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1077,7 +1078,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index d91a9bfdac..d4de732c7c 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -337,7 +337,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -369,7 +369,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -390,7 +390,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -529,7 +529,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable @@ -540,15 +540,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & + net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * US%L_to_m**2*G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo 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) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 3992aae530..46db11ecab 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1560,7 +1560,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + dataPtr_area(i1,j1) = ocean_grid%US%L_to_m**2 * ocean_grid%areaT(ig,jg) endif enddo enddo diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b667bcfae8..bde797c654 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2134,7 +2134,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! (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) - call MOM_grid_init(G, param_file, HI, bathymetry_at_vel=bathy_at_vel) + 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) @@ -2163,7 +2163,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call clone_MOM_domain(G%Domain, dG%Domain) call clone_MOM_domain(G%Domain, CS%G%Domain) - call MOM_grid_init(CS%G, param_file) + 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) @@ -2208,7 +2208,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 7f901f213d..124ad3a166 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -224,7 +224,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 - Area_h(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + Area_h(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo if (associated(OBC)) then ; do n=1,OBC%number_of_segments if (.not. OBC%segment(n)%on_pe) cycle @@ -863,10 +863,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & - +G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & - +( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & - +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & + KE(i,j) = ( ( US%L_to_m**2*G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & + +US%L_to_m**2*G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & + +( US%L_to_m**2*G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & + +US%L_to_m**2*G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & )*0.25*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then @@ -883,10 +883,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! The following discretization of KE is based on the one-dimensinal 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) - um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) - vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) - vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) + up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*US%L_to_m**2*G%areaCu(I-1,j) + um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*US%L_to_m**2*G%areaCu( I ,j) + vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*US%L_to_m**2*G%areaCv(i,J-1) + vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*US%L_to_m**2*G%areaCv(i, J ) KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index d98022204c..28d6913051 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1546,19 +1546,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do j=jsv,jev ; do I=isv-1,iev if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (-0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) + ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (-0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) + vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) endif enddo ; enddo endif diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 195b4061d7..68ad6d3888 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -252,14 +252,14 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi ! First collect local stats Area = 0. ; Vol = 0. do j = js, je ; do i = is, ie - Area = Area + G%areaT(i,j) + Area = Area + G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo T%minimum = 1.E34 ; T%maximum = -1.E34 ; T%average = 0. S%minimum = 1.E34 ; S%maximum = -1.E34 ; S%average = 0. h_minimum = 1.E34 do k = 1, nz ; do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then - dV = G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV + dV = G%US%L_to_m**2*G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV if (do_TS .and. h(i,j,k)>0.) then T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) T%average = T%average + dV*Temp(i,j,k) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index e9e55d9c4c..e03e82e265 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -335,8 +335,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm @@ -350,8 +350,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) @@ -365,8 +365,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & @@ -379,8 +379,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & @@ -391,8 +391,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) @@ -1134,8 +1134,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm @@ -1150,8 +1150,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & @@ -1164,8 +1164,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) @@ -1177,8 +1177,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) @@ -1188,8 +1188,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 0679c23efa..04da9abfb8 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -160,6 +160,9 @@ module MOM_grid real :: areaT_global !< Global sum of h-cell area [m2] real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2]. + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type + + ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE type(hor_index_type), pointer :: Block(:) => NULL() !< Index ranges for each block @@ -177,9 +180,10 @@ module MOM_grid contains !> MOM_grid_init initializes the ocean grid array sizes and grid memory. -subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) +subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_vel) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type type(hor_index_type), & optional, intent(in) :: HI !< A hor_index_type for array extents logical, optional, intent(in) :: global_indexing !< If true use global index @@ -215,6 +219,8 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) "in the y-direction on each processor (for openmp).", default=1, & layoutParam=.true.) + if (present(US)) then ; if (associated(US)) G%US => US ; endif + if (present(HI)) then G%HI = HI @@ -419,7 +425,7 @@ subroutine set_derived_metrics(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -443,8 +449,8 @@ subroutine set_derived_metrics(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 70f3508206..7935d3a529 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1410,11 +1410,12 @@ end subroutine open_boundary_impose_normal_slope !> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed. !! Also adjust u- and v-point cell area on specified open boundaries and mask all !! points outside open boundaries. -subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) +subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [m2] + type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [L2 ~> m2] ! Local variables integer :: i, j, n type(OBC_segment_type), pointer :: segment => NULL() @@ -1473,9 +1474,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed if (segment%direction == OBC_DIRECTION_E) then - areaCu(I,j) = G%areaT(i,j) - else ! West - areaCu(I,j) = G%areaT(i+1,j) + areaCu(I,j) = G%areaT(i,j) ! Both of these are in [L2] + else ! West + areaCu(I,j) = G%areaT(i+1,j) ! Both of these are in [L2] endif enddo else @@ -1483,9 +1484,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied if (segment%direction == OBC_DIRECTION_S) then - areaCv(i,J) = G%areaT(i,j+1) + areaCv(i,J) = G%areaT(i,j+1) ! Both of these are in [L2] else ! North - areaCu(i,J) = G%areaT(i,j) + areaCu(i,J) = G%areaT(i,j) ! Both of these are in [L2] endif enddo endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9e56e700a7..0e099cb079 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -320,7 +320,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_masso > 0) then work_2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * G%areaT(i,j) + work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo masso = reproducing_sum(work_2d) call post_data(CS%id_masso, masso, CS%diag) @@ -339,7 +339,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq do k=1,nz; do j=js,je ; do i=is,ie - work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j) + work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -372,7 +372,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, work_3d, CS%diag) if (CS%id_volcello > 0) then do k=1,nz; do j=js,je ; do i=is,ie ! volcello = dp/(rho*g)*area for non-Boussinesq - work_3d(i,j,k) = G%areaT(i,j) * work_3d(i,j,k) + work_3d(i,j,k) = US%L_to_m**2*G%areaT(i,j) * work_3d(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -1883,7 +1883,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%geoLonCu, diag, .true.) id = register_static_field('ocean_model', 'area_t', diag%axesT1, & - 'Surface area of tracer (T) cells', 'm2', & + 'Surface area of tracer (T) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') @@ -1893,21 +1893,21 @@ subroutine write_static_fields(G, GV, US, tv, diag) endif id = register_static_field('ocean_model', 'area_u', diag%axesCu1, & - 'Surface area of x-direction flow (U) cells', 'm2', & + 'Surface area of x-direction flow (U) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCu, diag, .true.) id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & - 'Surface area of y-direction flow (V) cells', 'm2', & + 'Surface area of y-direction flow (V) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCv, diag, .true.) id = register_static_field('ocean_model', 'area_q', diag%axesB1, & - 'Surface area of B-grid flow (Q) cells', 'm2', & + 'Surface area of B-grid flow (Q) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index c30dd3d52b..5a6041def3 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -483,7 +483,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ "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) + areaTm(i,j) = G%mask2dT(i,j)*US%L_to_m**2*G%areaT(i,j) enddo ; enddo if (GV%Boussinesq) then @@ -972,7 +972,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) if (associated(fluxes%evap)) then if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - FW_in(i,j) = dt*G%areaT(i,j)*(fluxes%evap(i,j) + & + FW_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(fluxes%evap(i,j) + & (((fluxes%lprec(i,j) + fluxes%vprec(i,j)) + fluxes%lrunoff(i,j)) + & (fluxes%fprec(i,j) + fluxes%frunoff(i,j)))) enddo ; enddo @@ -983,25 +983,25 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%seaice_melt(i,j) + FW_in(i,j) = FW_in(i,j) + dt * G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt(i,j) enddo ; enddo ; endif salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * (fluxes%sw(i,j) + & + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & ! + (fluxes%heat_content_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1011,7 +1011,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! smg: old code if (associated(sfc_state%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * sfc_state%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * sfc_state%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie @@ -1023,23 +1023,23 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. if (associated(sfc_state%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * & + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * & sfc_state%internal_heat(i,j) enddo ; enddo endif if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + G%areaT(i,j) * sfc_state%frazil(i,j) + heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * sfc_state%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j)*fluxes%heat_added(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) enddo ; enddo ; endif ! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) - G%areaT(i,j) * sfc_state%sw_lost(i,j) +! heat_in(i,j) = heat_in(i,j) - G%US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. - salt_in(i,j) = dt*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) + salt_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif @@ -1128,7 +1128,7 @@ subroutine create_depth_list(G, CS) list_pos = (j_global-1)*G%Domain%niglobal + i_global Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1488,7 +1488,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%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') mpp_chksum(field(:,:)) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9320f503b5..4a8091752a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3868,7 +3868,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -3896,7 +3896,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -4037,7 +4037,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 6640a4b15a..8f1d309b06 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -673,14 +673,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = i - G%isdB + 1 height = 0.5 * (h(i,j,k) + h(i+1,j,k)) - volume(I,j,k) = G%areaCu(I,j) * height * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * height * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo endif @@ -689,7 +689,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo enddo @@ -701,14 +701,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo else ! Intensive do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 height = 0.5 * (h(i,j,k) + h(i,j+1,k)) - volume(i,J,k) = G%areaCv(i,J) * height * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * height * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo endif @@ -717,7 +717,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo enddo @@ -729,7 +729,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do i=G%isc, G%iec if (h(i,j,k) > 0.) then - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) else volume(i,j,k) = 0. @@ -738,7 +738,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo endif @@ -746,7 +746,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, else ! Interface do k=1,nz do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 9bee061016..f46b8cb875 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -319,9 +319,11 @@ subroutine set_derived_dyn_horgrid(G, US) ! 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 @@ -331,7 +333,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -355,8 +357,8 @@ subroutine set_derived_dyn_horgrid(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_dyn_horgrid diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 00f1474879..f7084ee7ea 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -36,7 +36,7 @@ function global_area_mean(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_mean = reproducing_sum( tmpForSumming ) * G%IareaT_global @@ -54,7 +54,7 @@ function global_area_integral(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_integral = reproducing_sum( tmpForSumming ) @@ -77,7 +77,7 @@ function global_layer_mean(var, h, G, GV) tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k) enddo ; enddo ; enddo @@ -108,7 +108,7 @@ function global_volume_mean(var, h, G, GV) tmpForSumming(:,:) = 0. ; sum_weight(:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight_here = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight_here = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * weight_here sum_weight(i,j) = sum_weight(i,j) + weight_here enddo ; enddo ; enddo @@ -141,12 +141,12 @@ function global_mass_integral(h, G, GV, var, on_PE_only) if (present(var)) then do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo else do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo endif global_sum = .true. ; if (present(on_PE_only)) global_sum = .not.on_PE_only @@ -325,9 +325,9 @@ subroutine adjust_area_mean_to_zero(array, G, scaling) do j=G%jsc,G%jec ; do i=G%isc,G%iec posVals(i,j) = max(0., array(i,j)) - areaXposVals(i,j) = G%areaT(i,j) * posVals(i,j) + areaXposVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * posVals(i,j) negVals(i,j) = min(0., array(i,j)) - areaXnegVals(i,j) = G%areaT(i,j) * negVals(i,j) + areaXnegVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * negVals(i,j) enddo ; enddo areaIntPosVals = reproducing_sum( areaXposVals ) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 271ff5cb4b..d07fe42676 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -781,13 +781,13 @@ subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i+1,j)) / & - (G%areaT(i,j) + G%areaT(i+1,j))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i+1,j))) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i,j+1)) / & - (G%areaT(i,j) + G%areaT(i,j+1))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i,j+1))) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif @@ -996,7 +996,7 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) !### These hard-coded limits need to be corrected. They are inappropriate here. if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - sponge_area = sponge_area + G%areaT(i,j) + sponge_area = sponge_area + US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo @@ -1124,12 +1124,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call MOM_domains_init(CS%grid%domain, param_file, min_halo=wd_halos, symmetric=GRID_SYM_) ! call diag_mediator_init(CS%grid,param_file,CS%diag) ! this needs to be fixed - will probably break when not using coupled driver 0 - call MOM_grid_init(CS%grid, param_file) + call MOM_grid_init(CS%grid, param_file, CS%US) call create_dyn_horgrid(dG, CS%grid%HI) call clone_MOM_domain(CS%grid%Domain, dG%Domain) - call set_grid_metrics(dG, param_file) + call set_grid_metrics(dG, param_file, CS%US) ! call set_diag_mediator_grid(CS%grid, CS%diag) ! The ocean grid possibly uses different symmetry. @@ -1508,13 +1508,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_end(id_clock_pass) do j=jsd,jed ; do i=isd,ied - if (ISS%area_shelf_h(i,j) > G%areaT(i,j)) then + if (ISS%area_shelf_h(i,j) > US%L_to_m**2*G%areaT(i,j)) then call MOM_error(WARNING,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.") - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (G%areaT(i,j)) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; endif if (CS%debug) then @@ -1687,7 +1687,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) ISS%area_shelf_h(i,j) = 0.0 ISS%hmask(i,j) = 0. if (ISS%mass_shelf(i,j) > 0.0) then - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) ISS%h_shelf(i,j) = ISS%mass_shelf(i,j) / CS%rho_ice ISS%hmask(i,j) = 1. endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 415ae3d813..8d7adf9951 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -580,14 +580,16 @@ function ice_time_step_CFL(CS, ISS, G) real :: local_u_max, local_v_max integer :: i, j - min_ratio = 1.0e16 ! This is just an arbitrary large value. + min_ratio = 1.0e16 ! This is just an arbitrary large nondiensional value. do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) - ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + ! Here the hard-coded 1e-12 has units of m s-1. Consider revising. + ratio = G%US%L_to_m**2*min(G%areaT(i,j) / (local_u_max + 1.0e-12), & + G%areaT(i,j) / (local_v_max + 1.0e-12)) min_ratio = min(min_ratio, ratio) endif ; enddo ; enddo ! i- and j- loops @@ -896,7 +898,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 @@ -955,7 +957,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1120,7 +1122,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1191,7 +1193,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -1483,7 +1485,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -1712,7 +1714,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -1952,7 +1954,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) enddo if (n_flux > 0) then - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_reference = h_reference / real(n_flux) partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux @@ -2142,7 +2144,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) sy = 0 dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -2673,7 +2675,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j) *1000 @@ -2866,7 +2868,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j)*1000 @@ -3022,7 +3024,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) @@ -3679,7 +3681,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -3907,7 +3909,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index bc00ac61a9..2ace1b2137 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -128,11 +128,11 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! update thickness mask - if (area_shelf_h (i,j) >= G%areaT(i,j)) then + if (area_shelf_h (i,j) >= US%L_to_m**2*G%areaT(i,j)) then hmask(i,j) = 1. elseif (area_shelf_h (i,j) == 0.0) then hmask(i,j) = 0. - elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then + elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= US%L_to_m**2*G%areaT(i,j))) then hmask(i,j) = 2. else call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") @@ -206,11 +206,11 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 5505154d23..16b543387d 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -80,18 +80,18 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & do j=js,je ; do I=is-1,ie if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & - (G%areaT(i,j) + G%areaT(i+1,j)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%US%L_to_m**2*G%areaT(i+1,j))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i+1,j)) ) forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & - (G%areaT(i,j) + G%areaT(i,j+1)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%US%L_to_m**2*G%areaT(i,j+1))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i,j+1)) ) forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) enddo ; enddo diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index ec2787bae3..c0c7c96a59 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -168,11 +168,11 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 893bd87a75..0ee72e9bb0 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -78,7 +78,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) inputdir = slasher(inputdir) ! Set up the parameters of the physical domain (i.e. the grid), G - call set_grid_metrics(G, PF) + call set_grid_metrics(G, PF, US) ! Set up the bottom depth, G%bathyT either analytically or from file ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, @@ -99,7 +99,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call initialize_masks(G, PF, US) ! Make OBC mask consistent with land mask - call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv) + call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv, US) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1, scale=US%Z_to_m) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 2867783c2a..5162c1303f 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -118,8 +118,10 @@ subroutine grid_metrics_chksum(parent, G, US) type(unit_scale_type), optional, 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) @@ -146,8 +148,8 @@ subroutine grid_metrics_chksum(parent, G, US) call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', & G%IdxBu, G%IdyBu, G%HI, haloshift=halo) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo) + 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%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) @@ -361,7 +363,7 @@ 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) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = areaT(i,j) + G%dxT(i,j) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = 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) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) @@ -370,7 +372,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = areaBu(I,J) + G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -523,14 +525,14 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = L_to_m**2*I_dx * 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 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) = 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) = L_to_m**2*I_dx * 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 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -647,7 +649,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di ! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 - G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) + G%areaBu(I,J) = m_to_L**2 * G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -684,8 +686,8 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! 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) = Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) - G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) +! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) + G%areaT(i,j) = m_to_L**2 * G%dxT(i,j) * G%dyT(i,j) enddo ; enddo call callTree_leave("set_grid_metrics_spherical()") @@ -873,8 +875,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) 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 / (m_to_L**2*G%areaBu(I,J)) + G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -883,8 +885,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) 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 / (m_to_L**2*G%areaT(i,j)) + G%areaT(i,j) = m_to_L**2*G%dxT(i,j)*G%dyT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -903,7 +905,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) if (.not.simple_area) then do j=JsdB+1,jed ; do i=IsdB+1,ied - G%areaT(I,J) = GP%Rad_Earth**2 * & + G%areaT(I,J) = m_to_L**2*GP%Rad_Earth**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)) + & @@ -920,7 +922,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo endif @@ -1310,14 +1312,14 @@ subroutine initialize_masks(G, PF, US) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) - G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) - G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(m_to_L**2*G%areaCu(I,j)) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j) * G%dy_Cu(I,j) + G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) - G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) - G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(m_to_L**2*G%areaCv(i,J)) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J) * G%dx_Cv(i,J) + G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo call callTree_leave("initialize_masks()") diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 218ee56353..d5a748f4a6 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -716,9 +716,9 @@ subroutine reset_face_lengths_named(G, param_file, name, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -730,9 +730,9 @@ subroutine reset_face_lengths_named(G, param_file, name, US) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -783,9 +783,9 @@ subroutine reset_face_lengths_file(G, param_file, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -797,9 +797,9 @@ subroutine reset_face_lengths_file(G, param_file, US) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -997,9 +997,9 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1026,9 +1026,9 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index e8f42bc6d1..6a1f59baaa 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1882,7 +1882,7 @@ subroutine compute_global_grid_integrals(G) tmpForSumming(:,:) = 0. G%areaT_global = 0.0 ; G%IareaT_global = 0.0 do j=G%jsc,G%jec ; do i=G%isc,G%iec - tmpForSumming(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + tmpForSumming(i,j) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo G%areaT_global = reproducing_sum(tmpForSumming) G%IareaT_global = 1. / (G%areaT_global) @@ -2156,7 +2156,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 003a84d2f4..9b53e39df9 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -238,10 +238,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate_visc(i,j) = (0.25*US%m_to_L**2*G%IareaT(i,j) * & - ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & - G%areaCu(I,j)*drag_vel_u(I,j)) + & - (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & - G%areaCv(i,J)*drag_vel_v(i,J)) ) ) + ((US%L_to_m**2*G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & + US%L_to_m**2*G%areaCu(I,j)*drag_vel_u(I,j)) + & + (US%L_to_m**2*G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & + US%L_to_m**2*G%areaCv(i,J)*drag_vel_v(i,J)) ) ) enddo ; enddo else !$OMP parallel do default(shared) @@ -538,13 +538,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & - * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & + * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j))) & * min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j)) enddo ; enddo endif else @@ -684,7 +684,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) @@ -821,7 +821,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7a88529b03..d4fc2149c8 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1024,10 +1024,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) + CS%L2u(I,j) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCu(I,j) enddo; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) + CS%L2v(i,J) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCv(i,J) enddo; enddo else CS%L2u(:,:) = CS%Visbeck_L_scale**2 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 286ac580c4..7e4d64229d 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -312,7 +312,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -635,7 +635,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index cf19c54e93..c6a05b0401 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -681,7 +681,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,1) = 0.0 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) + h_avail(i,j,1) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) @@ -689,7 +689,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 88714fb1f6..6354ca8d71 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -598,20 +598,20 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) !$OMP private(s,Idenom,a_w,a_e,a_s,a_n,b_denom_1,b1,d1,c1) do j=js,je do i=is,ie - s = G%areaCu(I-1,j)+G%areaCu(I,j) + s = US%L_to_m**2*G%areaCu(I-1,j)+US%L_to_m**2*G%areaCu(I,j) if (s>0.0) then Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_w(i) = G%areaCu(I-1,j)*Idenom - a_e(i) = G%areaCu(I,j)*Idenom + a_w(i) = US%L_to_m**2*G%areaCu(I-1,j)*Idenom + a_e(i) = US%L_to_m**2*G%areaCu(I,j)*Idenom else a_w(i) = 0.0 ; a_e(i) = 0.0 endif - s = G%areaCv(i,J-1)+G%areaCv(i,J) + s = US%L_to_m**2*G%areaCv(i,J-1)+US%L_to_m**2*G%areaCv(i,J) if (s>0.0) then Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_s(i) = G%areaCv(i,J-1)*Idenom - a_n(i) = G%areaCv(i,J)*Idenom + a_s(i) = US%L_to_m**2*G%areaCv(i,J-1)*Idenom + a_n(i) = US%L_to_m**2*G%areaCv(i,J)*Idenom else a_s(i) = 0.0 ; a_n(i) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d2dd41257..1059349454 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1264,10 +1264,10 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! TKE_Ray has been initialized to 0 above. if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & US%m_to_Z**2 * US%T_to_s**2 * & - ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & - G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & - (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) + ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & + US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & + (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) if (TKE_to_layer + TKE_Ray > 0.0) then if (CS%BBL_mixing_as_max) then @@ -1445,10 +1445,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & if (Rayleigh_drag) TKE_remaining = TKE_remaining + & US%m_to_Z**2 * US%T_to_s**2 * & 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & - ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & - G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & - (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) + ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & + US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & + (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) ! Exponentially decay TKE across the thickness of the layer. ! This is energy loss in addition to work done as mixing, apparently to Joule heating. @@ -1760,15 +1760,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do i=is,ie visc%ustar_BBL(i,j) = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j) * & - ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & - G%areaCu(I,j)*(ustar(I)*ustar(I))) + & - (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & - G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) + ((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & + US%L_to_m**2*G%areaCu(I,j)*(ustar(I)*ustar(I))) + & + (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & + US%L_to_m**2*G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) visc%TKE_BBL(i,j) = US%T_to_s**2 * US%m_to_Z**2 * & - (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & - G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & - (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) + (((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & + US%L_to_m**2*G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & + (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & + US%L_to_m**2*G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) enddo enddo !$OMP end parallel diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c63748c97e..bbf7eac1fa 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1422,10 +1422,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1442,10 +1442,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1507,10 +1507,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1527,10 +1527,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 7d9ed5f0a4..0268c04f17 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -528,7 +528,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) 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) + mass = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass enddo ; enddo ; enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 7c25f5711a..d12897038f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -492,7 +492,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,Hml,G%isd,G%jsd,1,dt,& - G%areaT,get_diag_time_end(CS%diag),& + G%US%L_to_m**2*G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) @@ -594,7 +594,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde tr_ptr => tr_field(:,:,:,1) do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + tr_ptr(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index e8d4424e15..d553af730d 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -63,17 +63,17 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) 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%areaT(i,j)*h_pre(i,j,k) + & + 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%areaT(i,j)*h_pre(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)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo enddo @@ -189,10 +189,10 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! 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 - hvol = h_pre(i,j,k)*G%areaT(i,j) + 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%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + 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)) if (pos_flux>hvol .and. pos_flux>0.0) then scale_factor = ( hvol )/pos_flux*max_off_cfl @@ -294,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*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") @@ -364,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*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") @@ -409,7 +409,7 @@ 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%areaT(i,j) + h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do i=is-1,ie @@ -460,7 +460,7 @@ 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*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*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") @@ -506,7 +506,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) 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%areaT(i,j) + h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do j=js-1,je @@ -558,7 +558,7 @@ 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*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*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") diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index f43a7d4e05..bd482e241b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -322,7 +322,7 @@ 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%areaT(i,j) + h_vol(i,j,k) = 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) enddo ; enddo ; enddo @@ -342,7 +342,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! 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%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -483,7 +483,7 @@ 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%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -517,7 +517,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) 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%areaT(i,j)) + h_new(i,j,k) = 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) enddo ; enddo ; enddo @@ -528,7 +528,7 @@ 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%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -562,7 +562,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) 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%areaT(i,j)) + h_new(i,j,k) = 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) enddo ; enddo ; enddo @@ -628,8 +628,8 @@ real function remaining_transport_sum(CS, uhtr, vhtr) remaining_transport_sum = 0. do k=1,nz; do j=js,je ; do i=is,ie - uh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) - vh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) + 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 @@ -917,7 +917,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! 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%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*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) @@ -934,7 +934,7 @@ 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%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*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) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index af5cb3495d..ecf9a09058 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -157,13 +157,13 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k) + & + hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k)) + max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) enddo ; enddo else do i=is,ie ; do j=js,je @@ -175,11 +175,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i+1,j)) + uh_neglect(I,j) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i+1,j)) enddo ; enddo !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i,j+1)) + vh_neglect(i,J) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i,j+1)) enddo ; enddo !$OMP do @@ -431,7 +431,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = 0.0 CFL(I) = 0.0 elseif (uhr(I,j,k) < 0.0) then - hup = hprev(i+1,j,k) - US%m_to_L**2*G%areaT(i+1,j)*min_h + hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h hlos = MAX(0.0,uhr(I+1,j,k)) if ((((hup - hlos) + uhr(I,j,k)) < 0.0) .and. & ((0.5*hup + uhr(I,j,k)) < 0.0)) then @@ -443,7 +443,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h + hup = hprev(i,j,k) - G%areaT(i,j)*min_h hlos = MAX(0.0,-uhr(I-1,j,k)) if ((((hup - hlos) - uhr(I,j,k)) < 0.0) .and. & ((0.5*hup - uhr(I,j,k)) < 0.0)) then @@ -612,9 +612,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = hprev(i,j,k) - (uhh(I) - uhh(I-1)) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else do_i(i) = .false. @@ -773,7 +773,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & vhh(i,J) = 0.0 CFL(i) = 0.0 elseif (vhr(i,J,k) < 0.0) then - hup = hprev(i,j+1,k) - US%m_to_L**2*G%areaT(i,j+1)*min_h + hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h hlos = MAX(0.0,vhr(i,J+1,k)) if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & ((0.5*hup + vhr(i,J,k)) < 0.0)) then @@ -785,7 +785,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h + hup = hprev(i,j,k) - G%areaT(i,j)*min_h hlos = MAX(0.0,-vhr(i,J-1,k)) if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & ((0.5*hup - vhr(i,J,k)) < 0.0)) then @@ -958,9 +958,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = max(hprev(i,j,k) - (vhh(i,J) - vhh(i,J-1)), 0.0) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else ; do_i(i) = .false. ; endif enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 29b5cde89a..8e9333e7a1 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -294,7 +294,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if ((CS%id_KhTr_u > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & @@ -304,14 +304,14 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) khdt_x(I,j) = min(khdt_x(I,j), khdt_max) enddo ; enddo endif if ((CS%id_KhTr_v > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & @@ -321,7 +321,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) khdt_y(i,J) = min(khdt_y(i,J), khdt_max) enddo ; enddo endif @@ -1129,7 +1129,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Lu(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Lu(j)%p(I,k) * G%areaT(i,j) + vol = hP_Lu(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1164,7 +1164,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Ru(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Ru(j)%p(I,k) * G%areaT(i+1,j) + vol = hP_Ru(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i+1,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1266,7 +1266,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Lv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Lv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Lv(J)%p(i,k) * G%areaT(i,j) + vol = hP_Lv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1293,7 +1293,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Rv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Rv(J)%p(i,k) * G%areaT(i,j+1) + vol = hP_Rv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j+1) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1351,7 +1351,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & do k=1,PEmax_kRho ; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 0.0)) then Tr(m)%t(i,j,k) = Tr(m)%t(i,j,k) + tr_flux_conv(i,j,k) / & - (h(i,j,k)*G%areaT(i,j)) + (h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) tr_flux_conv(i,j,k) = 0.0 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index cbaf18d983..4680c058b4 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -738,7 +738,7 @@ subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do m=1,ntr do k=1,nz ; do j=js,je ; do i=is,ie - tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%areaT(i,j)*G%mask2dT(i,j) + tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j) enddo ; enddo ; enddo total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4db1e9dacd..12fd1e08a1 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -381,7 +381,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 946a5f981f..e712686521 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -320,7 +320,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 39e250da65..92f8491a49 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -360,7 +360,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d59fddbcba..35975bccb0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -407,7 +407,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 7730b8f12e..09fab89b70 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -384,7 +384,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS if (k>0) then k=min(k,k_max) ! Only insert k or first layer with interface 10 m above bottom CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt / & - ((h_new(i,j,k)+GV%H_subroundoff) * G%areaT(i,j) ) + ((h_new(i,j,k)+GV%H_subroundoff) * G%US%L_to_m**2*G%areaT(i,j) ) elseif (k<0) then h_total=GV%H_subroundoff do k=1, nz @@ -392,7 +392,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo do k=1, nz CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt/(h_total & - * G%areaT(i,j) ) + * G%US%L_to_m**2*G%areaT(i,j) ) enddo endif enddo @@ -441,7 +441,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index ea3ccb8928..af4c1e9659 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -286,7 +286,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(1) = stocks(1) + CS%diff(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(1) = GV%H_to_kg_m2 * stocks(1) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 9b36254206..aa9d34c4e1 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -393,7 +393,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo From a673354a5c784424251628907cfc4525d974a379 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 09:29:16 -0400 Subject: [PATCH 019/104] +Rescaled the units of G%dy_Cu and G%dx_Cv Rescaled G%dy_Cu and G%dx_Cv throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 12 +-- src/core/MOM_barotropic.F90 | 20 ++-- src/core/MOM_continuity_PPM.F90 | 96 +++++++++---------- src/core/MOM_grid.F90 | 10 +- src/core/MOM_open_boundary.F90 | 2 +- src/diagnostics/MOM_PointAccel.F90 | 12 +-- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 8 +- src/framework/MOM_dyn_horgrid.F90 | 12 +-- src/initialization/MOM_grid_initialize.F90 | 8 +- .../MOM_shared_initialization.F90 | 87 +++++++++-------- .../MOM_state_initialization.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 24 ++--- .../lateral/MOM_hor_visc.F90 | 48 +++++----- .../lateral/MOM_internal_tides.F90 | 30 +++--- .../lateral/MOM_thickness_diffuse.F90 | 20 ++-- .../vertical/MOM_set_viscosity.F90 | 4 +- .../vertical/MOM_vert_friction.F90 | 40 ++++---- src/tracer/MOM_tracer_hor_diff.F90 | 24 ++--- src/user/MOM_controlled_forcing.F90 | 12 +-- 20 files changed, 242 insertions(+), 235 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 124ad3a166..b144e6f58f 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -273,10 +273,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo if (CS%Coriolis_En_Dis) then do j=Jsq,Jeq+1 ; do I=is-1,ie - uh_center(I,j) = 0.5 * (US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * US%m_s_to_L_T*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 * (US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -319,9 +319,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) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) + vh_center(i,J) = G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - vh_center(i,J) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -358,9 +358,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) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - uh_center(I,j) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) endif enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 28d6913051..be2e25c769 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1544,21 +1544,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) endif enddo ; enddo endif @@ -4085,10 +4085,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = US%m_to_L*G%dy_Cu(I,j) + CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = US%m_to_L*G%dx_Cv(i,J) + CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J) enddo ; enddo call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All) call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index e03e82e265..f90650adfc 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -335,8 +335,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm @@ -350,8 +350,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) @@ -365,8 +365,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & @@ -379,8 +379,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & @@ -391,8 +391,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) @@ -439,7 +439,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (any_simple_OBC) then do I=ish-1,ieh do_I(I) = OBC%segment(OBC%segnum_u(I,j))%specified - if (do_I(I)) FAuI(I) = GV%H_subroundoff*US%m_to_L*G%dy_Cu(I,j) + if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & @@ -466,7 +466,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (OBC%segment(n)%direction == OBC_DIRECTION_E) then 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)*US%m_to_L*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; 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 @@ -474,7 +474,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else 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)*US%m_to_L*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) ; 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 @@ -539,35 +539,35 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) 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) = US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = G%dy_Cu(I,j) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then do I=ish-1,ieh ; if (do_I(I)) then if (OBC%segment(OBC%segnum_u(I,j))%open) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i) - duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = G%dy_Cu(I,j) * u(I) * h(i) + duhdu(I) = G%dy_Cu(I,j) * h(i) * visc_rem(I) else - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i+1) - duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + 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) endif endif endif ; enddo @@ -614,13 +614,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) @@ -1134,8 +1134,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm @@ -1150,8 +1150,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & @@ -1164,8 +1164,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) @@ -1177,8 +1177,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) @@ -1188,8 +1188,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) @@ -1234,7 +1234,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (any_simple_OBC) then do i=ish,ieh do_I(i) = (OBC%segment(OBC%segnum_v(i,J))%specified) - if (do_I(i)) FAvi(i) = GV%H_subroundoff*US%m_to_L*G%dx_Cv(i,J) + if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) enddo do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & @@ -1262,7 +1262,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O 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)*US%m_to_L*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; 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 @@ -1270,7 +1270,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O 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)*US%m_to_L*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) ; 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 @@ -1337,18 +1337,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i) * dt_in_T * US%L_to_m*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) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) 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)) @@ -1356,18 +1356,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, vh(i) = 0.0 h_marg = 0.5 * (h_L(i,j+1) + h_R(i,j)) endif - dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = G%dx_Cv(i,J) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then do i=ish,ieh ; if (do_I(i)) then if (OBC%segment(OBC%segnum_v(i,J))%open) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j) - dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + 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) else - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j+1) - dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + 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) endif endif endif ; enddo @@ -1414,14 +1414,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 04da9abfb8..45353cebce 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -96,7 +96,7 @@ module MOM_grid IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. @@ -108,7 +108,7 @@ module MOM_grid IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. @@ -425,7 +425,7 @@ subroutine set_derived_metrics(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -449,8 +449,8 @@ subroutine set_derived_metrics(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L*G%dxBu(I,J) * US%m_to_L*G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7935d3a529..3f0fb42cfc 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1475,7 +1475,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) do j=segment%HI%jsd,segment%HI%jed if (segment%direction == OBC_DIRECTION_E) then areaCu(I,j) = G%areaT(i,j) ! Both of these are in [L2] - else ! West + else ! West areaCu(I,j) = G%areaT(i+1,j) ! Both of these are in [L2] endif enddo diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index a13003a826..ca89dfc1c4 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -173,9 +173,9 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) - if (um(I,j,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i+1,j) - else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif + CFL = abs(US%m_to_L*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:",$)') @@ -504,9 +504,9 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (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)) * dt * G%dx_Cv(i,J) - if (vm(i,J,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j+1) - else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif + CFL = abs(US%m_to_L*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:",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 0e099cb079..1089dbb6e9 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1967,11 +1967,11 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%dyCv, diag, .true.) id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & - 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none') + 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dy_Cu, diag, .true.) id = register_static_field('ocean_model', 'dxCvo', diag%axesCv1, & - 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') + 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 5a6041def3..d03fa1ffef 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -713,9 +713,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) @@ -723,9 +723,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index f46b8cb875..d26e072c40 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -92,7 +92,7 @@ module MOM_dyn_horgrid IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. @@ -104,7 +104,7 @@ module MOM_dyn_horgrid IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. @@ -323,7 +323,7 @@ subroutine set_derived_dyn_horgrid(G, US) 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 + 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 @@ -333,7 +333,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -357,8 +357,8 @@ subroutine set_derived_dyn_horgrid(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L*G%dxBu(I,J) * m_to_L*G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_dyn_horgrid diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 5162c1303f..132fa9b60a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1311,14 +1311,14 @@ subroutine initialize_masks(G, PF, US) call pass_vector(G%mask2dCu, G%mask2dCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j) * G%dy_Cu(I,j) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*G%dyCu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J) * G%dx_Cv(i,J) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*G%dxCv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index d5a748f4a6..346e3d32a8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -624,6 +624,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! 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 :: pi_180 integer :: option = -1 @@ -639,6 +640,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) 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. @@ -646,62 +648,61 @@ subroutine reset_face_lengths_named(G, param_file, name, US) 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 ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*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 ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*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 ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*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 ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*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 ! Betw Hokkaido and Sakhalin at 217&218 = 142e - + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*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 ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*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 ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*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 ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*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 ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*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 ! entry to Makassar Straits at 240.5 W = 119.5 E + 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 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 ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + 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 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 ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + 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 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 ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + 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 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 ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*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 ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*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 ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + 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 ! 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 ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -709,28 +710,28 @@ 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 (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*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)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), G%dyCu(I,j), 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 - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*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)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), G%dxCv(i,J), 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) endif - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -751,6 +752,7 @@ subroutine reset_face_lengths_file(G, param_file, US) 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 @@ -758,6 +760,7 @@ subroutine reset_face_lengths_file(G, param_file, US) 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.", & @@ -772,32 +775,32 @@ 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) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=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 (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*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)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), G%dyCu(I,j), 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 - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*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)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), G%dxCv(i,J), 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) endif - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -824,6 +827,7 @@ subroutine reset_face_lengths_list(G, param_file, US) real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() 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 :: 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. @@ -840,6 +844,7 @@ subroutine reset_face_lengths_list(G, param_file, US) 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.", & @@ -983,7 +988,7 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(G%dyCu(I,j), max(u_width(npt), 0.0)) 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(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -991,13 +996,13 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(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 ",G%dy_Cu(I,j),"m" + 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" endif endif endif enddo - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -1012,7 +1017,7 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(G%dxCv(i,J), max(v_width(npt), 0.0)) 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(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1020,13 +1025,13 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(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 ",G%dx_Cv(I,j),"m" + 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" endif endif endif enddo - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -1177,6 +1182,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) type(fieldtype) :: fields(nFlds) 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. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1195,6 +1201,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) 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 ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: @@ -1297,8 +1304,10 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%areaBu(I,J) ; enddo ; enddo call write_field(unit, fields(16), G%Domain%mpp_domain, out_q) - call write_field(unit, fields(17), G%Domain%mpp_domain, G%dx_Cv) - call write_field(unit, fields(18), G%Domain%mpp_domain, G%dy_Cu) + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dx_Cv(i,J) ; enddo ; enddo + call write_field(unit, fields(17), G%Domain%mpp_domain, out_v) + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dy_Cu(I,j) ; enddo ; enddo + call write_field(unit, fields(18), G%Domain%mpp_domain, out_u) call write_field(unit, fields(19), G%Domain%mpp_domain, G%mask2dT) if (G%bathymetry_at_vel) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6a1f59baaa..0beda5477c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1385,12 +1385,12 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) do k=1,nz ; do j=js,je ; do I=Isq,Ieq psi1 = my_psi(I,j) psi2 = my_psi(I,j-1) - u(I,j,k) = (psi1-psi2) / (G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) + u(I,j,k) = (psi1-psi2) / (G%US%L_to_m*G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie psi1 = my_psi(i,J) psi2 = my_psi(i-1,J) - v(i,J,k) = (psi2-psi1) / (G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) + v(i,J,k) = (psi2-psi1) / (G%US%L_to_m*G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo contains diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9b53e39df9..39846b81a8 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -364,17 +364,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 - MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) - ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + ! MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 - MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) - ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + ! MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo @@ -392,22 +392,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max - MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((K4_here * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max - MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((K4_here * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo @@ -431,12 +431,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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)) & 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)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo @@ -446,12 +446,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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)) & 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)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 509ce21959..4bc095de56 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1875,34 +1875,34 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & - (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) - if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & - (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & + (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & + (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & - (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) - if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & - (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & + (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & + (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index e3db9b90a6..b2b63f90ac 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1536,16 +1536,16 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hL(i+1) + CFL * (0.5*(hR(i+1)-hL(i+1)) + curv_3*(CFL - 1.5))) else uh(I) = 0.0 @@ -1580,16 +1580,16 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) - vh(i) = G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & + vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) - vh(i) = G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & + vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) else vh(i) = 0.0 @@ -2391,8 +2391,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !call MOM_read_data(filename, 'land_mask', G%mask2dCu, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dCv, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dT, G%domain, timelevel=1) - !call pass_var(G%mask2dCu,G%domain) - !call pass_var(G%mask2dCv,G%domain) + !call pass_vector(G%mask2dCu, G%mask2dCv, G%domain, To_All+Scalar_Pair, CGRID_NE) !call pass_var(G%mask2dT,G%domain) ! Read in prescribed partial east face blockages from file (if overwriting -BDM) @@ -2402,8 +2401,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dy_Cu_file) !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) !G%dy_Cu(:,:) = 0.0 - !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1) - !call pass_var(G%dy_Cu,G%domain) + !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1, scale=US%m_to_L) ! Read in prescribed partial north face blockages from file (if overwriting -BDM) !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & @@ -2412,8 +2410,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dx_Cv_file) !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) !G%dx_Cv(:,:) = 0.0 - !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1) - !call pass_var(G%dx_Cv,G%domain) + !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1, scale=US%m_to_L) + !call pass_vector(G%dy_Cu, G%dx_Cv, G%domain, To_All+Scalar_Pair, CGRID_NE) ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & @@ -2421,9 +2419,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_refl_pref = register_diag_field('ocean_model', 'refl_pref', diag%axesT1, & Time, 'Partial reflection coefficients', '') CS%id_dx_Cv = register_diag_field('ocean_model', 'dx_Cv', diag%axesT1, & - Time, 'North face unblocked width', 'm') ! used if overriding (BDM) + Time, 'North face unblocked width', 'm', conversion=US%L_to_m) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & - Time, 'East face unblocked width', 'm') ! used if overriding (BDM) + Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & Time, 'Land mask', 'logical') ! used if overriding (BDM) ! Output reflection parameters as diags here (not needed every timestep) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c6a05b0401..f5ef54ffd2 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -831,7 +831,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -860,7 +860,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) hN2_u(I,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -922,7 +922,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_x(I,j,K) = max(uhtot(I,j)-h_avail(i+1,j,k), & ! min(uhtot(I,j)+h_avail(i,j,k), & ! min(h_avail_rsum(i+1,j,K), max(-h_avail_rsum(i,j,K), & -! (KH_u(I,j,K)*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) +! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1080,7 +1080,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1109,7 +1109,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) hN2_v(i,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1171,7 +1171,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_y(i,J,K) = max(vhtot(i,J)-h_avail(i,j+1,k), & ! min(vhtot(i,J)+h_avail(i,j,k), & ! min(h_avail_rsum(i,j+1,K), max(-h_avail_rsum(i,j,K), & -! (KH_v(i,J,K)*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) +! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1526,7 +1526,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*G%dy_Cu(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1551,7 +1551,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*G%dx_Cv(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom @@ -1683,7 +1683,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! ((e(i+1,j,K)-e(i+1,j,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then ! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dy_Cu(I,j) ! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then @@ -1703,7 +1703,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! ((e(i,j+1,K)-e(i,j+1,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then ! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) ! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dx_Cv(i,J) ! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 641415893c..8b4101eb62 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -831,8 +831,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 = US%L_to_m*G%dy_Cu(I,j) + else ; Cell_width = US%L_to_m*G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) Rayleigh = US%m_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 + & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index bbf7eac1fa..ff6d834215 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1395,9 +1395,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,11 +1421,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1441,11 +1441,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1480,9 +1480,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,11 +1506,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1526,11 +1526,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 8e9333e7a1..534c3c20ae 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -244,48 +244,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -297,8 +297,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max - if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + if (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & + Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else @@ -314,8 +314,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max - if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + if (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & + Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index cbfce62f39..be130a2a06 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -136,12 +136,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec call pass_var(CS%precip_0, G%Domain) do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_0(i,j) - CS%heat_0(i+1,j)) flux_prec_x(I,j) = coef * (CS%precip_0(i,j) - CS%precip_0(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_0(i,j) - CS%heat_0(i,j+1)) flux_prec_y(i,J) = coef * (CS%precip_0(i,j) - CS%precip_0(i,j+1)) enddo ; enddo @@ -320,12 +320,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i+1,j,m_u1)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i+1,j,m_u1)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i,j+1,m_u1)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i,j+1,m_u1)) enddo ; enddo @@ -345,12 +345,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((wt_per1 < 1.0) .and. (CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i+1,j,m_u2)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i+1,j,m_u2)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i,j+1,m_u2)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i,j+1,m_u2)) enddo ; enddo From 5ed5cdbe2061fd696c6f2d3c00ff911eee4fc79e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 10:49:19 -0400 Subject: [PATCH 020/104] +Rescaled the units of G%dyT and G%dxT Rescaled G%dyT and G%dxT throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_barotropic.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 60 ++++++++--------- src/core/MOM_grid.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 8 +-- src/framework/MOM_dyn_horgrid.F90 | 8 +-- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 65 +++++++++---------- src/initialization/MOM_grid_initialize.F90 | 20 +++--- .../MOM_shared_initialization.F90 | 4 +- .../lateral/MOM_hor_visc.F90 | 4 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- 10 files changed, 91 insertions(+), 94 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index be2e25c769..515bba15d9 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1351,8 +1351,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Limit the source (outward) correction to be a fraction the mass that ! can be transported out of the cell by velocities with a CFL number of ! CFL_cor. - u_max_cor = US%m_to_L*G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) - v_max_cor = US%m_to_L*G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) + u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) + v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) eta_cor_max = dt_in_T * (CS%IareaT(i,j) * & (((find_uhbt(u_max_cor, BTCL_u(I,j), US) + uhbt0(I,j)) - & (find_uhbt(-u_max_cor, BTCL_u(I-1,j), US) + uhbt0(I-1,j))) + & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index f90650adfc..1f0ecdf652 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -335,9 +335,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm uh_tot_0(I) = 0.0 ; duhdu_tot_0(I) = 0.0 @@ -350,9 +350,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) if (du_max_CFL(I) * visc_rem(I,k) > du_lim) & @@ -365,9 +365,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & du_max_CFL(I) = (dx_W*CFL_dt - u(I,j,k)) / visc_rem(I,k) @@ -379,9 +379,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & ((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) ) @@ -391,9 +391,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) du_min_CFL(I) = MAX(du_min_CFL(I), -(dx_E*CFL_dt + u(I,j,k))) @@ -1134,9 +1134,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm vh_tot_0(i) = 0.0 ; dvhdv_tot_0(i) = 0.0 @@ -1150,9 +1150,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & dv_max_CFL(i) = dv_lim / visc_rem(i,k) @@ -1164,9 +1164,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)) & @@ -1177,9 +1177,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) dv_min_CFL(i) = max(dv_min_CFL(i), 0.499 * & @@ -1188,9 +1188,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) enddo ; enddo diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 45353cebce..5f081e14cd 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -77,9 +77,9 @@ module MOM_grid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points [m]. + dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. + dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. areaT, & !< The area of an h-cell [m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. @@ -423,8 +423,8 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1089dbb6e9..f20a63bdfb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1943,12 +1943,12 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) id = register_static_field('ocean_model', 'dxt', diag%axesT1, & - 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxt, diag, .true.) + 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dxT, diag, .true.) id = register_static_field('ocean_model', 'dyt', diag%axesT1, & - 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyt, diag, .true.) + 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dyT, diag, .true.) id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & 'Delta(x) at u points (meter)', 'm', interp_method='none') diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index d26e072c40..a1947b71e5 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -71,9 +71,9 @@ module MOM_dyn_horgrid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxT, & !< dxT is delta x at h points [m]. + dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. + dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. areaT, & !< The area of an h-cell [L-2 ~> m-2]. IareaT !< 1/areaT [m-2]. @@ -331,8 +331,8 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(L_to_m*G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(L_to_m*G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 8d7adf9951..5e53c09923 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -871,9 +871,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 else X(2,:) = G%geoLonBu(i,j)*1000 - X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) + X(1,:) = G%geoLonBu(i,j)*1000 - US%L_to_m*G%dxT(i,j) Y(:,2) = G%geoLatBu(i,j)*1000 - Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + Y(:,1) = G%geoLatBu(i,j)*1000 - US%L_to_m*G%dyT(i,j) endif call bilinear_shape_functions(X, Y, Phi_temp, area) @@ -1485,7 +1485,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -1605,16 +1605,16 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -1714,7 +1714,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -1821,16 +1821,16 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -2142,9 +2142,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) cnt = 0 sx = 0 sy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -2673,8 +2673,8 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 @@ -2865,9 +2865,8 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo if ((CS%umask(i-1,j-1) == 3) .OR. (CS%umask(i,j-1) == 3) .OR. & (CS%umask(i-1,j) == 3) .OR. (CS%umask(i,j) == 3)) then - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 @@ -2884,8 +2883,6 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - do iq=1,2 ; do jq=1,2 uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & @@ -3022,8 +3019,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) do j=jsd+1,jed-1 do i=isd+1,ied-1 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then @@ -3681,7 +3678,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -3801,18 +3798,18 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3909,7 +3906,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -4016,18 +4013,18 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 132fa9b60a..504f519b09 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -126,7 +126,7 @@ subroutine grid_metrics_chksum(parent, G, US) 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) + G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo) @@ -363,7 +363,7 @@ 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) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) + 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) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) @@ -530,8 +530,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = dx_everywhere ; G%IdxT(i,j) = I_dx - G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy + G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = I_dx + G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = 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 enddo ; enddo @@ -680,14 +680,14 @@ 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) = G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di + 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) = G%Rad_Earth * dLat*PI_180 + G%dyT(i,j) = m_to_L*G%Rad_Earth * 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) = m_to_L**2 * G%dxT(i,j) * G%dyT(i,j) + G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) enddo ; enddo call callTree_leave("set_grid_metrics_spherical()") @@ -882,10 +882,10 @@ 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) = ds_di(xh(i,j), yh(i,j), GP) - G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) + 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%areaT(i,j) = m_to_L**2*G%dxT(i,j)*G%dyT(i,j) + G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 346e3d32a8..502dd35a1b 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1289,9 +1289,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dxT(i,j); enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dxT(i,j); enddo ; enddo call write_field(unit, fields(11), G%Domain%mpp_domain, out_h) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = G%dxBu(I,J) ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4bc095de56..ce60d2ccc2 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1869,8 +1869,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - CS%DX2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = G%dyT(i,j)*G%dyT(i,j) - CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) + CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) + CS%DX_dyT(i,j) = US%L_to_m*G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = US%L_to_m*G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d4fc2149c8..adf7cd3d6e 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1162,11 +1162,11 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 - CS%f2_dx2_h(i,j) = ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * & + CS%f2_dx2_h(i,j) = ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*G%dyT(i,j))**2) * & max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) - CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * (sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*G%dyT(i,j))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((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 + & From 14ce1d4406113726d90c628a347f699e14f8ec25 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 12:37:10 -0400 Subject: [PATCH 021/104] +Rescaled the units of G%dxCu and G%dyCv Rescaled G%dxCu and G%dyCv throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 20 +++++------ src/core/MOM_continuity_PPM.F90 | 4 +-- src/core/MOM_grid.F90 | 8 ++--- src/diagnostics/MOM_diagnostics.F90 | 36 +++++++++---------- src/framework/MOM_dyn_horgrid.F90 | 8 ++--- src/initialization/MOM_grid_initialize.F90 | 24 ++++++------- .../MOM_shared_initialization.F90 | 18 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 13 +++---- .../lateral/MOM_mixed_layer_restrat.F90 | 8 ++--- 9 files changed, 70 insertions(+), 69 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index b144e6f58f..96a28fc6f5 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -262,8 +262,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! but only first order accurate at boundaries with no slip b.c.s. ! First calculate the contributions to the circulation around the q-point. do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J) - dudy(I,J) = u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j) + dvdx(I,J) = v(i+1,J,k)*US%L_to_m*G%dyCv(i+1,J) - v(i,J,k)*US%L_to_m*G%dyCv(i,J) + dudy(I,J) = u(I,j+1,k)*US%L_to_m*G%dxCu(I,j+1) - u(I,j,k)*US%L_to_m*G%dxCu(I,j) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k)) @@ -294,16 +294,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) + dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*US%L_to_m*G%dxCu(I,j) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) + dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dxCu(I,j+1) endif enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -334,16 +334,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) + dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*US%L_to_m*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) + dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dyCv(i+1,J) endif enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 1f0ecdf652..d606bbdb0f 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -930,7 +930,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, domore = .false. do I=ish-1,ieh if (do_I(I)) domore = .true. - du_CFL(I) = (CFL_min * Idt) * US%m_to_L*G%dxCu(I,j) + du_CFL(I) = (CFL_min * Idt) * G%dxCu(I,j) duR(I) = min(0.0,du0(I) - du_CFL(I)) duL(I) = max(0.0,du0(I) + du_CFL(I)) FAmt_L(I) = 0.0 ; FAmt_R(I) = 0.0 ; FAmt_0(I) = 0.0 @@ -1730,7 +1730,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, domore = .false. do i=ish,ieh ; if (do_I(i)) then domore = .true. - dv_CFL(i) = (CFL_min * Idt) * US%m_to_L*G%dyCv(i,J) + dv_CFL(i) = (CFL_min * Idt) * G%dyCv(i,J) dvR(i) = min(0.0,dv0(i) - dv_CFL(i)) dvL(i) = max(0.0,dv0(i) + dv_CFL(i)) FAmt_L(i) = 0.0 ; FAmt_R(i) = 0.0 ; FAmt_0(i) = 0.0 diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 5f081e14cd..dff2bdf3cf 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -92,7 +92,7 @@ module MOM_grid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points [m]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. @@ -106,7 +106,7 @@ module MOM_grid geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [m]. IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. @@ -431,7 +431,7 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -439,7 +439,7 @@ subroutine set_derived_metrics(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index f20a63bdfb..37ad8ac14a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -936,10 +936,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*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) @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -975,10 +975,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*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) * & @@ -1002,11 +1002,11 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*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) * & @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*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) * & @@ -1951,19 +1951,19 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%dyT, diag, .true.) id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & - 'Delta(x) at u points (meter)', 'm', interp_method='none') + 'Delta(x) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCu, diag, .true.) id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') + 'Delta(y) at u points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCu, diag, .true.) id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') + 'Delta(x) at v points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCv, diag, .true.) id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & - 'Delta(y) at v points (meter)', 'm', interp_method='none') + 'Delta(y) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCv, diag, .true.) id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index a1947b71e5..2fac514036 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -88,7 +88,7 @@ module MOM_dyn_horgrid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. - dxCu, & !< dxCu is delta x at u points [m]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. @@ -102,7 +102,7 @@ module MOM_dyn_horgrid geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. dxCv, & !< dxCv is delta x at v points [m]. IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. @@ -339,7 +339,7 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -347,7 +347,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 504f519b09..9213615333 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -128,7 +128,7 @@ subroutine grid_metrics_chksum(parent, G, US) call hchksum_pair(trim(parent)//': d[xy]T', & G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo) + 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%dyCu, G%dxCv, G%HI, haloshift=halo) @@ -366,10 +366,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) 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) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) + G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = dyCv(i,J) + G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) @@ -538,7 +538,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = dx_everywhere ; G%IdxCu(I,j) = I_dx + G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = I_dx G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy enddo ; enddo @@ -546,7 +546,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx - G%dyCv(i,J) = dy_everywhere ; G%IdyCv(i,J) = I_dy + G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") @@ -660,7 +660,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di ! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) - G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180 + G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -669,8 +669,8 @@ 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) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di -! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) + 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) = G%Rad_Earth * dLat*PI_180 enddo ; enddo @@ -892,7 +892,7 @@ 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) = ds_di(xu(I,j), yu(I,j), GP) + G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo @@ -900,7 +900,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI 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) + G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo if (.not.simple_area) then @@ -1312,13 +1312,13 @@ subroutine initialize_masks(G, PF, US) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*G%dyCu(I,j) - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*G%dxCv(i,J) - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 502dd35a1b..35c42f0775 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -669,7 +669,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) 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)) + dy_2 = dx_2 * L_to_m*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. @@ -717,7 +717,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -731,7 +731,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -786,7 +786,7 @@ subroutine reset_face_lengths_file(G, param_file, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -800,7 +800,7 @@ subroutine reset_face_lengths_file(G, param_file, US) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -1002,7 +1002,7 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -1031,7 +1031,7 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -1284,9 +1284,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dyCu(I,j) ; enddo ; enddo call write_field(unit, fields(8), G%Domain%mpp_domain, out_u) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dxCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dxCu(I,j) ; enddo ; enddo call write_field(unit, fields(9), G%Domain%mpp_domain, out_u) - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dxT(i,j); enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index adf7cd3d6e..a6926474d0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1128,9 +1128,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * & + CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) - CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -1139,9 +1139,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * & + CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) - CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * (sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -1207,13 +1207,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes - grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) + grid_sp_u2 = G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes - grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) + !### The second factor here is wrong. + grid_sp_v2 = US%L_to_m*G%dyCv(i,J)*US%L_to_m*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 7e4d64229d..6115e2a8fe 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -360,7 +360,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( (G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -436,7 +436,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -663,7 +663,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -710,7 +710,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) From 9f3e8df44fecf26faedd614ba256f5dbedafba2e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 14:32:21 -0400 Subject: [PATCH 022/104] +Rescaled the units of G%dyCu and G%dxCv Rescaled G%dyCu and G%dxCv throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_grid.F90 | 8 +-- src/core/MOM_open_boundary.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/framework/MOM_diag_mediator.F90 | 8 +-- src/framework/MOM_dyn_horgrid.F90 | 8 +-- src/initialization/MOM_grid_initialize.F90 | 25 ++++----- .../MOM_shared_initialization.F90 | 26 ++++----- .../lateral/MOM_hor_visc.F90 | 56 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 12 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 16 +++--- src/user/Kelvin_initialization.F90 | 4 +- src/user/dyed_channel_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 2 +- src/user/tidal_bay_initialization.F90 | 2 +- 14 files changed, 90 insertions(+), 91 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index dff2bdf3cf..b65e5200f8 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -94,7 +94,7 @@ module MOM_grid geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. @@ -104,7 +104,7 @@ module MOM_grid mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points [m]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. @@ -432,13 +432,13 @@ subroutine set_derived_metrics(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 3f0fb42cfc..078a915871 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3285,11 +3285,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,G%ke segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & - G%dyCu(I,j) + US%L_to_m*G%dyCu(I,j) normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) enddo segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & - G%dyCu(I,j)) + US%L_to_m*G%dyCu(I,j)) if (associated(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 @@ -3299,11 +3299,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,G%ke segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & - G%dxCv(i,J) + US%L_to_m*G%dxCv(i,J) normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) enddo segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & - G%dxCv(i,J)) + US%L_to_m*G%dxCv(i,J)) if (associated(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. & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 37ad8ac14a..03bbec78fb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1955,11 +1955,11 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%dxCu, diag, .true.) id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) + 'Delta(y) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCu, diag, .true.) id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) + 'Delta(x) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCv, diag, .true.) id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 4a8091752a..54f1934abd 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3910,7 +3910,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + weight =mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k) total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -3966,7 +3966,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -4093,7 +4093,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo @@ -4107,7 +4107,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 2fac514036..5e533e0f05 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -90,7 +90,7 @@ module MOM_dyn_horgrid geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. @@ -100,7 +100,7 @@ module MOM_dyn_horgrid mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. - dxCv, & !< dxCv is delta x at v points [m]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. @@ -340,13 +340,13 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(L_to_m*G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(L_to_m*G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 9213615333..bba879eec7 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -130,8 +130,7 @@ subroutine grid_metrics_chksum(parent, G, US) 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%dyCu, G%dxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) call Bchksum_pair(trim(parent)//': dxB[uv]', & G%dxBu, G%dyBu, G%HI, haloshift=halo) @@ -366,10 +365,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) 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) 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) = dyCu(I,j) + G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) + G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) @@ -539,13 +538,13 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = I_dx - G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy + G%dyCu(I,j) = m_to_L*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) = dx_everywhere ; G%IdxCv(i,J) = I_dx + G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = I_dx G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo @@ -658,8 +657,8 @@ 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) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di -! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) + 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 enddo ; enddo @@ -671,7 +670,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! 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) = G%Rad_Earth * dLat*PI_180 + G%dyCu(I,j) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -893,13 +892,13 @@ subroutine set_grid_metrics_mercator(G, param_file, US) 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) = ds_dj(xu(I,j), yu(I,j), GP) + G%dyCu(I,j) = m_to_L*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) = ds_di(xv(i,J), yv(i,J), GP) + 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) enddo ; enddo @@ -1311,13 +1310,13 @@ subroutine initialize_masks(G, PF, US) call pass_vector(G%mask2dCu, G%mask2dCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*G%dyCu(I,j) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*G%dxCv(i,J) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 35c42f0775..9a6ecde5d8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -644,7 +644,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) 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)) + dy_2 = dx_2 * L_to_m*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)) & @@ -710,10 +710,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) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*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), G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-G%dyCu(I,j), & + 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), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif @@ -723,10 +723,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) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*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), G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-G%dxCv(i,J), & + 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), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) @@ -779,10 +779,10 @@ subroutine reset_face_lengths_file(G, param_file, US) 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) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*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), G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-G%dyCu(I,j), & + 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), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif @@ -792,10 +792,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) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*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), G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-G%dxCv(i,J), & + 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), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) @@ -988,7 +988,7 @@ 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(G%dyCu(I,j), max(u_width(npt), 0.0)) + 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)) 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(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -1017,7 +1017,7 @@ 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(G%dxCv(i,J), max(v_width(npt), 0.0)) + 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)) 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(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1279,9 +1279,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) ! I think that all of these copies are holdovers from a much earlier ! ancestor code in which many of the metrics were macros that could have ! had reduced dimensions, and that they are no longer needed in MOM6. -RWH - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dxCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dxCv(i,J) ; enddo ; enddo call write_field(unit, fields(7), G%Domain%mpp_domain, out_v) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dyCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dyCu(I,j) ; enddo ; enddo call write_field(unit, fields(8), G%Domain%mpp_domain, out_u) do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dxCu(I,j) ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index ce60d2ccc2..9382fd84fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -752,10 +752,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & + div_xx(i,j) = 0.5*((US%L_to_m*G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + US%L_to_m*G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (US%L_to_m*G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + US%L_to_m*G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -1875,34 +1875,34 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & - (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & - (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) + if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j)) .and. & + (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (US%L_to_m*G%dyCu(I-1,j)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) + if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1)) .and. & + (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (US%L_to_m*G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & - (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & - (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) + if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1)) .and. & + (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (US%L_to_m*G%dyCu(I,j+1)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) + if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J)) .and. & + (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (US%L_to_m*G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a6926474d0..d4b0b88313 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1128,9 +1128,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * & + CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) - CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * (sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -1139,9 +1139,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * & + CS%f2_dx2_v(i,J) = ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) - CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -1207,13 +1207,13 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes - grid_sp_u2 = G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) + grid_sp_u2 = US%L_to_m*G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes - !### The second factor here is wrong. + !### The second factor here is wrong. It should be G%dxCv(i,J). grid_sp_v2 = US%L_to_m*G%dyCv(i,J)*US%L_to_m*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 6115e2a8fe..c1520e68d7 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -360,7 +360,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -372,7 +372,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z @@ -381,7 +381,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + uDml_slow(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then @@ -436,7 +436,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -448,7 +448,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & + vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z @@ -457,7 +457,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & + vDml_slow(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then @@ -665,7 +665,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then @@ -712,7 +712,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & + vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 60fd96d900..0b1eba8d0f 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -274,7 +274,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & - h(i+1,j,k) * G%dyCu(I,j) + h(i+1,j,k) * G%US%L_to_m*G%dyCu(I,j) enddo endif endif @@ -330,7 +330,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & - h(i,j+1,k) * G%dxCv(i,J) + h(i,j+1,k) * G%US%L_to_m*G%dxCv(i,J) enddo endif endif diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 61f8183275..72dfc309e5 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -172,7 +172,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) segment%normal_vel(I,j,k) = flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = flow * G%dyCu(I,j) + segment%normal_trans(I,j,k) = flow * G%US%L_to_m*G%dyCu(I,j) endif enddo ; enddo enddo diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index f12378c3d9..0f204b6c6e 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -58,7 +58,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) segment%normal_vel(I,j,k) = zonal_flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = zonal_flow * G%dyCu(I,j) + segment%normal_trans(I,j,k) = zonal_flow * G%US%L_to_m*G%dyCu(I,j) endif enddo ; enddo enddo diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 161ad25c11..d84da56f4b 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -98,7 +98,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) do j=segment%HI%jsc,segment%HI%jec ; do I=segment%HI%IscB,segment%HI%IecB if (OBC%segnum_u(I,j) /= OBC_NONE) then do k=1,nz - my_area(1,j) = my_area(1,j) + h(I,j,k)*G%dyCu(I,j) + my_area(1,j) = my_area(1,j) + h(I,j,k)*G%US%L_to_m*G%dyCu(I,j) enddo endif enddo ; enddo From 013b9088105b2151619b4b21b98072c18c3301d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Aug 2019 06:18:43 -0400 Subject: [PATCH 023/104] +Rescaled the units of G%dxBu and G%dyBu Rescaled G%dxBu and G%dyBu throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 8 ++--- src/core/MOM_grid.F90 | 26 +++++++-------- src/framework/MOM_dyn_horgrid.F90 | 22 ++++++------- src/initialization/MOM_grid_initialize.F90 | 32 ++++++++----------- .../MOM_shared_initialization.F90 | 4 +-- .../lateral/MOM_hor_visc.F90 | 20 ++++++------ .../lateral/MOM_internal_tides.F90 | 4 +-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +-- 8 files changed, 58 insertions(+), 62 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 96a28fc6f5..2cce10933d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -301,9 +301,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -341,9 +341,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index b65e5200f8..9e17faf006 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -74,14 +74,14 @@ module MOM_grid !! set_first_direction. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. + mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. + areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. @@ -89,7 +89,7 @@ module MOM_grid !! and the true northward directions. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. + mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. @@ -98,10 +98,10 @@ module MOM_grid IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. - areaCu !< The areas of the u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. + mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [L ~> m]. @@ -110,17 +110,17 @@ module MOM_grid IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. - areaCv !< The areas of the v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. + mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points [m]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] + areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: & @@ -446,10 +446,10 @@ subroutine set_derived_metrics(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L*G%dxBu(I,J) * US%m_to_L*G%dyBu(I,J) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 5e533e0f05..3883dc9011 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -75,8 +75,8 @@ module MOM_dyn_horgrid IdxT, & !< 1/dxT [m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [L-2 ~> m-2]. - IareaT !< 1/areaT [m-2]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT !< 1/areaT [L-2 ~> m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions [nondim]. @@ -94,7 +94,7 @@ module MOM_dyn_horgrid IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. - areaCu !< The areas of the u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. @@ -106,18 +106,18 @@ module MOM_dyn_horgrid IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. - areaCv !< The areas of the v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. 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]. geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxBu, & !< dxBu is delta x at q points [m]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [L-2 ~> m-2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + areaBu, & !< areaBu is the area of a q-cell [L ~> m] + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: gridLatT => NULL() !< The latitude of T points for the purpose of labeling the output axes. @@ -354,10 +354,10 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(L_to_m*G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(L_to_m*G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L*G%dxBu(I,J) * m_to_L*G%dyBu(I,J) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index bba879eec7..28a01d6e68 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -125,15 +125,13 @@ subroutine grid_metrics_chksum(parent, G, US) 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) + call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) 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%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', & - G%dxBu, G%dyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) call hchksum_pair(trim(parent)//': Id[xy]T', & G%IdxT, G%IdyT, G%HI, haloshift=halo) @@ -159,11 +157,9 @@ subroutine grid_metrics_chksum(parent, G, US) call Bchksum(G%geoLonBu, trim(parent)//': geoLonBu',G%HI, haloshift=halo) call Bchksum(G%geoLatBu, trim(parent)//': geoLatBu',G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLonC[uv]', & - G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLonC[uv]', G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLatC[uv]', & - G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLatC[uv]', G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) end subroutine grid_metrics_chksum @@ -371,7 +367,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) + 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) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -522,8 +518,8 @@ 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) = dx_everywhere ; G%IdxBu(I,J) = I_dx - G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy + G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = I_dx + G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = 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 enddo ; enddo @@ -645,10 +641,10 @@ 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) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di -! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) - G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 - G%areaBu(I,J) = m_to_L**2 * G%dxBu(I,J) * G%dyBu(I,J) + 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%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -871,10 +867,10 @@ 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) = ds_di(xq(I,J), yq(I,J), GP) - G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) + 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%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 9a6ecde5d8..cb93a0d589 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1294,9 +1294,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = G%dxBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = L_to_m_scale*G%dxBu(I,J) ; enddo ; enddo call write_field(unit, fields(13), G%Domain%mpp_domain, out_q) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%dyBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = L_to_m_scale*G%dyBu(I,J) ; enddo ; enddo call write_field(unit, fields(14), G%Domain%mpp_domain, out_q) do j=js,je ; do i=is,ie ; out_h(i,j) = G%areaT(i,j) ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 9382fd84fa..3a2e7a06ca 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -580,9 +580,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*US%L_to_m*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*US%L_to_m*G%dxBu(I,J) endif endif enddo @@ -600,9 +600,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*US%L_to_m*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*US%L_to_m*G%dxBu(I,J) endif endif enddo @@ -713,9 +713,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! We will consider using a circulation based calculation of vorticity later. ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) - DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo @@ -738,12 +738,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo @@ -1865,8 +1865,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - CS%DX2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) - CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) + CS%DX2q(I,J) = US%L_to_m**2*G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = US%L_to_m**2*G%dyBu(I,J)*G%dyBu(I,J) + CS%DX_dyBu(I,J) = US%L_to_m*G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = US%L_to_m*G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index b2b63f90ac..f488316592 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1125,8 +1125,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! x = G%geoLonBu y = G%geoLatBu - Idx = G%IdxBu; dx = G%dxBu - Idy = G%IdyBu; dy = G%dyBu + Idx = G%IdxBu; dx = G%US%L_to_m*G%dxBu + Idy = G%IdyBu; dy = G%US%L_to_m*G%dyBu do j=jsh,jeh; do i=ish,ieh do m=1,int(Nsubrays) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d4b0b88313..a2a8a7b682 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1118,9 +1118,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif do J=js-1,Jeq ; do I=is-1,Ieq - CS%f2_dx2_q(I,J) = ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * & + CS%f2_dx2_q(I,J) = US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) - CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & + CS%beta_dx2_q(I,J) = oneOrTwo * US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & From dc6c85b3d0269214af3b13d3f6f13aff0b3a5d0d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Aug 2019 06:51:57 -0400 Subject: [PATCH 024/104] +Rescaled the units of G%IdxBu and G%IdyBu Rescaled G%IdxBu and G%IdyBu throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_grid.F90 | 8 +- src/core/MOM_open_boundary.F90 | 88 +++++++++---------- src/framework/MOM_dyn_horgrid.F90 | 8 +- src/initialization/MOM_grid_initialize.F90 | 7 +- .../lateral/MOM_hor_visc.F90 | 42 ++++----- .../lateral/MOM_internal_tides.F90 | 4 +- 6 files changed, 78 insertions(+), 79 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 9e17faf006..0c736d56f0 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -117,9 +117,9 @@ module MOM_grid geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. dxBu, & !< dxBu is delta x at q points [L ~> m]. - IdxBu, & !< 1/dxBu [m-1]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. dyBu, & !< dyBu is delta y at q points [L ~> m]. - IdyBu, & !< 1/dyBu [m-1]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. @@ -446,8 +446,8 @@ subroutine set_derived_metrics(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 078a915871..5689d48231 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1698,16 +1698,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%IdxBu(I-1,J) +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & - rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1773,8 +1773,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) & + + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -1894,16 +1894,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%IdxBu(I+1,J) +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & - rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1969,8 +1969,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) & + + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2091,16 +2091,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1)) +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = v_new(i,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & - rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2166,8 +2166,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) & - + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) & + + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) - & (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2287,16 +2287,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%IdyBu(I,J+1) +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%US%m_to_L*G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = v_new(i,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = v_new(i+1,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i+1,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & - rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2362,8 +2362,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) & - + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) & + + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) - & (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2491,10 +2491,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & - (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) - segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & - (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%US%m_to_L*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%US%m_to_L*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) enddo enddo endif @@ -2517,10 +2517,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & - (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) - segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & - (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%US%m_to_L*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%US%m_to_L*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) enddo enddo endif @@ -2545,10 +2545,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & - (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) - segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & - (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%US%m_to_L*G%IdxBu(I,J-2)) - & + (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%US%m_to_L*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) + segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%US%m_to_L*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) enddo enddo endif @@ -2571,10 +2571,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & - (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) - segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & - (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%US%m_to_L*G%IdxBu(I,J+2)) - & + (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%US%m_to_L*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) + segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%US%m_to_L*G%IdxBu(I,J+1)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%US%m_to_L*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) enddo enddo endif diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 3883dc9011..36eec12226 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -113,9 +113,9 @@ module MOM_dyn_horgrid geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. dxBu, & !< dxBu is delta x at q points [L ~> m]. - IdxBu, & !< 1/dxBu [m-1]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. dyBu, & !< dyBu is delta y at q points [L ~> m]. - IdyBu, & !< 1/dyBu [m-1]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. areaBu, & !< areaBu is the area of a q-cell [L ~> m] IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. @@ -354,8 +354,8 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(L_to_m*G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(L_to_m*G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 28a01d6e68..7293152f71 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -142,8 +142,7 @@ subroutine grid_metrics_chksum(parent, G, US) call uvchksum(trim(parent)//': Id[xy]C[uv]', & G%IdyCu, G%IdxCv, G%HI, haloshift=halo) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', & - G%IdxBu, G%IdyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=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) @@ -518,8 +517,8 @@ 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) = I_dx - G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = I_dy + 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 enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3a2e7a06ca..7a5153bec5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -713,9 +713,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! We will consider using a circulation based calculation of vorticity later. ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) - DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo @@ -738,12 +738,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo @@ -1321,17 +1321,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & - (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & +str_xy(I-1,J-1)*( & - (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & +(str_xy(I-1,J)*( & - (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & +str_xy(I,J-1)*( & - (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) enddo ; enddo ; endif ! Make a similar calculation as for FrictWork above but accumulating into @@ -1372,17 +1372,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & - (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & +(str_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1))*( & - (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & +((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J))*( & - (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & +(str_xy(I,J-1)-RoScl*bhstr_xy(I,J-1))*( & - (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) enddo ; enddo else do j=js,je ; do i=is,ie @@ -1866,7 +1866,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 CS%DX2q(I,J) = US%L_to_m**2*G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = US%L_to_m**2*G%dyBu(I,J)*G%dyBu(I,J) - CS%DX_dyBu(I,J) = US%L_to_m*G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = US%L_to_m*G%dyBu(I,J)*G%IdxBu(I,J) + CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index f488316592..002f8034db 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1125,8 +1125,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! x = G%geoLonBu y = G%geoLatBu - Idx = G%IdxBu; dx = G%US%L_to_m*G%dxBu - Idy = G%IdyBu; dy = G%US%L_to_m*G%dyBu + Idx = G%US%m_to_L*G%IdxBu ; dx = G%US%L_to_m*G%dxBu + Idy = G%US%m_to_L*G%IdyBu ; dy = G%US%L_to_m*G%dyBu do j=jsh,jeh; do i=ish,ieh do m=1,int(Nsubrays) From e1081a5a276d0e1eba07872d520f44d929aa12fe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Aug 2019 08:28:44 -0400 Subject: [PATCH 025/104] +Rescaled the units of G%IdxT and G%IdyT Rescaled G%IdxT and G%IdyT throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- config_src/mct_driver/ocn_cap_methods.F90 | 8 +++---- config_src/nuopc_driver/mom_cap_methods.F90 | 8 +++---- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 16 ++++++------- src/core/MOM_grid.F90 | 8 +++---- src/diagnostics/MOM_diagnostics.F90 | 6 ++--- src/framework/MOM_dyn_horgrid.F90 | 8 +++---- src/initialization/MOM_grid_initialize.F90 | 7 +++--- .../MOM_shared_initialization.F90 | 7 ++++-- .../lateral/MOM_hor_visc.F90 | 10 ++++---- .../lateral/MOM_internal_tides.F90 | 24 +++++++++---------- 11 files changed, 53 insertions(+), 51 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 7723f51a6c..2a23621c6f 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -217,7 +217,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! d/dx ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. @@ -235,14 +235,14 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshx(i,j) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + sshx(i,j) = slope * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 enddo; enddo ! d/dy ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. @@ -262,7 +262,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshy(i,j) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + sshy(i,j) = slope * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 enddo; enddo diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e6bdbea307..3ece152f7f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -564,7 +564,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! d/dx ssh ! This is a simple second-order difference - ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -587,14 +587,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + dhdx(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 enddo enddo ! d/dy ssh ! This is a simple second-order difference - ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -617,7 +617,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + dhdy(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 enddo enddo diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 515bba15d9..cdeccff4d5 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1399,7 +1399,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_S(i,j) * (Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) - H_eff_dx2 = max(H_min_dyn * ((US%L_to_m*G%IdxT(i,j))**2 + (US%L_to_m*G%IdyT(i,j))**2), & + H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j))**2 + (G%IdyT(i,j))**2), & G%IareaT(i,j) * & ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) ) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d606bbdb0f..979edadcb0 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -540,14 +540,14 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, ! Set new values of uh and duhdu. if (u(I) > 0.0) then if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif + else ; CFL = u(I) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif + else ; CFL = -u(I) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) @@ -615,13 +615,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif + else ; CFL = u(I,j,k) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif + else ; CFL = -u(I,j,k) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -1338,7 +1338,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif + else ; CFL = v(i) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) @@ -1346,7 +1346,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif + else ; CFL = -v(i) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) @@ -1415,14 +1415,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif + else ; CFL = v(i,J,k) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif + else ; CFL = -v(i,J,k) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 0c736d56f0..3ec744533a 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -78,9 +78,9 @@ module MOM_grid geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. dxT, & !< dxT is delta x at h points [L ~> m]. - IdxT, & !< 1/dxT [m-1]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. - IdyT, & !< IdyT is 1/dyT [m-1]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward @@ -423,8 +423,8 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 03bbec78fb..a84916aae2 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -641,19 +641,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CS%cfl_cg1(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CS%cfl_cg1_x(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdxT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CS%cfl_cg1_y(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdyT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) endif diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 36eec12226..ae0018d9ba 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -72,9 +72,9 @@ module MOM_dyn_horgrid geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. dxT, & !< dxT is delta x at h points [L ~> m]. - IdxT, & !< 1/dxT [m-1]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. - IdyT, & !< IdyT is 1/dyT [m-1]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT !< 1/areaT [L-2 ~> m-2]. real, allocatable, dimension(:,:) :: sin_rot @@ -331,8 +331,8 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(L_to_m*G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(L_to_m*G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7293152f71..7bf2295b15 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -133,8 +133,7 @@ subroutine grid_metrics_chksum(parent, G, US) call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) - call hchksum_pair(trim(parent)//': Id[xy]T', & - G%IdxT, G%IdyT, G%HI, haloshift=halo) + call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, haloshift=halo, scale=m_to_L) call uvchksum(trim(parent)//': Id[xy]C[uv]', & G%IdxCu, G%IdyCv, G%HI, haloshift=halo) @@ -524,8 +523,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = I_dx - G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = I_dy + 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 enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index cb93a0d589..35a590c753 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -96,8 +96,11 @@ 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. @@ -108,10 +111,10 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) do j=G%jsc, G%jec ; do i=G%isc, G%iec f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) f2 = 0.5*( G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1) ) - dF_dx(i,j) = G%IdxT(i,j) * ( f1 - f2 ) + dF_dx(i,j) = m_to_L*G%IdxT(i,j) * ( f1 - f2 ) f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) f2 = 0.5*( G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1) ) - dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) + dF_dy(i,j) = m_to_L*G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) end subroutine MOM_calculate_grad_Coriolis diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7a5153bec5..eab5b8af63 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1318,8 +1318,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) ! This is the old formulation that includes energy diffusion FrictWork(i,j,k) = US%s_to_T*GV%H_to_kg_m2 * ( & - (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & - -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & + (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & + -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & @@ -1369,8 +1369,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%s_to_T*GV%H_to_kg_m2 * ( & - ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & - -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & + ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & + -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & @@ -1870,7 +1870,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) - CS%DX_dyT(i,j) = US%L_to_m*G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = US%L_to_m*G%dyT(i,j)*G%IdxT(i,j) + CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 002f8034db..e5ecb275a3 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -796,20 +796,20 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & + df2_dx = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdxT(i,j) - df_dx = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + df_dx = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & G%IdxT(i,j) dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & + df2_dy = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdyT(i,j) - df_dy = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + df_dy = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & G%IdyT(i,j) dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & @@ -1536,14 +1536,14 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) - else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i,j)) + else ; CFL = u(I) * dt * US%m_to_L*G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt * US%m_to_L*G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hL(i+1) + CFL * (0.5*(hR(i+1)-hL(i+1)) + curv_3*(CFL - 1.5))) @@ -1580,14 +1580,14 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) - else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j)) + else ; CFL = v(i) * dt * US%m_to_L*G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt * US%m_to_L*G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) From 4bf27c6b6c8cffe0ea7e18b469c59e01535d33a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 06:00:45 -0400 Subject: [PATCH 026/104] +Rescaled the units of G%IdyCu and G%IdxCv Rescaled G%IdyCu and G%IdxCv throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 16 ++--- src/core/MOM_grid.F90 | 8 +-- src/diagnostics/MOM_PointAccel.F90 | 16 ++--- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 8 +-- src/initialization/MOM_grid_initialize.F90 | 7 +- .../MOM_shared_initialization.F90 | 2 +- .../lateral/MOM_hor_visc.F90 | 68 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 36 +++++----- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- 11 files changed, 86 insertions(+), 87 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 2cce10933d..343acd461d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -618,16 +618,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k) * US%L_to_m*G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) + Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k) * US%L_to_m*G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) + Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k) * US%L_to_m*G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) + Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k) * US%L_to_m*G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) + Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then @@ -724,16 +724,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k) * US%L_to_m*G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) + Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k) * US%L_to_m*G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) + Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k) * US%L_to_m*G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) + Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k) * US%L_to_m*G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) + Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 3ec744533a..6b642d3b80 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -95,7 +95,7 @@ module MOM_grid dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. - IdyCu, & !< 1/dyCu [m-1]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [L2 ~> m2]. @@ -105,7 +105,7 @@ module MOM_grid geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [L ~> m]. - IdxCv, & !< 1/dxCv [m-1]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. @@ -432,13 +432,13 @@ subroutine set_derived_metrics(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index ca89dfc1c4..9d4242bfdc 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -285,7 +285,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo @@ -297,7 +297,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo @@ -309,7 +309,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo @@ -321,7 +321,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo @@ -619,7 +619,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo @@ -631,7 +631,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo @@ -643,7 +643,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo @@ -655,7 +655,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)*US%m_to_L*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index a84916aae2..a2bd76766c 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -629,7 +629,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((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 + & @@ -678,7 +678,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((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 + & diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index ae0018d9ba..f72950e9ed 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -91,7 +91,7 @@ module MOM_dyn_horgrid dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. - IdyCu, & !< 1/dyCu [m-1]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [L2 ~> m2]. @@ -101,7 +101,7 @@ module MOM_dyn_horgrid geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. dxCv, & !< dxCv is delta x at v points [L ~> m]. - IdxCv, & !< 1/dxCv [m-1]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. @@ -340,13 +340,13 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(L_to_m*G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(L_to_m*G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7bf2295b15..310c665c3d 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -138,8 +138,7 @@ subroutine grid_metrics_chksum(parent, G, US) call uvchksum(trim(parent)//': Id[xy]C[uv]', & G%IdxCu, G%IdyCv, G%HI, haloshift=halo) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdyCu, G%IdxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, 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=m_to_L) @@ -532,13 +531,13 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = I_dx - G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = I_dy + G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*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) = I_dx + 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) = I_dy enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 35a590c753..716bc544e7 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -672,7 +672,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. - dy_2 = dx_2 * L_to_m*G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) + 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. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index eab5b8af63..15cd33a9cd 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -432,9 +432,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#GME# The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 do j=js,je ; do i=is,ie - dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & + dudx_bt(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) - dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & + dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo @@ -527,9 +527,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Calculate horizontal tension do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - dudx(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & + dudx(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * u(I,j,k) - & G%IdyCu(I-1,j) * u(I-1,j,k)) - dvdy(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & + dvdy(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * v(i,J,k) - & G%IdxCv(i,J-1) * v(i,J-1,k)) sh_xx(i,j) = dudx(i,j) - dvdy(i,j) enddo ; enddo @@ -739,12 +739,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) @@ -953,13 +953,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & + CS%DX_dyT(i,j) *US%m_to_L*(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization bhstr_xx(i,j) = Ah * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & + CS%DX_dyT(i,j) *US%m_to_L*(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) endif ! biharmonic @@ -1273,7 +1273,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & + diffu(I,j,k) = ((US%m_to_L*G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & CS%DY2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & CS%DX2q(I,J) *str_xy(I,J))) * & @@ -1297,7 +1297,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=Jsq,Jeq ; do i=is,ie diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & CS%DY2q(I,J) *str_xy(I,J)) - & - G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & + US%m_to_L*G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & US%m_to_L**2*G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo @@ -1967,12 +1967,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) - CS%IDXDY2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) + CS%IDXDY2u(I,j) = G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) - CS%IDXDY2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) + CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) + CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -2035,10 +2035,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) Idt = 1.0 / dt do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & - max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & - max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*G%IareaCv(i,J-1)) ) ) + (CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & + US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + (CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & + US%m_to_L**3*max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * Idt / denom @@ -2064,38 +2064,38 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .and. CS%better_bound_Ah) then Idt = 1.0 / dt do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & - CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & + u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*US%m_to_L*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & + CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) - u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & - CS%DY2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & + u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*US%m_to_L*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & + CS%DY2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & - CS%DX2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*US%m_to_L*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & + CS%DX2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & - CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*US%m_to_L*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & + CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & (CS%DY2h(i,j) * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & - CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & - max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & + CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & + US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & (CS%DX2h(i,j) * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & - CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & - max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*G%IareaCv(i,J-1)) ) ) + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & + CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & + US%m_to_L**3*max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Ah_Max_xx(I,J) = 0.0 if (denom > 0.0) & CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * Idt / denom diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a2a8a7b682..0cf88a7ced 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1121,32 +1121,32 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%f2_dx2_q(I,J) = US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) CS%beta_dx2_q(I,J) = oneOrTwo * US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & - ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & - (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2) ) )) + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & + ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & + (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2) ) )) enddo ; enddo do j=js,je ; do I=is-1,Ieq CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * (sqrt( & - 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & - ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & - (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) ) + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 )) + 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2 + & + ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & + (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdxCv(i+1,J-1))**2 + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2) ) + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 )) enddo ; enddo do J=js-1,Jeq ; do i=is,ie CS%f2_dx2_v(i,J) = ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) CS%beta_dx2_v(i,J) = oneOrTwo * ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & - 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & - (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & + 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdyCu(I-1,j+1))**2) + & + (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif @@ -1167,10 +1167,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) CS%beta_dx2_h(i,j) = oneOrTwo * ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*G%dyT(i,j))**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & - ((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) ) )) + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & + ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2) + & + (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index c1520e68d7..574d478590 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -526,14 +526,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_uml > 0) then do J=js,je ; do i=is-1,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) - uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) + uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * US%m_to_L*G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_uml, uDml_diag, CS%diag) endif if (CS%id_vml > 0) then do J=js-1,je ; do i=is,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) - vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) + vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * US%m_to_L*G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_vml, vDml_diag, CS%diag) endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index f5ef54ffd2..4abc826328 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -183,12 +183,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + US%m_to_L**2*G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt*(US%m_to_L**2*G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. From 3130e3620ee556c8722f39af7016e43936657d12 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 13:14:19 -0400 Subject: [PATCH 027/104] +Rescaled the units of G%IdxCu and G%IdyCv Rescaled G%IdxCu and G%IdyCv throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 40 ++++----- src/core/MOM_PressureForce_Montgomery.F90 | 24 ++--- src/core/MOM_PressureForce_analytic_FV.F90 | 16 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 16 ++-- src/core/MOM_barotropic.F90 | 28 +++--- src/core/MOM_grid.F90 | 8 +- src/core/MOM_isopycnal_slopes.F90 | 10 +-- src/diagnostics/MOM_PointAccel.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 8 +- src/initialization/MOM_grid_initialize.F90 | 7 +- .../MOM_shared_initialization.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 42 ++++----- .../lateral/MOM_hor_visc.F90 | 88 ++++++++++--------- .../lateral/MOM_internal_tides.F90 | 8 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_mixed_layer_restrat.F90 | 12 +-- .../lateral/MOM_thickness_diffuse.F90 | 38 ++++---- src/tracer/MOM_tracer_hor_diff.F90 | 24 ++--- src/user/MOM_controlled_forcing.F90 | 12 +-- 20 files changed, 200 insertions(+), 195 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 343acd461d..9d27542e75 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -590,19 +590,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J-1) * (vh_min(i,j-1)+vh_min(i+1,j-1)) endif - CAu(I,j,k) = 0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) + CAu(I,j,k) = 0.25 * G%IdxCu(I,j) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = 0.25 * & (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & - q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.125 * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & + CAu(I,j,k) = 0.125 * (G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & ((vh(i+1,J,k) + vh(i,J,k)) + (vh(i,J-1,k) + vh(i+1,J-1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -611,7 +611,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + & - (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers @@ -633,12 +633,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) / & - (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) + (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * G%IdxCu(I,j) endif enddo ; enddo endif @@ -646,7 +646,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) 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) + & - (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * US%L_to_m*G%IdxCu(I,j) + (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * G%IdxCu(I,j) enddo ; enddo ; endif @@ -694,19 +694,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = -0.25 * US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do J=Jsq,Jeq ; do i=is,ie CAv(i,J,k) = - 0.25* & (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) + q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = -0.125 * (US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & + CAv(i,J,k) = -0.125 * (G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & ((uh(I-1,j,k) + uh(I-1,j+1,k)) + (uh(I,j,k) + uh(I,j+1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -717,7 +717,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + & c(I,j+1) * uh(I,j+1,k)) & + (b(I,j) * uh(I,j,k) + & - d(I-1,j+1) * uh(I-1,j+1,k))) * US%L_to_m*G%IdyCv(i,J) + d(I-1,j+1) * uh(I-1,j+1,k))) * G%IdyCv(i,J) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers @@ -740,14 +740,14 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then UHeff = ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff & -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) ) CAv(i,J,k) = - QUHeff / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) endif enddo ; enddo endif @@ -755,7 +755,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie CAv(i,J,k) = CAv(i,J,k) + & - (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * US%L_to_m*G%IdyCv(i,J) + (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * G%IdyCv(i,J) enddo ; enddo ; endif if (CS%bound_Coriolis) then @@ -783,7 +783,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq,Jeq ; do i=is,ie AD%rv_x_u(i,J,k) = - 0.25* & (q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) + q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) enddo ; enddo endif @@ -791,13 +791,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do j=js,je ; do I=Isq,Ieq AD%rv_x_v(I,j,k) = 0.25 * & (q2(I,j) * (vh(i+1,J,k) + vh(i,J,k)) + & - q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo endif else if (associated(AD%rv_x_u)) then do J=Jsq,Jeq ; do i=is,ie - AD%rv_x_u(i,J,k) = -US%L_to_m*G%IdyCv(i,J) * C1_12 * & + AD%rv_x_u(i,J,k) = -G%IdyCv(i,J) * C1_12 * & ((q2(I,J) + q2(I-1,J) + q2(I-1,J-1)) * uh(I-1,j,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * uh(I,j,k) + & (q2(I-1,J) + q2(I,J+1) + q2(I,J)) * uh(I,j+1,k) + & @@ -807,7 +807,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (associated(AD%rv_x_v)) then do j=js,je ; do I=Isq,Ieq - AD%rv_x_v(I,j,k) = US%L_to_m*G%IdxCu(I,j) * C1_12 * & + AD%rv_x_v(I,j,k) = G%IdxCu(I,j) * C1_12 * & ((q2(I+1,J) + q2(I,J) + q2(I,J-1)) * vh(i+1,J,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * vh(i,J,k) + & (q2(I-1,J-1) + q2(I,J) + q2(I,J-1)) * vh(i,J-1,k) + & @@ -893,12 +893,12 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * US%L_to_m*G%IdxCu(I,j) + KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * US%L_to_m*G%IdyCv(i,J) + KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) enddo ; enddo if (associated(OBC)) then diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 05ac089c34..9bb0a02606 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -320,17 +320,17 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & + PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & ((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)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdyCv(i,J) * & + PFv_bc = US%m_s_to_L_T**2*(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)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc + 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 enddo ; enddo enddo ! k-loop @@ -338,10 +338,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS @@ -552,17 +552,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect enddo ; enddo do j=js,je ; do I=Isq,Ieq - PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & + PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (G%IdxCu(I,j) * & ((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)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdyCv(i,J) * & + 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)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc + 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 enddo ; enddo enddo ! k-loop @@ -570,10 +570,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index e4710a42a8..f84b8e780e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -384,7 +384,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) @@ -394,7 +394,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo @@ -402,11 +402,11 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! Adjust the Montgomery potential to make this a reduced gravity model. !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo endif enddo @@ -722,7 +722,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) enddo ; enddo @@ -733,7 +733,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) enddo ; enddo @@ -747,11 +747,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at do k=1,nz !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo enddo endif diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c3972a0ffe..773bcefc1d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -365,7 +365,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk @@ -375,17 +375,17 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo endif enddo @@ -716,7 +716,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) enddo ; enddo @@ -727,7 +727,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) enddo ; enddo @@ -739,10 +739,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (CS%GFS_scale < 1.0) then do k=1,nz do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cdeccff4d5..b7b1e2847c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1393,16 +1393,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! gravity waves, but it is a conservative estimate since it ignores the ! stabilizing effect of the bottom drag. Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (G%IareaT(i,j) * & - ((gtot_E(i,j) * (Datu(I,j)*US%L_to_m*G%IdxCu(I,j)) + & - gtot_W(i,j) * (Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j))) + & - (gtot_N(i,j) * (Datv(i,J)*US%L_to_m*G%IdyCv(i,J)) + & - gtot_S(i,j) * (Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)))) + & + ((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j)) + & + gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + & + (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + & + gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j))**2 + (G%IdyT(i,j))**2), & G%IareaT(i,j) * & - ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & - (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) ) + ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + & + (Datv(i,J)*G%IdyCv(i,J) + Datv(i,J-1)*G%IdyCv(i,J-1)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & (dtbt**2 * H_eff_dx2) @@ -2351,8 +2351,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! This is pretty accurate for gravity waves, but it is a conservative ! estimate since it ignores the stabilizing effect of the bottom drag. Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & - ((gtot_E(i,j)*Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & - (gtot_N(i,j)*Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1))) + & + ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + & + (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2 @@ -2449,7 +2449,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = ubt(I,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal H_u = BT_OBC%H_u(I,j) @@ -2463,7 +2463,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external @@ -2499,7 +2499,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = vbt(i,J) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal @@ -2515,7 +2515,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal @@ -4085,10 +4085,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) + CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J) + CS%IdyCv(I,j) = G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J) enddo ; enddo call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All) call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 6b642d3b80..e7048cb2d3 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -93,7 +93,7 @@ module MOM_grid geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. - IdxCu, & !< 1/dxCu [m-1]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. @@ -107,7 +107,7 @@ module MOM_grid dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. - IdyCv, & !< 1/dyCv [m-1]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. @@ -431,7 +431,7 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -439,7 +439,7 @@ subroutine set_derived_metrics(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index ab5ce700a7..18c47b3e90 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -157,7 +157,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ; enddo enddo - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & @@ -223,7 +223,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -237,7 +237,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) endif enddo ! I @@ -307,7 +307,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -321,7 +321,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) endif enddo ! i diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9d4242bfdc..f5ddab01bc 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -180,7 +180,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * dt * US%m_to_L*G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') @@ -511,7 +511,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * dt * US%m_to_L*G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d03fa1ffef..12d5e3c971 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -717,7 +717,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ else CFL_trans = (u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * CS%dt) * US%m_to_L*G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo @@ -727,7 +727,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ else CFL_trans = (v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * CS%dt) * US%m_to_L*G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index f72950e9ed..1a1e9cbf43 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -89,7 +89,7 @@ module MOM_dyn_horgrid geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. - IdxCu, & !< 1/dxCu [m-1]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. @@ -103,7 +103,7 @@ module MOM_dyn_horgrid dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. - IdyCv, & !< 1/dyCv [m-1]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. @@ -339,7 +339,7 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -347,7 +347,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 310c665c3d..1c594f45c1 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -135,8 +135,7 @@ subroutine grid_metrics_chksum(parent, G, US) call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, haloshift=halo, scale=m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdxCu, G%IdyCv, G%HI, haloshift=halo) + 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%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) @@ -530,7 +529,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = I_dx + 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 enddo ; enddo @@ -538,7 +537,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) 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) = I_dy + G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = L_to_m*I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 716bc544e7..1dac4295b8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -647,7 +647,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) 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 * L_to_m*G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) + 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)) & diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 39846b81a8..b1307efd98 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -364,17 +364,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 - MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) - ! MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + ! MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 - MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) - ! MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + ! MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo @@ -392,22 +392,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max - MEKE_uflux(I,j) = ((K4_here * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((K4_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max - MEKE_vflux(i,J) = ((K4_here * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((K4_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo @@ -431,12 +431,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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)) & 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 * ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo @@ -446,12 +446,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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)) & 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 * ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo @@ -656,14 +656,15 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !### Consider different combinations of these estimates of topographic beta, and the use ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & + (G%bathyT(i+1,j)-G%bathyT(i,j)) * US%m_to_L*G%IdxCu(I,j) & /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif @@ -803,14 +804,15 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & !### Consider different combinations of these estimates of topographic beta, and the use ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & + (G%bathyT(i+1,j)-G%bathyT(i,j)) * US%m_to_L*G%IdxCu(I,j) & /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 15cd33a9cd..951a45de5e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -450,9 +450,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Components for the barotropic shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) - dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo @@ -536,8 +536,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Components for the shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo ! Interpolate the thicknesses to velocity points. @@ -574,15 +574,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & + (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*US%L_to_m*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*US%L_to_m*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -594,15 +596,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & + (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*US%L_to_m*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*US%L_to_m*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) endif endif enddo @@ -714,9 +718,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) + dvdx(I,J) = DY_dxBu * US%m_to_L*(v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) + dudy(I,J) = DX_dyBu * US%m_to_L*(u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo ! Vorticity @@ -766,11 +770,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Divergence gradient !#GME# This index range should be: do j=Jsq,Jeq+1 ; do I=Isq-1,Ieq+1 do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + div_xx_dx(I,j) = US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo !#GME# This index range should be: do j=Jsq-1,Jeq+1 ; do i=Isq,Ieq+1 do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + div_xx_dy(i,J) = US%m_to_L*G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) enddo ; enddo !#GME# With the correct index ranges, this halo update is unnecessary. @@ -969,8 +973,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -1275,7 +1279,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((US%m_to_L*G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & CS%DY2h(i+1,j)*str_xx(i+1,j)) + & - G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & + US%m_to_L*G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & CS%DX2q(I,J) *str_xy(I,J))) * & US%m_to_L**2*G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) @@ -1295,7 +1299,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & + diffv(i,J,k) = ((US%m_to_L*G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & CS%DY2q(I,J) *str_xy(I,J)) - & US%m_to_L*G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & @@ -1967,12 +1971,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) - CS%IDXDY2u(I,j) = G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%IDX2dyCu(I,j) = (US%m_to_L*G%IdxCu(I,j)*US%m_to_L*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) + CS%IDXDY2u(I,j) = US%m_to_L*G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) - CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) + CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * US%m_to_L*G%IdyCv(i,J) + CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (US%m_to_L*G%IdyCv(i,J)*US%m_to_L*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -2045,10 +2049,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & - max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & - max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*G%IareaCv(i+1,J)) ) ) + (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & + US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & + US%m_to_L**3*max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom @@ -2066,22 +2070,22 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*US%m_to_L*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) + CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*US%m_to_L*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*US%m_to_L*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & CS%DY2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) + CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*US%m_to_L*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & + v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*US%m_to_L*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*US%m_to_L*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & CS%DX2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) - v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & + v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*US%m_to_L*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*US%m_to_L*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) enddo ; enddo @@ -2104,13 +2108,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & (CS%DX2q(I,J) * & - (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & - max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & + (CS%DX_dyBu(I,J)*US%m_to_L*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*US%m_to_L*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & + US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & (CS%DY2q(I,J) * & - (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & - max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*G%IareaCv(i+1,J)) ) ) + (CS%DX_dyBu(I,J)*US%m_to_L*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*US%m_to_L*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & + US%m_to_L**3*max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Ah_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index e5ecb275a3..5a6837c1ad 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -802,9 +802,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) df_dx = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & G%IdxT(i,j) - dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & + dlnCn_dx = 0.5*( US%m_to_L*G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & - G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & + US%m_to_L*G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) df2_dy = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & @@ -812,9 +812,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) df_dy = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & G%IdyT(i,j) - dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & + dlnCn_dy = 0.5*( US%m_to_L*G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & (0.5*(cn(i,j+1) + cn(i,j)) + cn_subRO) + & - G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & + US%m_to_L*G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & (0.5*(cn(i,j) + cn(i,j-1)) + cn_subRO) ) Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cn_subRO**2) if (Kmag2 > 0.0) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0cf88a7ced..2768e3034d 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -622,12 +622,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*US%m_to_L*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*US%m_to_L*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 574d478590..4e1b257c31 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -373,7 +373,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -382,7 +382,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -449,7 +449,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -458,7 +458,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -666,7 +666,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -713,7 +713,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 4abc826328..671bdb1225 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -183,12 +183,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + US%m_to_L**2*G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt*US%m_to_L**2*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*(US%m_to_L**2*G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt*US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -804,7 +804,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -822,7 +822,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif @@ -857,7 +857,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) @@ -922,7 +922,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_x(I,j,K) = max(uhtot(I,j)-h_avail(i+1,j,k), & ! min(uhtot(I,j)+h_avail(i,j,k), & ! min(h_avail_rsum(i+1,j,K), max(-h_avail_rsum(i,j,K), & -! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) +! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1053,7 +1053,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -1071,7 +1071,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif @@ -1106,7 +1106,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) @@ -1171,7 +1171,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_y(i,J,K) = max(vhtot(i,J)-h_avail(i,j+1,k), & ! min(vhtot(i,J)+h_avail(i,j,k), & ! min(h_avail_rsum(i,j+1,K), max(-h_avail_rsum(i,j,K), & -! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) +! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1536,8 +1536,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV adH = abs(dH) sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) - sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) + sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) + sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) ! Add the incremental diffusivites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1559,8 +1559,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV adH = abs(dH) sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) - sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) + sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) + sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) ! Add the incremental diffusviites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1681,8 +1681,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! if (n==1) then ! u-point. ! if ((h(i+1,j,k) - h(i,j,k)) * & ! ((e(i+1,j,K)-e(i+1,j,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) -! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) +! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) +! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dy_Cu(I,j) ! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then @@ -1701,8 +1701,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! else ! v-point ! if ((h(i,j+1,k) - h(i,j,k)) * & ! ((e(i,j+1,K)-e(i,j+1,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) -! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) +! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) +! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dx_Cv(i,J) ! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then @@ -1719,7 +1719,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! endif ! endif ! endif ! u- or v- selection. -! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) +! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) ! endif ! enddo ! enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 534c3c20ae..b279c20d8c 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -244,48 +244,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -297,8 +297,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max - if (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + if (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) > 0.0) & + Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) endif enddo ; enddo else @@ -314,8 +314,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max - if (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + if (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) > 0.0) & + Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) endif enddo ; enddo else diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index be130a2a06..bace6f6e40 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -136,12 +136,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec call pass_var(CS%precip_0, G%Domain) do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_0(i,j) - CS%heat_0(i+1,j)) flux_prec_x(I,j) = coef * (CS%precip_0(i,j) - CS%precip_0(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_0(i,j) - CS%heat_0(i,j+1)) flux_prec_y(i,J) = coef * (CS%precip_0(i,j) - CS%precip_0(i,j+1)) enddo ; enddo @@ -320,12 +320,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i+1,j,m_u1)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i+1,j,m_u1)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i,j+1,m_u1)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i,j+1,m_u1)) enddo ; enddo @@ -345,12 +345,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((wt_per1 < 1.0) .and. (CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i+1,j,m_u2)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i+1,j,m_u2)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i,j+1,m_u2)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i,j+1,m_u2)) enddo ; enddo From 37a570a9c2ffde258e2092d8369afabad17e6f5e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:27:35 -0400 Subject: [PATCH 028/104] Simplified rescaling in MOM_sum_output.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_sum_output.F90. All answers are bitwise identical. --- src/diagnostics/MOM_sum_output.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 12d5e3c971..d2c21551ce 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -664,7 +664,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*(GV%Rho0*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -673,7 +673,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*(GV%Rho0*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -713,21 +713,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL_trans = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * CS%dt) * US%m_to_L*G%IdxCu(I,j) + CFL_lin = abs(US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL_trans = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * CS%dt) * US%m_to_L*G%IdyCv(i,J) + CFL_lin = abs(US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo From 7b11e002b3363987c74f7a02d0abf2ae29cb8f59 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:27:56 -0400 Subject: [PATCH 029/104] Simplified rescaling in MOM_controlled_forcing.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_controlled_forcing.F90. All answers are bitwise identical. --- src/user/MOM_controlled_forcing.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index bace6f6e40..cbfce62f39 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -136,12 +136,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec call pass_var(CS%precip_0, G%Domain) do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) + coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_0(i,j) - CS%heat_0(i+1,j)) flux_prec_x(I,j) = coef * (CS%precip_0(i,j) - CS%precip_0(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) + coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_0(i,j) - CS%heat_0(i,j+1)) flux_prec_y(i,J) = coef * (CS%precip_0(i,j) - CS%precip_0(i,j+1)) enddo ; enddo @@ -320,12 +320,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) + coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i+1,j,m_u1)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i+1,j,m_u1)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) + coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i,j+1,m_u1)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i,j+1,m_u1)) enddo ; enddo @@ -345,12 +345,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((wt_per1 < 1.0) .and. (CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) + coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i+1,j,m_u2)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i+1,j,m_u2)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) + coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i,j+1,m_u2)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i,j+1,m_u2)) enddo ; enddo From b72dd75692ddd56df516745dd650712d607a0c27 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:28:51 -0400 Subject: [PATCH 030/104] Simplified rescaling in MOM_MEKE.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_MEKE.F90. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 34 +++++++++++----------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index b1307efd98..20caf163a4 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -237,11 +237,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*US%m_to_L**2*G%IareaT(i,j) * & - ((US%L_to_m**2*G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & - US%L_to_m**2*G%areaCu(I,j)*drag_vel_u(I,j)) + & - (US%L_to_m**2*G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & - US%L_to_m**2*G%areaCv(i,J)*drag_vel_v(i,J)) ) ) + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & + G%areaCu(I,j)*drag_vel_u(I,j)) + & + (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & + G%areaCv(i,J)*drag_vel_v(i,J)) ) ) enddo ; enddo else !$OMP parallel do default(shared) @@ -364,17 +364,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 - MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) - ! MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & + ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 - MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) - ! MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & + ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo @@ -392,22 +392,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & + Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max - MEKE_uflux(I,j) = ((K4_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & + Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max - MEKE_vflux(i,J) = ((K4_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo @@ -431,12 +431,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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)) & 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 * ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & + Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo @@ -446,12 +446,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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)) & 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 * ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & + Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo From 77692a3defbc5da2892f27a3214ddc232d3466ed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:29:12 -0400 Subject: [PATCH 031/104] Simplified rescaling in MOM_hor_visc.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_hor_visc.F90. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 951a45de5e..2162e373fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -756,10 +756,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*((US%L_to_m*G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - US%L_to_m*G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (US%L_to_m*G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - US%L_to_m*G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & + div_xx(i,j) = 0.5*US%m_to_L*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -1879,34 +1879,34 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) - if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j)) .and. & - (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (US%L_to_m*G%dyCu(I-1,j)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) - if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1)) .and. & - (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (US%L_to_m*G%dxCv(i,J-1)) + if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & + (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) + if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & + (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) - if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1)) .and. & - (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (US%L_to_m*G%dyCu(I,j+1)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) - if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J)) .and. & - (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (US%L_to_m*G%dxCv(i+1,J)) + if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & + (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) + if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & + (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then From 587e988ef69cfc27b4a47f38add72abdf54996e1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:29:34 -0400 Subject: [PATCH 032/104] Simplified rescaling in MOM_thickness_diffuse.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_thickness_diffuse.F90. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 671bdb1225..4bc664859d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -922,7 +922,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_x(I,j,K) = max(uhtot(I,j)-h_avail(i+1,j,k), & ! min(uhtot(I,j)+h_avail(i,j,k), & ! min(h_avail_rsum(i+1,j,K), max(-h_avail_rsum(i,j,K), & -! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) )) )) +! (KH_u(I,j,K)*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1171,7 +1171,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_y(i,J,K) = max(vhtot(i,J)-h_avail(i,j+1,k), & ! min(vhtot(i,J)+h_avail(i,j,k), & ! min(h_avail_rsum(i,j+1,K), max(-h_avail_rsum(i,j,K), & -! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) )) )) +! (KH_v(i,J,K)*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1526,7 +1526,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dy_Cu(I,j)) + denom = US%m_to_L * ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1551,7 +1551,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dx_Cv(I,j)) + denom = US%m_to_L * ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom From 57c2343c5e6054316c68db200a677d8c0ac3e0f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:30:04 -0400 Subject: [PATCH 033/104] Simplified rescaling in MOM_set_diffusivity.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_set_diffusivity.F90. All answers are bitwise identical. --- .../vertical/MOM_set_diffusivity.F90 | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1059349454..dee3422a7a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1262,12 +1262,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & US%m_to_Z**2 * US%T_to_s**2 * & - ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & - US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & - (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) + ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & + G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & + (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) if (TKE_to_layer + TKE_Ray > 0.0) then if (CS%BBL_mixing_as_max) then @@ -1444,11 +1444,11 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & US%m_to_Z**2 * US%T_to_s**2 * & - 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & - ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & - US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & - (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) + 0.5*CS%BBL_effic * G%IareaT(i,j) * & + ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & + G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & + (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) ! Exponentially decay TKE across the thickness of the layer. ! This is energy loss in addition to work done as mixing, apparently to Joule heating. @@ -1759,16 +1759,16 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) endif ; enddo do i=is,ie - visc%ustar_BBL(i,j) = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j) * & - ((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & - US%L_to_m**2*G%areaCu(I,j)*(ustar(I)*ustar(I))) + & - (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & - US%L_to_m**2*G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) + visc%ustar_BBL(i,j) = sqrt(0.5*G%IareaT(i,j) * & + ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & + G%areaCu(I,j)*(ustar(I)*ustar(I))) + & + (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & + G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) visc%TKE_BBL(i,j) = US%T_to_s**2 * US%m_to_Z**2 * & - (((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & - US%L_to_m**2*G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & - (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & - US%L_to_m**2*G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) + (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & + G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & + (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) enddo enddo !$OMP end parallel From b758eb41d5f03f258f8b95ec5b66b574200ebc54 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:30:25 -0400 Subject: [PATCH 034/104] Simplified rescaling in MOM_vert_friction.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_vert_friction.F90. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ff6d834215..930fcbdc6b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1395,9 +1395,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,11 +1421,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + if ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1441,11 +1441,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1480,9 +1480,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,11 +1506,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) + if ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) + elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1526,11 +1526,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) + elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) + elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo From 606280196825e2e6675bf595ff76aefcb061033a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:30:54 -0400 Subject: [PATCH 035/104] Simplified rescaling in MOM_tracer_hor_diff.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_tracer_hor_diff.F90. All answers are bitwise identical. --- src/tracer/MOM_tracer_hor_diff.F90 | 32 +++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index b279c20d8c..1f4e0b8987 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -244,48 +244,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -294,34 +294,34 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if ((CS%id_KhTr_u > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max - if (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & + Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) khdt_x(I,j) = min(khdt_x(I,j), khdt_max) enddo ; enddo endif if ((CS%id_KhTr_v > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max - if (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & + Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) khdt_y(i,J) = min(khdt_y(i,J), khdt_max) enddo ; enddo endif From 3689eb51a6a3e18612b0506bb26fb1a123265f16 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Aug 2019 18:40:35 -0400 Subject: [PATCH 036/104] Rescaled internal variables in MOM_hor_visc.F90 Rescaled multiple internal variables in MOM_hor_visc.F90 for more complete dimensional consistency testing. One dimensionally inconsistent expression (i.e., a bug) was identified and marked, but the code has not been changed yet so that the answers do not change. It is conceivable that underflow would be an issue in some test cases with out an explicitly set underflow velocity, but all answers in the MOM6-examples test csaes are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 652 +++++++++--------- 1 file changed, 342 insertions(+), 310 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2162e373fa..93c6324025 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -68,14 +68,14 @@ module MOM_hor_visc !! scales quadratically with the velocity shears. logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file. real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal - !! viscosity [m2 T-1 ~> m2 s-1]. The default is 0.0. + !! viscosity [L2 T-1 ~> m2 s-1]. The default is 0.0. logical :: use_land_mask !< 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 is False to maintain answers with legacy experiments !! but should be changed to True for new experiments. logical :: anisotropic !< If true, allow anisotropic component to the viscosity. - real :: Kh_aniso !< The anisotropic viscosity [m2 T-1 ~> m2 s-1]. + real :: Kh_aniso !< The anisotropic viscosity [L2 T-1 ~> m2 s-1]. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by @@ -86,15 +86,15 @@ module MOM_hor_visc !! forms of the same expressions. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx - !< The background Laplacian viscosity at h points [m2 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d - !< The background Laplacian viscosity at h points [m2 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx - !< The background biharmonic viscosity at h points [m4 T-1 ~> m4 s-1]. + !< The background biharmonic viscosity at h points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm5_const2_xx @@ -106,17 +106,17 @@ module MOM_hor_visc !< The amount by which stresses through h points are reduced !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. - Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy - !< The background Laplacian viscosity at q points [m2 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at q points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy - !< The background biharmonic viscosity at q points [m4 T-1 ~> m4 s-1]. + !< The background biharmonic viscosity at q points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm5_const2_xy @@ -128,43 +128,43 @@ module MOM_hor_visc !< The amount by which stresses through q points are reduced !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. - Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - dx2h, & !< Pre-calculated dx^2 at h points [m2] - dy2h, & !< Pre-calculated dy^2 at h points [m2] + dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] + dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] dy_dxT !< Pre-calculated dy/dx at h points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - dx2q, & !< Pre-calculated dx^2 at q points [m2] - dy2q, & !< Pre-calculated dy^2 at q points [m2] + dx2q, & !< Pre-calculated dx^2 at q points [L2 ~> m2] + dy2q, & !< Pre-calculated dy^2 at q points [L2 ~> m2] dx_dyBu, & !< Pre-calculated dx/dy at q points [nondim] dy_dxBu !< Pre-calculated dy/dx at q points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Idx2dyCu, & !< 1/(dx^2 dy) at u points [m-3] - Idxdy2u !< 1/(dx dy^2) at u points [m-3] + Idx2dyCu, & !< 1/(dx^2 dy) at u points [L-3 ~> m-3] + Idxdy2u !< 1/(dx dy^2) at u points [L-3 ~> m-3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Idx2dyCv, & !< 1/(dx^2 dy) at v points [m-3] - Idxdy2v !< 1/(dx dy^2) at v points [m-3] + Idx2dyCv, & !< 1/(dx^2 dy) at v points [L-3 ~> m-3] + Idxdy2v !< 1/(dx dy^2) at v points [L-3 ~> m-3] ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac2_const_xx, & !< Laplacian metric-dependent constants [m2] - Biharm5_const_xx, & !< Biharmonic metric-dependent constants [m5] - Laplac3_const_xx, & !< Laplacian metric-dependent constants [m3] - Biharm_const_xx, & !< Biharmonic metric-dependent constants [m4] - Biharm_const2_xx !< Biharmonic metric-dependent constants [T m4 ~> s m4] + Laplac2_const_xx, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xx, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xx, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xx, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xx !< Biharmonic metric-dependent constants [T L4 ~> s m4] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac2_const_xy, & !< Laplacian metric-dependent constants [m2] - Biharm5_const_xy, & !< Biharmonic metric-dependent constants [m5] - Laplac3_const_xy, & !< Laplacian metric-dependent constants [m3] - Biharm_const_xy, & !< Biharmonic metric-dependent constants [m4] - Biharm_const2_xy !< Biharmonic metric-dependent constants [T m4 ~> s m4] + Laplac2_const_xy, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xy, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xy, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xy, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xy !< Biharmonic metric-dependent constants [T L4 ~> s m4] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -197,14 +197,14 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, & +subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV, US, & CS, OBC, BT) 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_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u_in !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v_in !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -224,69 +224,74 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing !! barotropic velocities. + !### Temporary variables that will be removed later. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u [m-1 s-1] + u0, & ! Laplacian of u [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v [m-1 s-1] + v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] vbtav ! meridional barotropic vel. ave. over baroclinic time-step [m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & - dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [s-1] - div_xx, & ! Estimate of horizontal divergence at h-points [s-1] - sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [s-1] - sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [s-1] - str_xx,& ! str_xx is the diagonal term in the stress tensor [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] - str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] + dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] + div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] + sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution - ! [H m2 T-1 s-1 ~> m3 s-2 or kg s-2] - FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [W m-2] - Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] - Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] - beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] - grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [m-1 s-1] - grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [m-1 s-1] - grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [m-1 s-1] - dudx, dvdy, & ! components in the horizontal tension [s-1] - grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [s-2] - grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [s-2] - grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [m-2 s-2] + ! [H L2 T-2 ~> m3 s-2 or kg s-2] + FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [kg m-2 L2 T-3 ~> W m-2] + ! Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] + ! Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] + ! beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] + grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] + dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1] + grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] + grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] + grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2] max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [m2 s-3] - boundary_mask ! A mask that zeroes out cells with at least one land edge + boundary_mask ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx, dudy, & ! components in the shearing strain [s-1] - dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [s-1] - sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] - sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [s-1] - str_xy, & ! str_xy is the cross term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] - str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H m2 s-2] + dvdx, dudy, & ! components in the shearing strain [T-1 s-1] + dv0dx, du0dy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 s-1] + sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] + str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution - ! [H m2 s-2 ~> m3 s-2 or kg s-2] - vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [s-1] - Leith_Kh_q, & ! Leith Laplacian viscosity at q-points [m2 s-1] - Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [m4 s-1] - beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] - grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [m-1 s-1] - grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [m-1 s-1] - grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [m-1 s-1] - grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [s-2] + ! [H L2 T-2 ~> m3 s-2 or kg s-2] + vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] + ! Leith_Kh_q, & ! Leith Laplacian viscosity at q-points [m2 s-1] + ! Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [m4 s-1] + ! beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] + grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [T-2 ~> s-2] hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] ! This form guarantees that hq/hu < 4. - grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [s-2] + grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] - Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] - sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] - vort_xy_q, & ! vertical vorticity at corner points [s-1] - GME_coeff_q !< GME coeff. at q-points [m2 T-1 ~> m2 s-1] + Ah_q, & ! biharmonic viscosity at corner points [L4 T-1 ~> m4 s-1] + Kh_q, & ! Laplacian viscosity at corner points [L2 T-1 ~> m2 s-1] + sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + vort_xy_q, & ! vertical vorticity at corner points [T-1 ~> s-1] + GME_coeff_q !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] ! These 3-d arrays are unused. ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & @@ -294,33 +299,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & ! KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - Ah_h, & ! biharmonic viscosity at thickness points [m4 T-1 ~> m4 s-1] - Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] - sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [s-1] - diss_rate, & ! MKE dissipated by parameterized shear production [m2 s-3] - max_diss_rate, & ! maximum possible energy dissipated by lateral friction [m2 s-3] + Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] + Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] + sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + diss_rate, & ! MKE dissipated by parameterized shear production [L2 T-3 ~> m2 s-3] + max_diss_rate, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated - ! by friction [m2 s-3] - FrictWork, & ! work done by MKE dissipation mechanisms [W m-2] - FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [W m-2] - FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [W m-2] - FrictWork_GME, & ! work done by GME [W m-2] - div_xx_h ! horizontal divergence [s-1] + ! by friction [L2 T-3 ~> m2 s-3] + FrictWork, & ! work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWork_GME, & ! work done by GME [kg m-2 L2 T-3 ~> W m-2] + div_xx_h ! horizontal divergence [T-1 ~> s-1] ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ! KH_t_GME, & !< interface height diffusivities in t-columns [m2 s-1] - GME_coeff_h !< GME coeff. at h-points [m2 T-1 ~> m2 s-1] - real :: Ah ! biharmonic viscosity [m4 T-1 ~> m4 s-1] - real :: Kh ! Laplacian viscosity [m2 T-1 ~> m2 s-1] - real :: AhSm ! Smagorinsky biharmonic viscosity [m4 T-1 ~> m4 s-1] -! real :: KhSm ! Smagorinsky Laplacian viscosity [m2 T-1 ~> m2 s-1] - real :: AhLth ! 2D Leith biharmonic viscosity [m4 T-1 ~> m4 s-1] -! real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] + GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] + real :: Ah ! biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Kh ! Laplacian viscosity [L2 T-1 ~> m2 s-1] + real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear [T-1 ~> s-1] - real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 T-1 ~> m-1 s-1] + real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [L-1 T-1 ~> m-1 s-1] real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -338,10 +341,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Laplacian viscosity is rescaled [nondim] real :: RoScl ! The scaling function for MEKE source term [nondim] real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] - real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. + real :: local_strain ! Local variable for interpolating computed strain rates [T-1 ~> s-1]. real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. - real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 T-1 ~> m2 s-1] - real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 T-1 ~> m2 s-1] + real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] + real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [L2 T-1 ~> m2 s-1] real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] @@ -416,7 +419,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! GME tapers off above this depth H0_GME = 1000.0*US%m_to_Z FWfrac = 1.0 - GME_coeff_limiter = 1e7*US%T_to_s + GME_coeff_limiter = 1e7*US%m_to_L**2*US%T_to_s ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 @@ -432,9 +435,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#GME# The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 do j=js,je ; do i=is,ie - dudx_bt(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * ubtav(I,j) - & + dudx_bt(i,j) = CS%DY_dxT(i,j)*US%m_s_to_L_T*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) - dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * vbtav(i,J) - & + dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_s_to_L_T*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo @@ -450,9 +453,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Components for the barotropic shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_s_to_L_T*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) - dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_s_to_L_T*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo @@ -486,10 +489,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo !#GME# max_diss_rate_bt is not used. + !### Also, the expression for max_diss_rate_bt is dimensionally inconsistent. Perhaps + ! US%s_to_T**2*grad_vel_mag_t_h should be US%s_to_T*sqrt(grad_vel_mag_bt_h) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then !#GME# These loops bounds should be: do j=js-1,je+1 ; do i=is-1,is+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * grad_vel_mag_bt_h(i,j) + max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * US%s_to_T**2*grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif @@ -500,7 +505,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_vel_mag_bt_q(I,J) = boundary_mask(i,j) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2) + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)))**2) enddo ; enddo endif ! use_GME @@ -521,23 +526,32 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz + ! This is temporary code until the input velocities have been dimensionally rescaled. + do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 + u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo + do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 + v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo + + ! The following are the forms of the horizontal tension and horizontal ! shearing strain advocated by Smagorinsky (1993) and discussed in ! Griffies and Hallberg (2000). ! Calculate horizontal tension do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - dudx(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * u(I,j,k) - & + dudx(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & G%IdyCu(I-1,j) * u(I-1,j,k)) - dvdy(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * v(i,J,k) - & + dvdy(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & G%IdxCv(i,J-1) * v(i,J-1,k)) sh_xx(i,j) = dudx(i,j) - dvdy(i,j) enddo ; enddo ! Components for the shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) + dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo ! Interpolate the thicknesses to velocity points. @@ -574,17 +588,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & - (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & - (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -596,17 +610,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & - (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else - dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & - (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) endif endif enddo @@ -687,12 +701,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*sh_xx(i+1,j) - CS%DY2h(i,j)*sh_xx(i,j)) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J)*sh_xy(I,J) - CS%DX2q(I,J-1)*sh_xy(I,J-1)) + u0(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J)*sh_xy(I,J) - CS%DY2q(I-1,J)*sh_xy(I-1,J)) - & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*sh_xx(i,j+1) - CS%DX2h(i,j)*sh_xx(i,j)) + v0(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo if (apply_OBC) then; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments @@ -718,9 +732,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - dvdx(I,J) = DY_dxBu * US%m_to_L*(v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) + dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - dudy(I,J) = DX_dyBu * US%m_to_L*(u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) + dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo ! Vorticity @@ -743,12 +757,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) @@ -756,7 +770,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*US%m_to_L*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & @@ -770,11 +784,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Divergence gradient !#GME# This index range should be: do j=Jsq,Jeq+1 ; do I=Isq-1,Ieq+1 do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + div_xx_dx(I,j) = US%s_to_T*US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo !#GME# This index range should be: do j=Jsq-1,Jeq+1 ; do i=Isq,Ieq+1 do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = US%m_to_L*G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + div_xx_dy(i,J) = US%s_to_T*US%m_to_L*G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) enddo ; enddo !#GME# With the correct index ranges, this halo update is unnecessary. @@ -784,12 +798,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Why use the magnitude of the average instead of the average magnitude? !#GME# This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + grad_div_mag_h(i,j) = US%L_to_m*US%T_to_s*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 !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + grad_div_mag_q(I,J) = US%L_to_m*US%T_to_s*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 @@ -815,13 +829,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then !#GME# beta_h and beta_q are never used. - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) - enddo; enddo - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - beta_q(I,J) = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & - (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) - enddo ; enddo + ! do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + ! beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + ! enddo ; enddo + ! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + ! beta_q(I,J) = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & + ! (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) + ! enddo ; enddo do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) @@ -835,15 +849,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#GME# This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & + grad_vort_mag_h_2d(i,j) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) enddo ; enddo !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + grad_vort_mag_q_2d(I,J) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo + ! This accumulates terms, some of which are in VarMix, so rescaling can not be done here. call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) @@ -851,12 +866,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#GME# This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & + grad_vort_mag_h(i,j) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) enddo ; enddo !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + grad_vort_mag_q(I,J) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo @@ -866,15 +881,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & + Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 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)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = US%T_to_s*MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) + vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3.*grad_vort_mag_h_2d(i,j)) else - vert_vort_mag = US%T_to_s*(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) + vert_vort_mag = (grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then @@ -896,7 +911,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) & - Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + Kh = Kh + US%m_to_L**2*MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -940,7 +955,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -948,7 +963,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah - if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution + if (use_MEKE_Au) Ah = Ah + US%L_to_m**4*MEKE%Au(i,j) ! *Add* the MEKE contribution if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) @@ -957,13 +972,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *US%m_to_L*(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xx(i,j) = Ah * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *US%m_to_L*(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + bhstr_xx(i,j) = Ah * & + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) endif ! biharmonic @@ -973,8 +988,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dv0dx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) + du0dy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -983,17 +998,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= Jeq)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then - dvdx(I,J) = 0. ; dudy(I,J) = 0. + dv0dx(I,J) = 0. ; du0dy(I,J) = 0. elseif (OBC%freeslip_strain) then - dudy(I,J) = 0. + du0dy(I,J) = 0. endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= Ieq)) then do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%zero_strain) then - dvdx(I,J) = 0. ; dudy(I,J) = 0. + dv0dx(I,J) = 0. ; du0dy(I,J) = 0. elseif (OBC%freeslip_strain) then - dvdx(I,J) = 0. + dv0dx(I,J) = 0. endif enddo endif @@ -1005,15 +1020,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = US%T_to_s * sqrt(sh_xy(I,J)*sh_xy(I,J) + & + Shear_mag = sqrt(sh_xy(I,J)*sh_xy(I,J) + & 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)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = US%T_to_s*MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) + vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3.*grad_vort_mag_q_2d(I,J)) else - vert_vort_mag = US%T_to_s*(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) + vert_vort_mag = (grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) @@ -1060,7 +1075,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, 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 = Kh + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + Kh = Kh + 0.25*US%m_to_L**2*( (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 @@ -1116,8 +1131,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & - (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) + Ah = Ah + 0.25*US%L_to_m**4*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & + (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) endif if (CS%better_bound_Ah) then @@ -1126,19 +1141,29 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx(I,J) + dudy(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dv0dx(I,J) + du0dy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dvdx(I,J) + dudy(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dv0dx(I,J) + du0dy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic enddo ; enddo - if (find_FrictWork) then if (CS%Laplacian) then + if (CS%biharmonic) then + !### This code is dimensionally incorrect, but needed to reproduce previous answers. + ! This should be considered a serious bug in cases where the answers change if the + ! following code is commented out - i.e. if both biharmonic and Laplacian are used + ! and FindFrictWork is true. + do J=js-1,Jeq ; do I=is-1,Ieq + dvdx(I,J) = US%m_to_L**2*dv0dx(I,J) + dudy(I,J) = US%m_to_L**2*du0dy(I,J) + enddo ; enddo + endif + if (CS%answers_2018) then do j=js,je ; do i=is,ie grad_vel_mag_h(i,j) = boundary_mask(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & @@ -1160,8 +1185,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then do j=js,je ; do i=is,ie - grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & - (0.5*(v0(i,J) + v0(i,J-1)))**2) + grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * & + ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & + (0.5*(v0(i,J) + v0(i,J-1)))**2) enddo ; enddo else do j=js,je ; do i=is,ie @@ -1171,13 +1197,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 - diss_rate(i,j,k) = -US%s_to_T*Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & - US%s_to_T*Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) + diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & + Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + max_diss_rate(i,j,k) = 2.0*US%m_s_to_L_T**2*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 FrictWorkMax(i,j,k) = -max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 @@ -1202,8 +1228,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then - GME_coeff = FWfrac*US%T_to_s*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) -! GME_coeff = FWfrac*US%T_to_s*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) +! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1222,8 +1248,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(I,J)>0) ) then !#GME# target_diss_rate_GME and max_diss_rate are defined at h points, not q points as used here. - GME_coeff = FWfrac*US%T_to_s*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) -! GME_coeff = FWfrac*US%T_to_s*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) +! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1237,7 +1263,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo - ! applying GME diagonal term + ! 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) @@ -1256,7 +1282,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - FrictWork_GME(i,j,k) = US%s_to_T*GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) + FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo endif @@ -1277,11 +1303,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = ((US%m_to_L*G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & - CS%DY2h(i+1,j)*str_xx(i+1,j)) + & - US%m_to_L*G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & - CS%DX2q(I,J) *str_xy(I,J))) * & - US%m_to_L**2*G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) + diffu(I,j,k) = US%L_T_to_m_s * & + ((G%IdyCu(I,j)*(CS%dy2h(i,j) *str_xx(i,j) - & + CS%dy2h(i+1,j)*str_xx(i+1,j)) + & + G%IdxCu(I,j)*(CS%dx2q(I,J-1)*str_xy(I,J-1) - & + CS%dx2q(I,J) *str_xy(I,J))) * & + G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo if (apply_OBC) then @@ -1299,11 +1326,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = ((US%m_to_L*G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & - CS%DY2q(I,J) *str_xy(I,J)) - & - US%m_to_L*G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & - CS%DX2h(i,j+1)*str_xx(i,j+1))) * & - US%m_to_L**2*G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) + diffv(i,J,k) = US%L_T_to_m_s * & + ((G%IdyCv(i,J)*(CS%dy2q(I-1,J)*str_xy(I-1,J) - & + CS%dy2q(I,J) *str_xy(I,J)) - & + G%IdxCv(i,J)*(CS%dx2h(i,j) *str_xx(i,j) - & + CS%dx2h(i,j+1)*str_xx(i,j+1))) * & + G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo if (apply_OBC) then ! This is not the right boundary condition. If all the masking of tendencies are done @@ -1321,21 +1349,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then ; do j=js,je ; do i=is,ie ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) ! This is the old formulation that includes energy diffusion - FrictWork(i,j,k) = US%s_to_T*GV%H_to_kg_m2 * ( & - (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & - -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & + FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & + (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & + -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & - (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & +str_xy(I-1,J-1)*( & - (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & +(str_xy(I-1,J)*( & - (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & +str_xy(I,J-1)*( & - (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) + (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) enddo ; enddo ; endif ! Make a similar calculation as for FrictWork above but accumulating into @@ -1352,7 +1380,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do i=is,ie FatH = 0.25*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) - Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & + Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 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)))) if (CS%answers_2018) then @@ -1372,33 +1400,34 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) endif endif - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%s_to_T*GV%H_to_kg_m2 * ( & - ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & - -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%L_to_m**2*US%s_to_T**3*GV%H_to_kg_m2 * ( & + ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & + -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & - (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & +(str_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1))*( & - (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & +((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J))*( & - (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & +(str_xy(I,J-1)-RoScl*bhstr_xy(I,J-1))*( & - (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) + (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) enddo ; enddo else do j=js,je ; do i=is,ie ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + & + US%L_to_m**2*US%s_to_T**3*MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) enddo ; enddo endif ! MEKE%backscatter if (CS%use_GME .and. associated(MEKE)) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + US%L_to_m**2*US%s_to_T**3*FrictWork_GME(i,j,k) enddo ; enddo endif endif @@ -1425,13 +1454,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%debug) then if (CS%Laplacian) then - call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0) - call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0) + call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0, scale=US%s_to_T) endif - if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%s_to_T) - if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) + if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) endif if (CS%id_FrictWorkIntz > 0) then @@ -1462,11 +1491,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities - ! at u points [m-2], with u0u, v0u, and v0v defined similarly. - real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [m2] - real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [m3] - real :: grid_sp_q2 ! spacings at h and q points [m2] - real :: grid_sp_q3 ! spacings at h and q points^(3/2) [m3] + ! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly. + real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [L2 ~> m2] + real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] + real :: grid_sp_q2 ! spacings at h and q points [L2 ~> m2] + real :: grid_sp_q3 ! spacings at h and q points^(3/2) [L3 ~> m3] real :: Kh_Limit ! A coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four @@ -1475,10 +1504,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! [T2 L-2 ~> s2 m-2] real :: Ah_Limit ! coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit biharmonic viscosity - real :: Kh ! Lapacian horizontal viscosity [m2 s-1] - real :: Ah ! biharmonic horizontal viscosity [m4 s-1] - real :: Kh_vel_scale ! this speed [m T-1 ~> m s-1] times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed [m T-1 ~> m s-1] times grid spacing cubed gives bih visc + real :: Kh ! Lapacian horizontal viscosity [L2 s-1] + real :: Ah ! biharmonic horizontal viscosity [L4 s-1] + real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc + real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant @@ -1491,7 +1520,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration [L T-1 ~> m s-1] - real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 T-1 ~> m2 s-1] + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: get_all ! If true, read and log all parameters, regardless of @@ -1561,20 +1590,20 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%Laplacian .or. get_all) then call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%T_to_s) + 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, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & - units = "m2 s-1", default=0.0, scale=US%T_to_s) + 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, & "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%T_to_s) + 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, & "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%T_to_s) + 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, & "The power used to raise SIN(LAT) when using a latitudinally "//& @@ -1637,7 +1666,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%anisotropic .or. get_all) then 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%T_to_s) + 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, & "Selects the mode for setting the direction of anistropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& @@ -1665,13 +1694,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .or. get_all) then call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & - units = "m4 s-1", default=0.0, scale=US%T_to_s) + 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, & "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%T_to_s) + 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, & "A time scale whose inverse is multiplied by the fourth "//& "power of the grid spacing to calculate biharmonic viscosity. "//& @@ -1838,7 +1867,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & - G%domain, timelevel=1, scale=US%T_to_s) + G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif @@ -1869,11 +1898,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - CS%DX2q(I,J) = US%L_to_m**2*G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = US%L_to_m**2*G%dyBu(I,J)*G%dyBu(I,J) + CS%dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) + CS%dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j) CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo @@ -1917,7 +1946,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ! Static factors in the Smagorinsky and Leith schemes - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) + grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j) + CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xx(i,j) = Smag_Lap_const * grid_sp_h2 if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 @@ -1943,7 +1972,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Calculate and store the background viscosity at q-points do J=js-1,Jeq ; do I=is-1,Ieq ! Static factors in the Smagorinsky and Leith schemes - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J) + CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xy(I,J) = Smag_Lap_const * grid_sp_q2 if (CS%Leith_Kh) CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 @@ -1971,12 +2000,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (US%m_to_L*G%IdxCu(I,j)*US%m_to_L*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) - CS%IDXDY2u(I,j) = US%m_to_L*G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%Idx2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) + CS%Idxdy2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * US%m_to_L*G%IdyCv(i,J) - CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (US%m_to_L*G%IdyCv(i,J)*US%m_to_L*G%IdyCv(i,J)) + CS%Idx2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) + CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -1986,7 +2015,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j)+CS%DY2h(i,j)) + grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Ah) then @@ -1994,7 +2023,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%bound_Coriolis) then fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) - CS%Biharm_const2_xx(i,j) = US%m_to_L**2*(grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & + CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif endif @@ -2010,13 +2039,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J)+CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J)+CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then - CS%Biharm_const2_xy(I,J) = US%m_to_L**2*(grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & + CS%Biharm_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif @@ -2039,27 +2068,27 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) Idt = 1.0 / dt do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & - US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & - US%m_to_L**3*max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + (CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & + max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + (CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & + max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & - US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & - US%m_to_L**3*max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + (CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & + max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + (CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & + max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo if (CS%debug) then - call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) endif endif @@ -2068,38 +2097,38 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .and. CS%better_bound_Ah) then Idt = 1.0 / dt do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*US%m_to_L*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & - CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*US%m_to_L*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) - - u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*US%m_to_L*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & - CS%DY2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*US%m_to_L*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) + u0u(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & + CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) ) + + u0v(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & + CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dx2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*US%m_to_L*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*US%m_to_L*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & - CS%DX2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) - - v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*US%m_to_L*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*US%m_to_L*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & - CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + v0u(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & + CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) ) + + v0v(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & + CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) ) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & - CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & - US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & - CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & - US%m_to_L**3*max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + (CS%dy2h(i,j) * & + (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & + CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & + max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + (CS%dx2h(i,j) * & + (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & + CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & + max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Ah_Max_xx(I,J) = 0.0 if (denom > 0.0) & CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * Idt / denom @@ -2107,21 +2136,21 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * & - (CS%DX_dyBu(I,J)*US%m_to_L*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*US%m_to_L*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & - US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * & - (CS%DX_dyBu(I,J)*US%m_to_L*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*US%m_to_L*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & - US%m_to_L**3*max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + (CS%dx2q(I,J) * & + (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & + max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + (CS%dy2q(I,J) * & + (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & + max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Ah_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo if (CS%debug) then - call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) endif endif @@ -2135,61 +2164,64 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & - 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%s_to_T, & + 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T, & cmor_field_name='difmxybo', & cmor_long_name='Ocean lateral biharmonic viscosity', & cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & - 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%s_to_T) + 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) endif if (CS%Laplacian) then CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & - 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%s_to_T, & + 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='difmxylo', & cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & - 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%s_to_T) + 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & - 'Vertical vorticity at q Points', 's-1') + 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & - 'Horizontal divergence at h Points', 's-1') + 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) endif endif if (CS%use_GME) then CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & - 'GME coefficient at h Points', 'm2 s-1', conversion=US%s_to_T) + 'GME coefficient at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & - 'GME coefficient at q Points', 'm2 s-1', conversion=US%s_to_T) + 'GME coefficient at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& - 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', 'W m-2') + 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& - 'Integral work done by lateral friction terms', 'W m-2') + 'Integral work done by lateral friction terms', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) CS%id_FrictWork_diss = register_diag_field('ocean_model','FrictWork_diss',diag%axesTL,Time,& - 'Integral work done by lateral friction terms (excluding diffusion of energy)', 'W m-2') + 'Integral work done by lateral friction terms (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) if (associated(MEKE)) then if (associated(MEKE%mom_src)) then CS%id_FrictWorkMax = register_diag_field('ocean_model', 'FrictWorkMax', diag%axesTL, Time,& - 'Maximum possible integral work done by lateral friction terms', 'W m-2') + 'Maximum possible integral work done by lateral friction terms', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif endif CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & - 'Depth integrated work done by lateral friction', 'W m-2', & + 'Depth integrated work done by lateral friction', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') From 9438c735955e75c2c6042f312e5d5ea790e53f87 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Aug 2019 19:01:53 -0400 Subject: [PATCH 037/104] +Rescaled ubtav returned by barotropic_get_tav Changed the units of ubtav and vbtav as returned by barotropic_get_tav from [m s-1] to [L T-1] for dimensional consistency testing, and made corresponding changes inside of MOM_hor_visc.F90. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 8 ++++---- src/parameterizations/lateral/MOM_hor_visc.F90 | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b7b1e2847c..6438efc816 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4384,19 +4384,19 @@ subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) type(barotropic_CS), pointer :: CS !< Control structure for this module 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 [m s-1] + !! over a baroclinic timestep [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged - !! over a baroclinic timestep [m s-1] + !! over a baroclinic timestep [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - ubtav(I,j) = US%L_T_to_m_s*CS%ubtav(I,j) + ubtav(I,j) = CS%ubtav(I,j) enddo ; enddo do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - vbtav(i,J) = US%L_T_to_m_s*CS%vbtav(i,J) + vbtav(i,J) = CS%vbtav(i,J) enddo ; enddo end subroutine barotropic_get_tav diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 93c6324025..1bc42c3994 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -234,13 +234,13 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] - ubtav ! zonal barotropic vel. ave. over baroclinic time-step [m s-1] + ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] - vbtav ! meridional barotropic vel. ave. over baroclinic time-step [m s-1] + vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] @@ -435,9 +435,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV !#GME# The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 do j=js,je ; do i=is,ie - dudx_bt(i,j) = CS%DY_dxT(i,j)*US%m_s_to_L_T*(G%IdyCu(I,j) * ubtav(I,j) - & + dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) - dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_s_to_L_T*(G%IdxCv(i,J) * vbtav(i,J) - & + dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo @@ -453,9 +453,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Components for the barotropic shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_s_to_L_T*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) - dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_s_to_L_T*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo From 4a59fef9c1021c8d624f63e381af3142a0638fb1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 05:21:01 -0400 Subject: [PATCH 038/104] +Rescaled div_xx_dx sent to calc_QG_Leith_viscosity Changed the units of div_xx_dx, div_xx_dy, vort_xy_dx and vort_xy_dy that passed to calc_QG_Leith_viscosity from [m-1 s-1] to [L-1 T-1] for dimensional consistency testing, making corresponding changes inside of horizontal_viscosity and calc_QG_Leith_viscosity. Also passed a new unit_scale_type argument to calc_QG_Leith_viscosity. All answers in the MOM6-examples test cases are bitwise identical and pass the dimensional rescaling tests, but I do not believe that cases with Leith viscosity are being adequately tested by the MOM6-examples test suite. --- .../lateral/MOM_hor_visc.F90 | 30 +++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 40 ++++++++++--------- 2 files changed, 36 insertions(+), 34 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1bc42c3994..2b915fd3fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -232,14 +232,14 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV real, dimension(SZIB_(G),SZJ_(G)) :: & u0, & ! Laplacian of u [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. - vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] - div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. - vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] - div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] @@ -757,12 +757,12 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) @@ -784,11 +784,11 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Divergence gradient !#GME# This index range should be: do j=Jsq,Jeq+1 ; do I=Isq-1,Ieq+1 do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = US%s_to_T*US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo !#GME# This index range should be: do j=Jsq-1,Jeq+1 ; do i=Isq,Ieq+1 do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = US%s_to_T*US%m_to_L*G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) enddo ; enddo !#GME# With the correct index ranges, this halo update is unnecessary. @@ -798,12 +798,12 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Why use the magnitude of the average instead of the average magnitude? !#GME# This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_div_mag_h(i,j) = US%L_to_m*US%T_to_s*sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**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 !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_div_mag_q(I,J) = US%L_to_m*US%T_to_s*sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**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 @@ -849,29 +849,29 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV !#GME# This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vort_mag_h_2d(i,j) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & + grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) enddo ; enddo !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q_2d(I,J) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo ! This accumulates terms, some of which are in VarMix, so rescaling can not be done here. - call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & + call calc_QG_Leith_viscosity(VarMix, G, GV, US, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) endif !#GME# This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vort_mag_h(i,j) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & + grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) enddo ; enddo !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q(I,J) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2768e3034d..58bc2776e0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -706,22 +706,23 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) +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(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 ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [m s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence - !! (d/dx(du/dx + dv/dy)) [m-1 s-1] + !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence - !! (d/dy(du/dx + dv/dy)) [m-1 s-1] + !! (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity - !! (d/dx(dv/dx - du/dy)) [m-1 s-1] + !! (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity - !! (d/dy(dv/dx - du/dy)) [m-1 s-1] + !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity !! at h-points [m2 s-1] ! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity @@ -736,8 +737,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! dudy, & ! Meridional shear of zonal velocity [s-1] ! dvdx ! Zonal shear of meridional velocity [s-1] real, dimension(SZI_(G),SZJB_(G)) :: & -! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] -! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] +! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] beta_v, & ! Beta at v-points [m-1 s-1] @@ -745,16 +746,17 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x grad_div_mag_v ! mag. of div. grad. at v-points [s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & -! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] -! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] - dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] +! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] beta_u, & ! Beta at u-points [m-1 s-1] - grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1] - grad_div_mag_u ! mag. of div. grad. at u-points [s-1] + grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1 m-1] + grad_div_mag_u ! mag. of div. grad. at u-points [s-1 m-1] ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag - real :: h_at_slope_above, h_at_slope_below, Ih, f + real :: h_at_slope_above, h_at_slope_below, Ih + real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz real :: inv_PI3 @@ -801,7 +803,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x !### do J=js-1,je ; do i=is-1,Ieq+1 do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) - vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_m * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) @@ -811,7 +813,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) !### I think that this should be vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & - vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_m * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -824,9 +826,9 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x if (CS%use_QG_Leith_GM) then do j=js,je ; do I=is-1,Ieq - grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + grad_vort_mag_u(I,j) = US%m_to_L*US%s_to_T*SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) - grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + grad_div_mag_u(I,j) = US%m_to_L*US%s_to_T*SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & @@ -840,9 +842,9 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x enddo ; enddo do J=js-1,Jeq ; do i=is,ie - grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + grad_vort_mag_v(i,J) = US%m_to_L*US%s_to_T*SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) - grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + grad_div_mag_v(i,J) = US%m_to_L*US%s_to_T*SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) if (CS%use_beta_in_QG_Leith) then beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & From 63ba91b8fa36f8f8f408465f2f303d2bdc7c50c3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 05:37:24 -0400 Subject: [PATCH 039/104] Renamed u0 to Del2u in horizontal_viscosity Renamed u0 and v0 variables to Del2u and Del2v in horizontal_viscosity for greater code clarity. Also added some missing variables to an OMP statement. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 64 +++++++++---------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2b915fd3fa..7149d508f9 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -230,13 +230,13 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u [L-1 T-1 ~> m-1 s-1] + Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] + Del2v, & ! The v-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] @@ -266,7 +266,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [T-1 s-1] - dv0dx, du0dy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] @@ -510,16 +510,16 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif ! use_GME - !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & - !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & + !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,US,u,v,is,js,ie,je, & + !$OMP h,rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,diffv,apply_OBC,OBC, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & !$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & - !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & - !$OMP sh_xy, str_xy, Ah, Kh, AhSm, dvdx, dudy, & - !$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & - !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & + !$OMP private(Del2u, Del2v, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy,str_xy,Ah,Kh,AhSm,dvdx,dudy,dDel2udy, & + !$OMP dDel2vdx,sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & + !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv,h_u,h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & !$OMP meke_res_fn,Sh_F_pow, & @@ -698,26 +698,26 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV enddo ; enddo endif - ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) + ! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & - CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) + Del2u(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & - CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) + Del2v(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo if (apply_OBC) then; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= Jsq-1) .and. (J <= Jeq+1)) then do I=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v0(i,J) = 0. + Del2v(i,J) = 0. enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= Isq-1) .and. (I <= Ieq+1)) then do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u0(I,j) = 0. + Del2u(I,j) = 0. enddo endif enddo @@ -972,13 +972,13 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & - (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) * (G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization bhstr_xx(i,j) = Ah * & - (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) * (G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) endif ! biharmonic @@ -988,8 +988,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dv0dx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - du0dy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dDel2vdx(I,J) = CS%DY_dxBu(I,J)*(Del2v(i+1,J)*G%IdyCv(i+1,J) - Del2v(i,J)*G%IdyCv(i,J)) + dDel2udy(I,J) = CS%DX_dyBu(I,J)*(Del2u(I,j+1)*G%IdxCu(I,j+1) - Del2u(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -998,17 +998,17 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= Jeq)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then - dv0dx(I,J) = 0. ; du0dy(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - du0dy(I,J) = 0. + dDel2udy(I,J) = 0. endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= Ieq)) then do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%zero_strain) then - dv0dx(I,J) = 0. ; du0dy(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - dv0dx(I,J) = 0. + dDel2vdx(I,J) = 0. endif enddo endif @@ -1141,10 +1141,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dv0dx(I,J) + du0dy(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dv0dx(I,J) + du0dy(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic @@ -1159,8 +1159,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! following code is commented out - i.e. if both biharmonic and Laplacian are used ! and FindFrictWork is true. do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = US%m_to_L**2*dv0dx(I,J) - dudy(I,J) = US%m_to_L**2*du0dy(I,J) + dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) + dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) enddo ; enddo endif @@ -1186,8 +1186,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (CS%biharmonic) then do j=js,je ; do i=is,ie grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * & - ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & - (0.5*(v0(i,J) + v0(i,J-1)))**2) + ((0.5*(Del2u(I,j) + Del2u(I-1,j)))**2 + & + (0.5*(Del2v(i,J) + Del2v(i,J-1)))**2) enddo ; enddo else do j=js,je ; do i=is,ie From b4df1471dd49b127b83e8c40af40b5a169ff6cab Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 08:16:29 -0400 Subject: [PATCH 040/104] +Rescaled 9 elements of the MEKE_type Rescaled the dimensions of the MEKE, GM_src, mom_src, GME_snk, Kh, Kh_diff, Ku, and Au elements of the MEKE_type. All answers are bitwise identical, but the units of 9 elements of a public type have changed. --- src/parameterizations/lateral/MOM_MEKE.F90 | 168 +++++++++++------- .../lateral/MOM_MEKE_types.F90 | 16 +- .../lateral/MOM_hor_visc.F90 | 23 ++- .../lateral/MOM_thickness_diffuse.F90 | 20 +-- src/tracer/MOM_tracer_hor_diff.F90 | 4 +- 5 files changed, 134 insertions(+), 97 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 20caf163a4..20aecb07c1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -175,10 +175,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%MEKE)) then if (CS%debug) then - if (associated(MEKE%mom_src)) call hchksum(MEKE%mom_src, 'MEKE mom_src',G%HI) - if (associated(MEKE%GME_snk)) call hchksum(MEKE%GME_snk, 'MEKE GME_snk',G%HI) - if (associated(MEKE%GM_src)) call hchksum(MEKE%GM_src, 'MEKE GM_src',G%HI) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE',G%HI) + if (associated(MEKE%mom_src)) & + call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GME_snk)) & + call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GM_src)) & + call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif @@ -287,26 +290,28 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(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) + src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%mom_src(i,j) enddo ; enddo endif if (associated(MEKE%GME_snk)) then -!$OMP do + !$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) + src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GME_snk(i,j) enddo ; enddo endif if (associated(MEKE%GM_src)) then -!$OMP do if (CS%GM_src_alt) then + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / MAX(1.0,G%bathyT(i,j)) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) / & + MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant. enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) enddo ; enddo endif endif @@ -314,44 +319,47 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Increase EKE by a full time-steps worth of source !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j) )*G%mask2dT(i,j) + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + US%m_s_to_L_T**2*sdt*src(i,j) )*G%mask2dT(i,j) enddo ; enddo if (use_drag_rate) then ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) -!$OMP do if (CS%Jansen15_drag) then + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (cdrag2/MAX(1.0,G%bathyT(i,j))) * sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + & - 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) * 2.0 * bottomFac2(i,j)*MEKE%MEKE(i,j) + drag_rate(i,j) = (cdrag2/MAX(1.0,G%bathyT(i,j))) * & + sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + & + 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) * & + 2.0 * bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j) enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo endif endif ! First stage of Strang splitting -!$OMP do if (CS%Jansen15_drag) then + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j),sdt_damp*drag_rate(i,j)) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j), US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j)) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. ! notice that the above line ensures a damping only if MEKE is positive, ! while leaving MEKE unchanged if it is negative MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo endif -!$OMP end parallel if (CS%kh_flux_enabled .or. CS%MEKE_K4 >= 0.0) then ! Update MEKE in the halos for lateral or bi-harmonic diffusion @@ -365,18 +373,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & - (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & - ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + ! US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & - (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & - ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + ! US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) @@ -428,9 +436,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(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)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(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)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -438,14 +448,16 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & - (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) + US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) 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)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(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)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(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(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -453,30 +465,30 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & - (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) + US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then advFac = GV%H_to_m * CS%MEKE_advection_factor / dt !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie if (baroHu(I,j)>0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac elseif (baroHu(I,j)<0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i+1,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i+1,j)*advFac endif enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie if (baroHv(i,J)>0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac elseif (baroHv(i,J)<0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j+1)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j+1)*advFac endif enddo ; enddo endif !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*(sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo @@ -486,7 +498,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + del4MEKE(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*del4MEKE(i,j) enddo ; enddo endif @@ -495,21 +507,23 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (sdt>sdt_damp) then ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then -!$OMP do if (CS%Jansen15_drag) then + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) -sdt_damp*drag_rate(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. ! notice that the above line ensures a damping only if MEKE is positive, ! while leaving MEKE unchanged if it is negative MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) @@ -517,7 +531,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif endif -!$OMP do endif endif ! MEKE_KH>=0 @@ -525,7 +538,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) ! enddo ; enddo -!$OMP end parallel call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -537,20 +549,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Rd_as_max_scale) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & - * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j))) & - * min(MEKE%Rd_dx_h(i,j), 1.0) + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff * & + sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) ) * & + min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) enddo ; enddo endif else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) enddo ; enddo endif endif @@ -559,13 +573,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate viscosity for the main model to use if (CS%viscosity_coeff_Ku /=0.) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = US%T_to_s*CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) enddo ; enddo endif if (CS%viscosity_coeff_Au /=0.) then do j=js,je ; do i=is,ie - MEKE%Au(i,j) = US%T_to_s*CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 + MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * US%m_to_L**3*LmixScale(i,j)**3 enddo ; enddo endif @@ -752,8 +766,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m else EKE = 0. endif - MEKE%MEKE(i,j) = EKE -! MEKE%MEKE(i,j) = (US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 + MEKE%MEKE(i,j) = US%m_s_to_L_T**2*EKE +! MEKE%MEKE(i,j) = US%m_s_to_L_T**2*(US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 enddo ; enddo end subroutine MEKE_equilibrium @@ -771,7 +785,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [m2 s-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. @@ -824,7 +838,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & + MEKE%Rd_dx_h(i,j), SN, US%L_T_to_m_s**2*MEKE%MEKE(i,j), US%Z_to_m, & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) enddo ; enddo @@ -920,6 +934,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this ! run to the representation in a restart file. + real :: L_rescale ! A rescaling factor for length from the internal representation in this + ! run to the representation in a restart file. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed logical :: laplacian, biharmonic, useVarMix, coldStart ! This include declares and sets the variable "version". @@ -1122,38 +1138,38 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Register fields for output from this module. CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & - 'Mesoscale Eddy Kinetic Energy', 'm2 s-2') + 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) if (.not. associated(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') + '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 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & - 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%s_to_T) + '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 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & - 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%s_to_T) + '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 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & - 'MEKE derived eddy-velocity scale', 'm s-1') + 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(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') + '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 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & - 'MEKE derived barotropic eddy-velocity scale', 'm s-1') + '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 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & 'MEKE decay rate', 's-1') CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & - 'MEKE energy available from thickness mixing', 'W m-2') + 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & - 'MEKE energy available from momentum', 'W m-2') + 'MEKE energy available from momentum', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & - 'MEKE energy lost to GME backscatter', 'W m-2') + 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') @@ -1188,16 +1204,38 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) I_T_rescale = 1.0 if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & I_T_rescale = US%s_to_T_restart / US%s_to_T + L_rescale = 1.0 + if ((US%m_to_L_restart /= 0.0) .and. (US%m_to_L_restart /= US%m_to_L)) & + L_rescale = US%m_to_L / US%m_to_L_restart - if (I_T_rescale /= 1.0) then + if (L_rescale*I_T_rescale /= 1.0) then + if (associated(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 + 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 do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = I_T_rescale * MEKE%Ku(i,j) + 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 + 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 do j=js,je ; do i=is,ie - MEKE%Au(i,j) = I_T_rescale * MEKE%Au(i,j) + MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) enddo ; enddo endif ; endif endif diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 438e394e3b..33f8f5d1b2 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -8,20 +8,20 @@ module MOM_MEKE_types type, public :: MEKE_type ! Variables real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [W m-2]. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [W m-2]. - GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [W m-2]. - Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [m2 s-1]. + MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [kg m-2 L2 T-3 ~> W m-2]. + mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + 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 [m2 s-1]. + !! 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 - !! [m2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! [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 [m4 T-1 ~> m4 s-1]. + !! 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 7149d508f9..98b9d6c49a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -261,7 +261,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2] - max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [m2 s-3] + max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [L2 T-3 ~> m2 s-3] boundary_mask ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -494,7 +494,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then !#GME# These loops bounds should be: do j=js-1,je+1 ; do i=is-1,is+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * US%s_to_T**2*grad_vel_mag_bt_h(i,j) + max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * US%s_to_T*grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif @@ -911,7 +911,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) & - Kh = Kh + US%m_to_L**2*MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -963,7 +963,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah - if (use_MEKE_Au) Ah = Ah + US%L_to_m**4*MEKE%Au(i,j) ! *Add* the MEKE contribution + if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) @@ -1075,7 +1075,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, 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 = Kh + 0.25*US%m_to_L**2*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + Kh = Kh + 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 @@ -1131,8 +1131,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*US%L_to_m**4*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & - (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) + Ah = Ah + 0.25*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & + (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) endif if (CS%better_bound_Ah) then @@ -1203,7 +1203,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - max_diss_rate(i,j,k) = 2.0*US%m_s_to_L_T**2*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 FrictWorkMax(i,j,k) = -max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 @@ -1400,7 +1400,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) endif endif - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%L_to_m**2*US%s_to_T**3*GV%H_to_kg_m2 * ( & + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & @@ -1419,15 +1419,14 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV else do j=js,je ; do i=is,ie ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + & - US%L_to_m**2*US%s_to_T**3*MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) enddo ; enddo endif ! MEKE%backscatter if (CS%use_GME .and. associated(MEKE)) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + US%L_to_m**2*US%s_to_T**3*FrictWork_GME(i,j,k) + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) enddo ; enddo endif endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 4bc664859d..1878072e52 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -217,13 +217,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + & - G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & + US%L_T_to_m_s**2*0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif endif ; endif @@ -296,13 +296,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie - Khth_Loc(I,j) = Khth_Loc(I,j) + & - G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & + US%L_T_to_m_s**2*0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif endif ; endif @@ -365,7 +365,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is,ie - MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & + MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * US%s_to_T*MEKE%MEKE(i,j) / & (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo @@ -458,7 +458,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp MEKE%Kh_diff(:,:) = 0.0 do k=1,nz do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + US%m_to_L**2*US%T_to_s*KH_t(i,j,k) * h(i,j,k) enddo; enddo enddo @@ -1278,9 +1278,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then if (CS%GM_src_alt) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*PE_release_h else - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*Work_h endif endif ; endif !enddo ; enddo ; enddo ; endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 1f4e0b8987..a61af65ee9 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -212,7 +212,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online 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)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*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) & Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) @@ -229,7 +229,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online 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)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*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) & Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) From 1ff9073ff6b9da9ee984c861a4aa1c6d6f205c36 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 09:02:54 -0400 Subject: [PATCH 041/104] +Rescaled horizontal viscosity accelerations Applied dimensional rescaling to the horizontal viscosity accelerations, diffu and diffv, that are returned from horizontal_viscosity, into [L T-2]. This change also includes rescaling of two diagnostics. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_checksum_packages.F90 | 6 ++-- src/core/MOM_dynamics_split_RK2.F90 | 14 ++++----- src/core/MOM_dynamics_unsplit.F90 | 14 ++++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 30 +++++++++---------- src/diagnostics/MOM_PointAccel.F90 | 8 ++--- src/diagnostics/MOM_diagnostics.F90 | 4 +-- .../lateral/MOM_hor_visc.F90 | 14 ++++----- 7 files changed, 44 insertions(+), 46 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 68ad6d3888..795885e817 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -179,10 +179,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p !! (equal to -dM/dy) [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the - !! along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + !! along-isopycnal stress tensor [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: diffv !< Meridional acceleration due to convergence of - !! the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + !! the along-isopycnal stress tensor [L T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer @@ -208,7 +208,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! and js...je as their extent. call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) - call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%s_to_T) + call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) if (present(pbce)) & call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) if (present(u_accel_bt) .and. present(v_accel_bt)) & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d97cdf06a9..193062ac42 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -70,13 +70,13 @@ module MOM_dynamics_split_RK2 type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] - PFu, & !< PFu = -dM/dx [m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u !< Both the fraction of the zonal momentum originally in a @@ -449,10 +449,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + US%m_s_to_L_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + US%m_s_to_L_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -707,10 +707,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%m_s_to_L_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%m_s_to_L_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index e4f902c9e0..286aa96c77 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -108,16 +108,16 @@ module MOM_dynamics_unsplit type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> mm s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -282,10 +282,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + dt * US%s_to_T*CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s*CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + dt * US%s_to_T*CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s*CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e4c92b9783..c3faabf8ba 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -105,13 +105,13 @@ module MOM_dynamics_unsplit_RK2 type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) @@ -321,12 +321,12 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_pred * & - (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_pred * & - (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -377,16 +377,16 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & - (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & - (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & - (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & - (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index f5ddab01bc..92292bb8e7 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -192,7 +192,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffu(I,j,k)); enddo + 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 if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') @@ -358,7 +358,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%s_to_T*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') @@ -526,7 +526,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffv(i,J,k)); enddo + 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 if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') @@ -688,7 +688,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (dt*US%L_T2_to_m_s2*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%s_to_T*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index a2bd76766c..eef2955ee0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%L_T2_to_m_s2*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%L_T2_to_m_s2*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 98b9d6c49a..876cea507f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -209,10 +209,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of - !! along-coordinate stress tensor [m s-1 T-1 ~> m s-2] + !! along-coordinate stress tensor [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: diffv !< Meridional acceleration due to convergence - !! of along-coordinate stress tensor [m s-1 T-1 ~> m s-2]. + !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that @@ -1303,8 +1303,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = US%L_T_to_m_s * & - ((G%IdyCu(I,j)*(CS%dy2h(i,j) *str_xx(i,j) - & + diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%dy2h(i,j) *str_xx(i,j) - & CS%dy2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%dx2q(I,J-1)*str_xy(I,J-1) - & CS%dx2q(I,J) *str_xy(I,J))) * & @@ -1326,8 +1325,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = US%L_T_to_m_s * & - ((G%IdyCv(i,J)*(CS%dy2q(I-1,J)*str_xy(I-1,J) - & + diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%dy2q(I-1,J)*str_xy(I-1,J) - & CS%dy2q(I,J) *str_xy(I,J)) - & G%IdxCv(i,J)*(CS%dx2h(i,j) *str_xx(i,j) - & CS%dx2h(i,j+1)*str_xx(i,j+1))) * & @@ -2156,10 +2154,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Register fields for output from this module. CS%id_diffu = register_diag_field('ocean_model', 'diffu', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) + 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) + 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & From 070c6048b8b58ecca18bed0ad846ac59e75a37ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 04:31:29 -0400 Subject: [PATCH 042/104] (*)Eliminated a bug in horizontal viscosity work Commented out code that deliberately retained a bug, thereby eliminating the dimensionally inconsistent expressions for the limits on the estimates of energy extracted by the horizontal viscosity. The decision to simply eliminate this bug by commenting out code instead of adding a run-time bugfix parameter was taken after consulting with Scott Bachman and Malte Jansen, whose simulations seemed the most likely to be impacted. All answers are bitwise identical in the dev/gfdl MOM6-examples test cases, but other solutions could be changed. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 876cea507f..65b120c62e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1153,16 +1153,16 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (find_FrictWork) then if (CS%Laplacian) then - if (CS%biharmonic) then + ! if (CS%biharmonic) then !### This code is dimensionally incorrect, but needed to reproduce previous answers. ! This should be considered a serious bug in cases where the answers change if the ! following code is commented out - i.e. if both biharmonic and Laplacian are used ! and FindFrictWork is true. - do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) - dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) - enddo ; enddo - endif + ! do J=js-1,Jeq ; do I=is-1,Ieq + ! dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) + ! dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) + ! enddo ; enddo + ! endif if (CS%answers_2018) then do j=js,je ; do i=is,ie From f07e85f47e90c3d2cf77907cbba3aefb469552ce Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 05:15:26 -0400 Subject: [PATCH 043/104] Rescaled internal variables in MOM_MEKE.F90 Rescaled multiple internal variables in MOM_MEKE.F90 for more complete dimensional consistency testing. Two dimensionally inconsistent expressions (i.e., bugs) were identified and marked; one of these bugs makes the horizontal advection of MEKE much less effective than is should have been, the other arises from dimensional inconsistency in the use of the dragrate variable when MEKE_JANSEN15_DRAG is true. It is conceivable that underflow would be an issue in some test cases with out an explicitly set underflow velocity, but all answers in the MOM6-examples test cases are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 420 +++++++++++---------- 1 file changed, 220 insertions(+), 200 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 20aecb07c1..aa0242b8fc 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -33,7 +33,7 @@ module MOM_MEKE 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] - real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [s-1]. + real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [T-1 ~> s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 !! to account for the surface intensification of MEKE. @@ -51,12 +51,12 @@ module MOM_MEKE logical :: use_old_lscale !< Use the old formula for mixing length scale. logical :: use_min_lscale !< Use simple minimum for mixing length scale. real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. - real :: MEKE_BGsrc !< Background energy source for MEKE [W kg-1] (= m2 s-3). + real :: MEKE_BGsrc !< Background energy source for MEKE [L2 T-3 ~> W kg-1] (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim] real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh [nondim] - real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] - real :: MEKE_KH !< Background lateral diffusion of MEKE [m2 s-1] - real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] + real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [L T-1 ~> m s-1] + real :: MEKE_KH !< Background lateral diffusion of MEKE [L2 T-1 ~> m2 s-1] + real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [L4 T-1 ~> m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for !! MEKE itself [nondim]. real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for @@ -65,7 +65,7 @@ module MOM_MEKE real :: viscosity_coeff_Au !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral biharmonic momentum mixing !! by unresolved eddies represented by MEKE. - real :: Lfixed !< Fixed mixing length scale [m]. + real :: Lfixed !< Fixed mixing length scale [L ~> m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] real :: aFrict !< Weighting towards frictional arrest scale of mixing length [nondim] @@ -116,40 +116,47 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZI_(G),SZJ_(G)) :: & mass, & ! The total mass of the water column [kg m-2]. I_mass, & ! The inverse of mass [m2 kg-1]. - src, & ! The sum of all MEKE sources [m2 s-3]. - MEKE_decay, & ! The MEKE decay timescale [s-1]. - MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. - MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. - MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. - drag_rate_visc, & - drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. - del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [s-2]. - del4MEKE, & ! MEKE tendency arising from the biharmonic of MEKE [m2 s-2]. - LmixScale, & ! Square of eddy mixing length [m2]. + src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3). + MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. + ! MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. + ! MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. + ! MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. + drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] + drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + drag_rate_J15, & ! The MEKE spindown timescale due to bottom drag with the Jansen 2015 scheme. + ! Unfortunately, as written the units seem inconsistent. [T-1 ~> s-1]. + del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2]. + del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2]. + LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. - Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. - baroHu, & ! Depth integrated accumulated zonal mass flux [H m2 ~> m3 or kg]. + MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHu, & ! Depth integrated accumulated zonal mass flux [H L2 ~> m3 or kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points [m s-1]. + ! u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. - Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. - baroHv, & ! Depth integrated accumulated meridional mass flux [H m2 ~> m3 or kg]. + MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHv, & ! Depth integrated accumulated meridional mass flux [H L2 ~> m3 or kg]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points [m s-1]. - real :: Kh_here, Inv_Kh_max, K4_here + ! v-points [Z T-1 ~> m s-1]. + real :: Kh_here ! The local horizontal viscosity [L2 T-1 ~> m2 s-1] + real :: Inv_Kh_max ! The inverse of the local horizontal viscosity [T L-2 ~> s m-2] + real :: K4_here ! The local horizontal biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Inv_K4_max ! The inverse of the local horizontal biharmonic viscosity [T L-4 ~> s m-4] real :: cdrag2 real :: advFac ! The product of the advection scaling factor and some unit conversion - ! factors divided by the timestep [m H-1 s-1 ~> s-1 or m3 kg-1 s-1] + ! factors divided by the timestep [m H-1 T-1 ~> s-1 or m3 kg-1 s-1] real :: mass_neglect ! A negligible mass [kg m-2]. - real :: ldamping ! The MEKE damping rate [s-1]. + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. - real :: sdt ! dt to use locally [s] (could be scaled to accelerate) - real :: sdt_damp ! dt for damping [s] (sdt could be split). + real :: sdt ! dt to use locally [T ~> s] (could be scaled to accelerate) + real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -161,10 +168,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - Rho0 = GV%H_to_kg_m2 * GV%m_to_H - mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping - if (CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0 .or. CS%MEKE_Cb>0. & + if ((US%s_to_T*CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & .or. CS%visc_drag) then use_drag_rate = .true. else @@ -172,7 +176,10 @@ 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 (associated(MEKE%MEKE)) then + if (.not.associated(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)) & @@ -186,8 +193,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif - ! Why are these 3 lines repeated from above? - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + sdt = US%s_to_T*dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping Rho0 = GV%H_to_kg_m2 * GV%m_to_H mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff cdrag2 = CS%cdrag**2 @@ -203,7 +209,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) = US%L_to_m**2*hu(I,j,k) + baroHu(I,j) = hu(I,j,k) enddo ; enddo enddo do J=js-1,je ; do i=is,ie @@ -211,7 +217,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-1,je ; do i=is,ie - baroHv(i,J) = US%L_to_m**2*hv(i,J,k) + baroHv(i,J) = hv(i,J,k) enddo ; enddo enddo endif @@ -219,7 +225,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie - drag_rate(i,j) = 0. + drag_rate(i,j) = 0. ; drag_rate_J15(i,j) = 0. enddo ; enddo endif @@ -229,18 +235,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * US%Z_to_L * & ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & G%areaCu(I,j)*drag_vel_u(I,j)) + & (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & @@ -273,12 +279,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculates bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then - call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) + call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, scale=US%Z_to_m*US%s_to_T) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) - call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI) + call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI, scale=US%L_T_to_m_s) call hchksum(bottomFac2, 'MEKE bottomFac2',G%HI) call hchksum(barotrFac2, 'MEKE barotrFac2',G%HI) - call hchksum(LmixScale, 'MEKE LmixScale',G%HI) + call hchksum(LmixScale, 'MEKE LmixScale',G%HI,scale=US%L_to_m) endif ! Aggregate sources of MEKE (background, frictional and GM) @@ -290,14 +296,14 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(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)*US%L_to_m**2*US%s_to_T**3*MEKE%mom_src(i,j) + 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 !$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)*US%L_to_m**2*US%s_to_T**3*MEKE%GME_snk(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif @@ -305,13 +311,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%GM_src_alt) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) / & - MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant. + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & + MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant (1 m?). enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) enddo ; enddo endif endif @@ -319,7 +325,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Increase EKE by a full time-steps worth of source !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + US%m_s_to_L_T**2*sdt*src(i,j) )*G%mask2dT(i,j) + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j))*G%mask2dT(i,j) enddo ; enddo if (use_drag_rate) then @@ -327,16 +333,15 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (cdrag2/MAX(1.0,G%bathyT(i,j))) * & - sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + & - 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) * & - 2.0 * bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j) + drag_rate_J15(i,j) = US%L_to_m**3*US%s_to_T**2 * (cdrag2/MAX(1.0,G%bathyT(i,j))) * & + sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) * & + 2.0 * bottomFac2(i,j)*MEKE%MEKE(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + drag_rate(i,j) = (US%L_to_m*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo endif endif @@ -345,8 +350,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j), US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j)) + ldamping = CS%MEKE_damping + drag_rate_J15(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j), US%m_to_L**2*US%T_to_s**2*sdt_damp*drag_rate_J15(i,j)) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else @@ -372,48 +377,50 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 + ! Here the units of MEKE_uflux are [L2 T-2]. MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & - ! US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 + ! Here the units of MEKE_vflux are [L2 T-2]. MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & - ! US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - del2MEKE(i,j) = US%m_to_L**2*G%IareaT(i,j) * & + del2MEKE(i,j) = G%IareaT(i,j) * & ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) - ! del2MEKE(i,j) = (US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j)) * & + ! del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & ! ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) enddo ; enddo ! Bi-harmonic diffusion of MEKE - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))))**2 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + max(G%IareaT(i,j), G%IareaT(i+1,j)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max + ! Here the units of MEKE_uflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))))**2 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j), G%IareaT(i,j+1)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & @@ -422,7 +429,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Store tendency arising from the bi-harmonic in del4MEKE !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - del4MEKE(i,j) = (sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & + del4MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo @@ -431,64 +438,70 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%kh_flux_enabled) then ! Lateral diffusion of MEKE - Kh_here = max(0.,CS%MEKE_Kh) + Kh_here = max(0., CS%MEKE_Kh) !$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)) & - Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + 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)) & Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) + 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)) * & - max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) + max(G%IareaT(i,j),G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) + (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) 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)) & - Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + 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)) & - Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(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(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) + 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 Kh_v(i,J) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) + (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then - advFac = GV%H_to_m * CS%MEKE_advection_factor / dt + !### I think that for dimensional consistency, this should be: + ! advFac = GV%H_to_kg_m2 * CS%MEKE_advection_factor / (US%s_to_T*dt) + advFac = GV%H_to_m * CS%MEKE_advection_factor / (US%s_to_T*dt) !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHu(I,j)>0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac elseif (baroHu(I,j)<0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i+1,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i+1,j)*advFac endif enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHv(i,J)>0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac elseif (baroHv(i,J)<0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j+1)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j+1)*advFac endif enddo ; enddo endif + + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*(sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & + ! This expression is correct if the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo @@ -498,7 +511,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*del4MEKE(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + del4MEKE(i,j) enddo ; enddo endif @@ -510,15 +523,15 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j) + ldamping = CS%MEKE_damping + drag_rate_J15(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - US%m_to_L**2*US%T_to_s**2*sdt_damp*drag_rate_J15(i,j) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + drag_rate(i,j) = (US%L_to_m*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do i=is,ie @@ -564,7 +577,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & - sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif endif @@ -573,13 +586,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate viscosity for the main model to use if (CS%viscosity_coeff_Ku /=0.) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif if (CS%viscosity_coeff_Au /=0.) then do j=js,je ; do i=is,ie - MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * US%m_to_L**3*LmixScale(i,j)**3 + MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j)**3 enddo ; enddo endif @@ -618,10 +631,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call post_data(CS%id_gamma_t, barotrFac2, CS%diag) endif -! else ! if MEKE%MEKE -! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") - endif - end subroutine step_forward_MEKE !> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity @@ -632,17 +641,28 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m 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 !< MEKE data. + type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution + !! to the MEKE drag rate [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. ! Local variables - real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady - real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src - real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: SN ! The local Eady growth rate [T-1 ~> s-1] + real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim] + real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m] + real :: I_H, KhCoeff + real :: Kh ! A lateral diffusivity [L2 T-1 ~> m2 s-1] + real :: Ubg2 ! Background (tidal?) velocity squared [L2 T-2 ~> m2 s-2] + real :: cd2 + real :: drag_rate ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + real :: src ! The sum of MEKE sources [L2 T-3 ~> W kg-1] + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. + real :: EKE, EKEmin, EKEmax, EKEerr ! [L2 T-2 ~> m2 s-2] + real :: resid, ResMin, ResMax ! Residuals [L2 T-3 ~> W kg-1] + real :: FatH ! Coriolis parameter at h points; to compute topographic beta [T-1 ~> s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -656,12 +676,12 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !$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.) + ! 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( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) + SN = US%T_to_s * min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - FatH = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points + FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points ! Since zero-bathymetry cells are masked, this avoids calculations on land if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then @@ -670,63 +690,61 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !### Consider different combinations of these estimates of topographic beta, and the use ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i+1,j)-G%bathyT(i,j)) * US%m_to_L*G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & + / max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif + beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & + (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) - - I_H = GV%Rho0 * I_mass(i,j) + I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then ! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E EKEmin = 0. ! Use the trivial root as the left bracket ResMin = 0. ! Need to detect direction of left residual - EKEmax = 0.01 ! First guess at right bracket + EKEmax = 0.01*US%m_s_to_L_T**2 ! First guess at right bracket useSecant = .false. ! Start using a bisection method ! First find right bracket for which resid<0 - resid = 1. ; n1 = 0 + resid = 1.0*US%m_to_L**2*US%T_to_s**3 ; n1 = 0 do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & - bottomFac2, barotrFac2, LmixScale, & - Lrhines, Leady) + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, EKE, & + bottomFac2, barotrFac2, LmixScale, LRhines, LEady) ! TODO: Should include resolution function in Kh Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale) src = Kh * (SN * SN) - drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) + drag_rate = I_H * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) ldamping = CS%MEKE_damping + drag_rate * bottomFac2 resid = src - ldamping * EKE - if (debugIteration) then - write(0,*) n1, 'EKE=',EKE,'resid=',resid - write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin - write(0,*) 'src=',src,'ldamping=',ldamping - write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 - write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 - endif + ! if (debugIteration) then + ! write(0,*) n1, 'EKE=',EKE,'resid=',resid + ! write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin + ! write(0,*) 'src=',src,'ldamping=',ldamping + ! write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 + ! write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 + ! endif if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here EKEmax = 10. * EKE ! and guess again for the right bracket if (resid 2.e17) then + if (US%L_T_to_m_s**2*EKEmax > 2.e17) then if (debugIteration) stop 'Something has gone very wrong' debugIteration = .true. resid = 1. ; n1 = 0 EKEmin = 0. ; ResMin = 0. - EKEmax = 0.01 + EKEmax = 0.01*US%m_s_to_L_T**2 useSecant = .false. endif endif @@ -735,7 +753,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! Bisect the bracket n2 = 0 ; EKEerr = EKEmax - EKEmin - do while (EKEerr>tolerance) + do while (US%L_T_to_m_s**2*EKEerr>tolerance) n2 = n2 + 1 if (useSecant) then EKE = EKEmin + (EKEmax - EKEmin) * (ResMin / (ResMin - ResMax)) @@ -749,7 +767,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) ldamping = CS%MEKE_damping + drag_rate * bottomFac2 resid = src - ldamping * EKE - if (useSecant.and.resid>ResMin) useSecant = .false. + if (useSecant .and. resid>ResMin) useSecant = .false. if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here if (resid m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN - real :: FatH ! Coriolis parameter at h points [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real, dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady ! Possible mixing length scales [L ~> m] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: SN ! The local Eady growth rate [T-1 ~> s-1] + real :: FatH ! Coriolis parameter at h points [T-1 ~> s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -802,12 +821,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25 * US%T_to_s*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif - FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1) ) + & - ( G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1) ) ) ! Coriolis parameter at h points + FatH = 0.25* ( ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1) ) + & + ( G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1) ) ) ! Coriolis parameter at h points ! If bathyT is zero, then a division by zero FPE will be raised. In this ! case, we apply Adcroft's rule of reciprocals and set the term to zero. @@ -818,61 +837,62 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & !### Consider different combinations of these estimates of topographic beta, and the use ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i+1,j)-G%bathyT(i,j)) * US%m_to_L*G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & + / max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & + (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) else beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, US%L_T_to_m_s**2*MEKE%MEKE(i,j), US%Z_to_m, & + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & - Lrhines(i,j), Leady(i,j)) + LRhines(i,j), LEady(i,j)) enddo ; enddo - if (CS%id_Lrhines>0) call post_data(CS%id_Lrhines, Lrhines, CS%diag) - if (CS%id_Leady>0) call post_data(CS%id_Leady, Leady, CS%diag) + if (CS%id_Lrhines>0) call post_data(CS%id_LRhines, LRhines, CS%diag) + if (CS%id_Leady>0) call post_data(CS%id_LEady, LEady, CS%diag) end subroutine MEKE_lengthScales !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & +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. - real, intent(in) :: area !< Grid cell area [m2] - real, intent(in) :: beta !< Planetary beta = |grad F| [s-1 m-1] + 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 = |grad F| [T-1 L-1 ~> s-1 m-1] real, intent(in) :: depth !< Ocean depth [Z ~> m] real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. - real, intent(in) :: SN !< Eady growth rate [s-1]. - real, intent(in) :: EKE !< Eddy kinetic energy [m s-1]. - real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to - !! the units for lateral distances (L). + real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1]. + real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. +! real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to +! !! the units for lateral distances (L). real, intent(out) :: bottomFac2 !< gamma_b^2 real, intent(out) :: barotrFac2 !< gamma_t^2 - real, intent(out) :: LmixScale !< Eddy mixing length [m]. - real, intent(out) :: Lrhines !< Rhines length scale [m]. - real, intent(out) :: Leady !< Eady length scale [m]. + real, intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. + real, intent(out) :: Lrhines !< Rhines length scale [L ~> m]. + real, intent(out) :: Leady !< Eady length scale [L ~> m]. ! Local variables - real :: Lgrid, Ldeform, LdeformLim, Ue, Lfrict + real :: Lgrid, Ldeform, Lfrict ! Length scales [L ~> m] + real :: Ue ! An eddy velocity [L T-1 ~> m s-1] ! Length scale for MEKE derived diffusivity Lgrid = sqrt(area) ! Grid scale Ldeform = Lgrid * Rd_dx ! Deformation scale - Lfrict = (Z_to_L * depth) / CS%cdrag ! Frictional arrest scale + Lfrict = (US%Z_to_L * depth) / CS%cdrag ! Frictional arrest scale ! gamma_b^2 is the ratio of bottom eddy energy to mean column eddy energy ! used in calculating bottom drag bottomFac2 = CS%MEKE_CD_SCALE**2 @@ -881,7 +901,7 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & ! gamma_t^2 is the ratio of barotropic eddy energy to mean column eddy energy ! used in the velocity scale for diffusivity barotrFac2 = 1. - if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1./( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 + if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1. / ( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 barotrFac2 = max(barotrFac2, CS%MEKE_min_gamma) if (CS%use_old_lscale) then if (CS%Rd_as_max_scale) then @@ -891,9 +911,9 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & endif else Ue = sqrt( 2.0 * max( 0., barotrFac2*EKE ) ) ! Barotropic eddy flow scale - Lrhines = sqrt( Ue / max( beta, 1.e-30 ) ) ! Rhines scale + Lrhines = sqrt( Ue / max( beta, 1.e-30*US%T_to_s*US%L_to_m ) ) ! Rhines scale if (CS%aEady > 0.) then - Leady = Ue / max( SN, 1.e-15 ) ! Bound Eady time-scale < 1e15 seconds + Leady = Ue / max( SN, 1.e-15*US%T_to_s ) ! Bound Eady time-scale < 1e15 seconds else Leady = 0. endif @@ -970,7 +990,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "MEKE_DAMPING", CS%MEKE_damping, & "The local depth-independent MEKE dissipation rate.", & - units="s-1", default=0.0) + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & "The ratio of the bottom eddy velocity to the column mean "//& "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//& @@ -1005,15 +1025,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & - default=0.0) + default=0.0, scale=US%m_to_L**2*US%T_to_s**3) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & - units="m2 s-1", default=-1.0) + units="m2 s-1", default=-1.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "MEKE_K4", CS%MEKE_K4, & "A lateral bi-harmonic diffusivity of MEKE. "//& "Use a negative value to not apply bi-harmonic diffusion to MEKE.", & - units="m4 s-1", default=-1.0) + units="m4 s-1", default=-1.0, scale=US%m_to_L**4*US%T_to_s) call get_param(param_file, mdl, "MEKE_DTSCALE", CS%MEKE_dtScale, & "A scaling factor to accelerate the time evolution of MEKE.", & units="nondim", default=1.0) @@ -1026,7 +1046,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) units="nondim", default=1.0) call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & "The background velocity that is combined with MEKE to "//& - "calculate the bottom drag.", units="m s-1", default=0.0) + "calculate the bottom drag.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "MEKE_JANSEN15_DRAG", CS%Jansen15_drag, & "If true, use the bottom drag formulation from Jansen et al. (2015) "//& "to calculate the drag acting on MEKE.", default=.false.) @@ -1072,7 +1092,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & "If positive, is a fixed length contribution to the expression "//& "for mixing length used in MEKE-derived diffusivity.", & - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & "If positive, is a coefficient weighting the deformation scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & @@ -1161,7 +1181,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & - 'MEKE decay rate', 's-1') + 'MEKE decay rate', 's-1', conversion=US%s_to_T) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 @@ -1172,11 +1192,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & - 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') + '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, & - 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm') + 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Leady = register_diag_field('ocean_model', 'MEKE_Leady', diag%axesT1, Time, & - 'Eady length scale used in the MEKE derived eddy diffusivity', 'm') + 'Eady length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_gamma_b = register_diag_field('ocean_model', 'MEKE_gamma_b', diag%axesT1, Time, & 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity', 'nondim') CS%id_gamma_t = register_diag_field('ocean_model', 'MEKE_gamma_t', diag%axesT1, Time, & @@ -1184,9 +1204,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) if (CS%kh_flux_enabled) then CS%id_KhMEKE_u = register_diag_field('ocean_model', 'KHMEKE_u', diag%axesCu1, Time, & - 'Zonal diffusivity of MEKE', 'm2 s-1') + 'Zonal diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhMEKE_v = register_diag_field('ocean_model', 'KHMEKE_v', diag%axesCv1, Time, & - 'Meridional diffusivity of MEKE', 'm2 s-1') + 'Meridional diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) endif CS%id_clock_pass = cpu_clock_id('(Ocean continuity halo updates)', grain=CLOCK_ROUTINE) From 133b03fafa20741990efe52cad076a46be35473d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 05:50:41 -0400 Subject: [PATCH 044/104] +Rescaled G%dF_dx & G%dF_dy to units of [T-1 L-1] Rescaled the units of G%dF_dx & G%dF_dy to [T-1 L-1] for more complete dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_grid.F90 | 4 ++-- src/framework/MOM_dyn_horgrid.F90 | 4 ++-- src/initialization/MOM_fixed_initialization.F90 | 4 ++-- src/initialization/MOM_shared_initialization.F90 | 9 +++++---- src/parameterizations/lateral/MOM_MEKE.F90 | 8 ++++---- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 8 ++++---- 7 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e7048cb2d3..1a2d03bd44 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -152,8 +152,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 1a1e9cbf43..ef74a12c9d 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -151,8 +151,8 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 0ee72e9bb0..8ed9a0a4c7 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -152,8 +152,8 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) if (debug) then call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L*US%s_to_T) + call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L*US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 1dac4295b8..3d0fe6f1ed 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -90,9 +90,9 @@ end subroutine MOM_initialize_rotation subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dx !< x-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dx !< x-component of grad f [T-1 L-1 ~> s-1 m-1] real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dy !< y-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dy !< y-component of grad f [T-1 L-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j @@ -111,12 +111,13 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) do j=G%jsc, G%jec ; do i=G%isc, G%iec f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) f2 = 0.5*( G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1) ) - dF_dx(i,j) = m_to_L*G%IdxT(i,j) * ( f1 - f2 ) + dF_dx(i,j) = G%IdxT(i,j) * ( f1 - f2 ) f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) f2 = 0.5*( G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1) ) - dF_dy(i,j) = m_to_L*G%IdyT(i,j) * ( f1 - f2 ) + dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) + end subroutine MOM_calculate_grad_Coriolis !> Return the global maximum ocean bottom depth in the same units as the input depth. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index aa0242b8fc..915290d90a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -701,8 +701,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & - (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) @@ -848,8 +848,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & - (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) else beta = 0. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 65b120c62e..66aa64987a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -253,7 +253,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [kg m-2 L2 T-3 ~> W m-2] ! Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] ! Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] - ! beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] + ! beta_h, & ! Gradient of planetary vorticity at h-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] @@ -277,7 +277,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] ! Leith_Kh_q, & ! Leith Laplacian viscosity at q-points [m2 s-1] ! Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [m4 s-1] - ! beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] + ! beta_q, & ! Gradient of planetary vorticity at q-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1] diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 58bc2776e0..00112c3d15 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -831,8 +831,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo grad_div_mag_u(I,j) = US%m_to_L*US%s_to_T*SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then - beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) + beta_u(I,j) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & * CS%Laplac3_const_u(I,j) * inv_PI3 else @@ -847,8 +847,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo grad_div_mag_v(i,J) = US%m_to_L*US%s_to_T*SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) if (CS%use_beta_in_QG_Leith) then - beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) + beta_v(i,J) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & * CS%Laplac3_const_v(i,J) * inv_PI3 else From a7e832c45498ba6ad4699426af197073c32b1ff8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 07:57:41 -0400 Subject: [PATCH 045/104] Rescaled variables in MOM_mixedlayer_restrat.F90 Rescaled multiple internal variables in MOM_mixedlayer_restrat.F90 for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_mixed_layer_restrat.F90 | 207 +++++++++--------- 1 file changed, 106 insertions(+), 101 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 4e1b257c31..37ce9f0b79 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -41,16 +41,16 @@ module MOM_mixed_layer_restrat !! [nondim]. This increases with grid spacing^2, up to something !! of order 500. real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD [nondim]. - real :: front_length !< If non-zero, is the frontal-length scale [m] used to calculate the + real :: front_length !< If non-zero, is the frontal-length scale [L ~> m] used to calculate the !! upscaling of buoyancy gradients that is otherwise represented !! by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is !! non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0. logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [s]. - real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [s]. - real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kgm-3]. + real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. + real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. + real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kg m-3]. real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer restratification !! depth used for a smoother stream function at the base of !! the mixed-layer [nondim]. @@ -109,15 +109,15 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, "Module must be initialized before it is used.") if (GV%nkml>0) then - call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) + call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, G, GV, US, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -129,36 +129,36 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_fast, & ! g_Rho0 times the average mixed layer density [m s-2] + Rml_av_fast, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_slow ! g_Rho0 times the average mixed layer density [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av_slow ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) [s-1] + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a @@ -166,11 +166,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! the mixed layer must be 0. real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [s], stored in 2-D arrays + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -179,7 +179,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho - real :: hAtVel, zpa, zpb, dh, res_scaling_fac, I_l_f + real :: hAtVel, zpa, zpb, dh, res_scaling_fac + real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: proper_averaging, line_is_empty, keep_going, res_upscale real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions @@ -246,8 +247,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered,'mixed_layer_restrat: MLD_filtered',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_in,'mixed_layer_restrat: MLD in',G%HI,haloshift=1) endif - aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time ) + aFac = CS%MLE_MLD_decay_time / ( dt_in_T + CS%MLE_MLD_decay_time ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -263,8 +264,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered_slow,'mixed_layer_restrat: MLD_filtered_slow',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_fast,'mixed_layer_restrat: MLD fast',G%HI,haloshift=1,scale=GV%H_to_m) endif - aFac = CS%MLE_MLD_decay_time2 / ( dt + CS%MLE_MLD_decay_time2 ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time2 ) + aFac = CS%MLE_MLD_decay_time2 / ( dt_in_T + CS%MLE_MLD_decay_time2 ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time2 ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -280,14 +281,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 - I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + I4dt = 0.25 / (dt_in_T) + g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug if (CS%front_length>0.) then res_upscale = .true. - I_l_f = 1./CS%front_length + I_LFront = 1. / CS%front_length else res_upscale = .false. endif @@ -296,7 +297,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & +!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & !$OMP res_upscale, & !$OMP nz,MLD_fast,uDml_diag,vDml_diag,proper_averaging) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & @@ -312,7 +313,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -343,10 +344,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo if (CS%debug) then - call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m*US%s_to_T) - call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=US%m_to_Z) + call hchksum(h,'mixed_layer_restrat: h', G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(forces%ustar,'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) + call hchksum(MLD_fast,'mixed_layer_restrat: MLD', G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(Rml_av_fast,'mixed_layer_restrat: rml', G%HI, haloshift=1, & + scale=US%m_to_Z*US%L_to_m**2*US%s_to_T**2) endif ! TO DO: @@ -356,11 +358,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -372,8 +374,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - US%m_to_L*G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -381,8 +383,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - US%m_to_L*G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -421,7 +423,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -432,11 +434,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( (US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -448,8 +450,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - US%m_to_L*G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -457,8 +459,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - US%m_to_L*G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -497,7 +499,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -507,7 +509,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -526,14 +528,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_uml > 0) then do J=js,je ; do i=is-1,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) - uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * US%m_to_L*G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) + uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_uml, uDml_diag, CS%diag) endif if (CS%id_vml > 0) then do J=js-1,je ; do i=is,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) - vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * US%m_to_L*G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) + vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_vml, vDml_diag, CS%diag) endif @@ -547,7 +549,7 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. -subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) +subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -558,29 +560,29 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av ! g_Rho0 times the average mixed layer density [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] @@ -589,10 +591,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions [s], stored in 2-D + ! directions [T ~> s], stored in 2-D ! arrays for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -606,8 +608,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 - I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + I4dt = 0.25 / (dt_in_T) + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z @@ -635,7 +637,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo @@ -653,8 +655,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -663,10 +665,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - US%m_to_L*G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -687,7 +689,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -700,8 +702,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -710,16 +712,16 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - US%m_to_L*G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else I2htot = 1.0 / (htot(i,j) + htot(i,j+1) + h_neglect) z_topx2 = 0.0 - ! a(k) relates the sublayer transport to uDml with a linear profile. + ! a(k) relates the sublayer transport to vDml with a linear profile. ! The sum of a(k) through the mixed layers must be 0. do k=1,nkml hx2 = (h(i,j,k) + h(i,j+1,k) + h_neglect) @@ -733,7 +735,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -743,7 +745,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -807,12 +809,11 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, if (.not. mixedlayer_restrat_init) return if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an "// & - "associated control structure.") + call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") endif ! Nonsense values to cause problems when these parameters are not used - CS%MLE_MLD_decay_time = -9.e9 + CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9 CS%MLE_tail_dh = -9.e9 CS%MLE_use_PBL_MLD = .false. @@ -839,7 +840,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "upscaling of buoyancy gradients that is otherwise represented "//& "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is "//& "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer "//& "depth provided by the active PBL parameterization. If false, "//& @@ -849,12 +850,12 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "The time-scale for a running-mean filter applied to the mixed-layer "//& "depth used in the MLE restratification parameterization. When "//& "the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & "The time-scale for a running-mean filter applied to the filtered "//& "mixed-layer depth used in a second MLE restratification parameterization. "//& "When the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) if (.not. CS%MLE_use_PBL_MLD) then call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer "//& @@ -876,8 +877,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%diag => diag - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif + if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0*US%L_to_m**2*US%s_to_T + else ; flux_to_kg_per_s = US%L_to_m**2*US%s_to_T ; endif CS%id_uhml = register_diag_field('ocean_model', 'uhml', diag%axesCuL, Time, & 'Zonal Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & @@ -886,22 +887,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, 'Meridional Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & x_cell_method='sum', v_extensive=.true.) CS%id_urestrat_time = register_diag_field('ocean_model', 'MLu_restrat_time', diag%axesCu1, Time, & - 'Mixed Layer Zonal Restratification Timescale', 's') + 'Mixed Layer Zonal Restratification Timescale', 's', conversion=US%T_to_s) CS%id_vrestrat_time = register_diag_field('ocean_model', 'MLv_restrat_time', diag%axesCv1, Time, & - 'Mixed Layer Meridional Restratification Timescale', 's') + 'Mixed Layer Meridional Restratification Timescale', 's', conversion=US%T_to_s) CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, & 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm') CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & - 'm s2', conversion=US%m_to_Z) + 'm s2', conversion=US%m_to_Z*US%L_to_m**2*US%s_to_T**2) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & - 'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for zonal restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & - 'Transport stream function amplitude for meridional restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for meridional restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_uml = register_diag_field('ocean_model', 'uml_restrat', diag%axesCu1, Time, & - 'Surface zonal velocity component of mixed layer restratification', 'm s-1') + 'Surface zonal velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & - 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + 'Surface meridional velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) ! Rescale variables from restart files if the internal dimensional scalings have changed. if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then From c9f0b2a4324028a61e86f863ddca77a7b37bbe2d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 17:02:03 -0400 Subject: [PATCH 046/104] Rescaled variables in MOM_thickness_diffuse.F90 Rescaled multiple internal variables in MOM_thickness_diffuse.F90 for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_thickness_diffuse.F90 | 481 +++++++++--------- 1 file changed, 246 insertions(+), 235 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 1878072e52..8fa5beb918 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -35,14 +35,14 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private - real :: Khth !< Background interface depth diffusivity [m2 s-1] + real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [m2 s-1] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion - real :: Khth_Min !< Minimum value of Khth [m2 s-1] - real :: Khth_Max !< Maximum value of Khth [m2 s-1], or 0 for no max + real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] + real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers [Z2 s-1 ~> m2 s-1]. + !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. logical :: thickness_diffuse !< If true, interfaces heights are diffused. logical :: use_FGNV_streamfn !< If true, use the streamfunction formulation of !! Ferrari et al., 2010, which effectively emphasizes @@ -52,12 +52,12 @@ module MOM_thickness_diffuse real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, !! streamfunction formulation [m s-1]. real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, - !! streamfunction formulation [s-2]. + !! streamfunction formulation [T-2 ~> s-2]. logical :: detangle_interfaces !< If true, add 3-d structured interface height !! diffusivities to horizontally smooth jagged layers. real :: detangle_time !< If detangle_interfaces is true, this is the !! timescale over which maximally jagged grid-scale - !! thickness variations are suppressed [s]. This must be + !! thickness variations are suppressed [T ~> s]. This must be !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes @@ -68,7 +68,7 @@ module MOM_thickness_diffuse real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of !! the GEOMETRIC thickness difussion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness - !! diffusivity [s-1]. + !! diffusivity [T-1 ~> s-1]. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. @@ -78,8 +78,8 @@ module MOM_thickness_diffuse real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns (m2 s-1) - KH_v_GME => NULL() !< interface height diffusivities in v-columns (m2 s-1) + KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [m2 s-1] + KH_v_GME => NULL() !< interface height diffusivities in v-columns [m2 s-1] !>@{ !! Diagnostic identifier @@ -114,40 +114,41 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. - real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] - real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] + real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & - KH_u, & ! interface height diffusivities in u-columns [m2 s-1] + KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & - KH_v, & ! interface height diffusivities in v-columns [m2 s-1] + KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - KH_t ! diagnosed diffusivity at tracer points [m2 s-1] + KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G), SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [m2 s-1] + KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G), SZJB_(G)) :: & - KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [m2 s-1] + KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [L2 T-1 ~> m2 s-1] real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) - real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [m2 s-1] + real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] + real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] - real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] + 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:"// & "Module must be initialized before it is used.") @@ -157,6 +158,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff + dt_in_T = US%s_to_T*dt if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -183,12 +185,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*US%m_to_L**2*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt_in_T * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt_in_T * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -201,14 +203,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP int_slope_v,khth_use_ebt_struct) !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = CS%Khth + Khth_loc_u(I,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + & + CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -217,13 +220,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & - US%L_T_to_m_s**2*0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & - (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & + 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + (US%T_to_s*VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + 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 @@ -231,24 +234,24 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) * VarMix%Res_fn_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) * VarMix%Res_fn_u(I,j) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, min(Khth_Loc_u(I,j),CS%Khth_Max)) + Khth_loc_u(I,j) = max(CS%Khth_Min, min(Khth_loc_u(I,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, Khth_Loc_u(I,j)) + Khth_loc_u(I,j) = max(CS%Khth_Min, Khth_loc_u(I,j)) enddo ; enddo endif !$OMP do do j=js,je; do I=is-1,ie - KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_Loc_u(I,j)) + KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_loc_u(I,j)) enddo ; enddo if (khth_use_ebt_struct) then @@ -267,7 +270,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do j=js,je ; do I=is-1,ie - KH_u(I,j,k) = VarMix%KH_u_QG(I,j,k) + KH_u(I,j,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_u_QG(I,j,k) enddo ; enddo ; enddo endif endif @@ -275,20 +278,20 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then do k=1,nz+1 ; do j=js,je ; do I=is-1,ie - CS%KH_u_GME(I,j,k) = KH_u(I,j,k) + CS%KH_u_GME(I,j,k) = US%L_to_m**2*US%s_to_T*KH_u(I,j,k) enddo ; enddo ; enddo endif !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = CS%Khth + Khth_loc(i,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) enddo ; enddo endif endif @@ -296,13 +299,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie - Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & - US%L_T_to_m_s**2*0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & - (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) + Khth_loc(I,j) = Khth_loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & + 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + (US%T_to_s*VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Khth_loc(i,j) = Khth_loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif endif ; endif @@ -310,26 +313,26 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) * VarMix%Res_fn_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) * VarMix%Res_fn_v(i,J) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, min(Khth_Loc(i,j),CS%Khth_Max)) + Khth_loc(i,j) = max(CS%Khth_Min, min(Khth_loc(i,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, Khth_Loc(i,j)) + Khth_loc(i,j) = max(CS%Khth_Min, Khth_loc(i,j)) enddo ; enddo endif if (CS%max_Khth_CFL > 0.0) then !$OMP do do J=js-1,je ; do i=is,ie - KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_Loc(i,j)) + KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_loc(i,j)) enddo ; enddo endif @@ -349,7 +352,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do J=js-1,je ; do i=is,ie - KH_v(i,J,k) = VarMix%KH_v_QG(i,J,k) + KH_v(i,J,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_v_QG(i,J,k) enddo ; enddo ; enddo endif endif @@ -357,7 +360,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then do k=1,nz+1 ; do J=js-1,je ; do i=is,ie - CS%KH_v_GME(i,J,k) = KH_v(i,J,k) + CS%KH_v_GME(i,J,k) = US%L_to_m**2*US%s_to_T*KH_v(i,J,k) enddo ; enddo ; enddo endif @@ -365,8 +368,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is,ie - MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * US%s_to_T*MEKE%MEKE(i,j) / & - (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & + !### This will not give bitwise rotational symmetry. Add parentheses. + MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & + (0.25*US%T_to_s*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo endif @@ -380,12 +384,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP end parallel if (CS%detangle_interfaces) then - call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, & + call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, & CS, int_slope_u, int_slope_v) endif if (CS%debug) then - call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI,haloshift=0) + call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0) call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=US%Z_to_m) @@ -401,10 +405,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v) endif @@ -448,7 +452,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ! diagnose diffusivity at T-point do j=js,je ; do i=is,ie - KH_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & + Kh_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & +(hv(i,J-1)*KH_v_lay(i,J-1)+hv(i,J)*KH_v_lay(i,J))) & / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) enddo ; enddo @@ -458,7 +462,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp MEKE%Kh_diff(:,:) = 0.0 do k=1,nz do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + US%m_to_L**2*US%T_to_s*KH_t(i,j,k) * h(i,j,k) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + Kh_t(i,j,k) * h(i,j,k) enddo; enddo enddo @@ -476,15 +480,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhD(I,j,k)*dt - if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T + if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = US%L_to_m**2*US%s_to_T*uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhD(i,J,k)*dt - if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T + if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = US%L_to_m**2*US%s_to_T*vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt * US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -497,7 +501,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%debug) then call uvchksum("thickness_diffuse [uv]hD", uhD, vhD, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) call uvchksum("thickness_diffuse [uv]htr", uhtr, vhtr, & G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) call hchksum(h, "thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) @@ -508,7 +512,7 @@ end subroutine thickness_diffuse !> Calculates parameterized layer transports for use in the continuity equation. !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). -subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & +subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -516,16 +520,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points [m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of @@ -547,28 +551,28 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself [kg m-3], when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer [nondim]. 0 m s-2], ! used for calculating PE release real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below, nondim) - hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [m s-2] + hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [L2 Z-1 T-2 ~> m s-2], ! used for calculating PE release real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres, & ! The pressure at an interface [Pa]. - h_avail_rsum ! The running sum of h_avail above an interface [H m2 s-1 ~> m3 s-1 or kg s-1]. + h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1] drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1] drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. - real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & T_u, & ! Temperature on the interface at the u-point [degC]. S_u, & ! Salinity on the interface at the u-point [ppt]. @@ -580,9 +584,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [W]. real :: Work_h ! The work averaged over an h-cell [W m-2]. - real :: PE_release_h ! The amount of potential energy released by GM, averaged over an h-cell [m3 s-3]. + real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. - real :: I4dt ! 1 / 4 dt [s-1]. + real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. @@ -597,26 +601,26 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. - real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [m2 Z-1 s-2 ~> m s-2]. + real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. + real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning - ! streamfunction [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z m2 s-1 ~> m3 s-1]. + ! streamfunction [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: Sfn_in_h ! The overturning streamfunction [H m2 s-1 ~> m3 s-1 or kg s-1] (note that + real :: Sfn_in_h ! The overturning streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] (note that ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a - ! good thing to use when the slope is so large as to be meaningless [Z m2 s-1 ~> m3 s-1]. + ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -624,14 +628,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors [m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! factors [m3 T Z-1 H-1 s-3 ~> m s-2 or m4 kg-1 s-2]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. - real :: G_rho0 ! g/Rho0 [m5 Z-1 s-2 ~> m4 s-2]. + real :: G_rho0 ! g/Rho0 [L2 m3 Z-1 T-2 ~> m4 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors [s-2 m2 Z-2 ~> s-2] + ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v @@ -640,13 +644,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB - I4dt = 0.25 / dt + I4dt = 0.25 / (dt_in_T) I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 * GV%H_to_m + G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**3 * GV%H_to_m h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z - G_rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 - N2_floor = CS%N2_floor*US%Z_to_m**2 + G_rho0 = GV%g_Earth / GV%Rho0 + 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) @@ -666,7 +670,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, 1, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt_in_T, T, S, G, GV, 1, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -681,7 +685,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,1) = 0.0 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - h_avail(i,j,1) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) + h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) @@ -689,7 +693,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) @@ -804,11 +808,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdx**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -822,16 +826,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_L*((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_x_PE(I,j,k) = MIN(Slope,CS%slope_max) - hN2_x_PE(I,j,k) = hN2_u(I,K) * US%m_to_Z + hN2_x_PE(I,j,k) = hN2_u(I,K) if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -857,11 +861,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_L*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) - hN2_u(I,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) + hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -875,7 +879,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) - c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) + c2_h_u(I,k) = CS%FGNV_scale * & + ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -909,11 +914,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. - uhD(I,j,k) = max(min((Sfn_in_h - uhtot(I,j)), h_avail(i,j,k)), & + uhD(I,j,k) = max(min((Sfn_in_H - uhtot(I,j)), h_avail(i,j,k)), & -h_avail(i+1,j,k)) if (CS%id_sfn_x>0) diag_sfn_x(I,j,K) = diag_sfn_x(I,j,K+1) + uhD(I,j,k) @@ -1053,11 +1058,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdy**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -1071,16 +1076,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_L*((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_y_PE(i,J,k) = MIN(Slope,CS%slope_max) - hN2_y_PE(i,J,k) = hN2_v(i,K) * US%m_to_Z + hN2_y_PE(i,J,k) = hN2_v(i,K) if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1106,11 +1111,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_L*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) - hN2_v(i,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) + hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect @@ -1124,7 +1129,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) - c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) + c2_h_v(i,k) = CS%FGNV_scale * & + ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1158,12 +1164,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. - vhD(i,J,k) = max(min((Sfn_in_h - vhtot(i,J)), h_avail(i,j,k)), & - -h_avail(i,j+1,k)) + vhD(i,J,k) = max(min((Sfn_in_H - vhtot(i,J)), h_avail(i,j,k)), -h_avail(i,j+1,k)) if (CS%id_sfn_y>0) diag_sfn_y(i,J,K) = diag_sfn_y(i,J,K+1) + vhD(i,J,k) ! sfn_y(i,J,K) = max(min(Sfn_in_h, vhtot(i,J)+h_avail(i,j,k)), & @@ -1269,16 +1274,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 if (find_work) then ; do j=js,je ; do i=is,ie ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. - Work_h = 0.5 * US%m_to_L**2*G%IareaT(i,j) * & + 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))) - PE_release_h = -0.25*(Kh_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & - Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & - Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & - Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) + PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & + Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & + Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & + Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then if (CS%GM_src_alt) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_m**2*US%m_to_Z*PE_release_h else MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*Work_h endif @@ -1300,7 +1305,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [m s-2] real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [m s-2] - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z m2 s-1 ~> m3 s-1] or arbitrary units + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z L2 T-1 ~> m3 s-1] or arbitrary units !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1329,7 +1334,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures -subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & +subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1337,15 +1342,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from @@ -1361,10 +1366,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at - ! u points [m2 s-1]. + ! u points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & Kh_lay_v ! The tentative interface height diffusivity for each layer at - ! v points [m2 s-1]. + ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the ! detangling is applied [H ~> m or kg m-2]. @@ -1377,44 +1382,44 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! normalized by the arithmetic mean thickness. real :: Kh_scale ! A ratio by which Kh_u_CFL is scaled for maximally jagged ! layers [nondim]. - real :: Kh_det ! The detangling diffusivity [m2 s-1]. +! real :: Kh_det ! The detangling diffusivity [m2 s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_sl ! The absolute value of the larger in magnitude of the slopes - ! above and below. + ! above and below [L Z-1 ~> nondim]. real :: Rsl ! The ratio of the smaller magnitude slope to the larger ! magnitude one [nondim]. 0 <= Rsl <1. real :: IRsl ! The (limited) inverse of Rsl [nondim]. 1 < IRsl <= 1e9. real :: dH ! The thickness gradient divided by the damping timescale ! and the ratio of the face length to the adjacent cell - ! areas for comparability with the diffusivities [m2 s-1]. - real :: adH ! The absolute value of dH [m2 s-1]. + ! areas for comparability with the diffusivities [L Z T-1 ~> m2 s-1]. + real :: adH ! The absolute value of dH [L Z T-1 ~> m2 s-1]. real :: sign ! 1 or -1, with the same sign as the layer thickness gradient. - real :: sl_K ! The sign-corrected slope of the interface above [nondim]. - real :: sl_Kp1 ! The sign-corrected slope of the interface below [nondim]. - real :: I_sl_K ! The (limited) inverse of sl_K [nondim]. - real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [nondim]. - real :: I_4t ! A quarter of a unit conversion factor divided by - ! the damping timescale [s-1]. + real :: sl_K ! The sign-corrected slope of the interface above [Z L-1 ~> nondim]. + real :: sl_Kp1 ! The sign-corrected slope of the interface below [Z L-1 ~> nondim]. + real :: I_sl_K ! The (limited) inverse of sl_K [L Z-1 ~> nondim]. + real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [L Z-1 ~> nondim]. + real :: I_4t ! A quarter of a flux scaling factor divided by + ! the damping timescale [T-1 ~> s-1]. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. - real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. - real :: Kh_max ! A local ceiling on the diffusivity [m2 s-1]. + ! real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. + real :: Kh_max ! A local ceiling on the diffusivity [L2 T-1 ~> m2 s-1]. real :: wt1, wt2 ! Nondimensional weights. ! Variables used only in testing code. ! real, dimension(SZK_(G)) :: uh_here ! real, dimension(SZK_(G)+1) :: Sfn - real :: dKh ! An increment in the diffusivity [m2 s-1]. + real :: dKh ! An increment in the diffusivity [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - Kh_bg, & ! The background (floor) value of Kh [m2 s-1]. - Kh, & ! The tentative value of Kh [m2 s-1]. - Kh_detangle, & ! The detangling diffusivity that could be used [m2 s-1]. + Kh_bg, & ! The background (floor) value of Kh [L2 T-1 ~> m2 s-1]. + Kh, & ! The tentative value of Kh [L2 T-1 ~> m2 s-1]. + Kh_detangle, & ! The detangling diffusivity that could be used [L2 T-1 ~> m2 s-1]. Kh_min_max_p, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K+1) [m2 s-1]. + ! based on the value of Kh(I,K+1) [L2 T-1 ~> m2 s-1]. Kh_min_max_m, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K-1) [m2 s-1]. + ! based on the value of Kh(I,K-1) [L2 T-1 ~> m2 s-1]. ! The following are variables that define the relationships between ! successive values of Kh. ! Search for Kh that satisfy... @@ -1423,15 +1428,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Kh(I,K) <= Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K) ! Kh(I,K) <= Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K) Kh_min_m , & ! See above [nondim]. - Kh0_min_m , & ! See above [m2 s-1]. + Kh0_min_m , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_m , & ! See above [nondim]. - Kh0_max_m, & ! See above [m2 s-1]. + Kh0_max_m, & ! See above [L2 T-1 ~> m2 s-1]. Kh_min_p , & ! See above [nondim]. - Kh0_min_p , & ! See above [m2 s-1]. + Kh0_min_p , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_p , & ! See above [nondim]. - Kh0_max_p ! See above [m2 s-1]. + Kh0_max_p ! See above [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G)) :: & - Kh_max_max ! The maximum diffusivity permitted in a column. + Kh_max_max ! The maximum diffusivity permitted in a column [L2 T-1 ~> m2 s-1].. logical, dimension(SZIB_(G)) :: & do_i ! If true, work on a column. integer :: i, j, k, n, ish, jsh, is, ie, js, je, nz, k_top @@ -1443,7 +1448,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! distributing the diffusivities more effectively (with wt1 & wt2), but this ! means that the additions to a single interface can be up to twice as large. Kh_scale = 0.5 - if (CS%detangle_time > dt) Kh_scale = 0.5 * dt / CS%detangle_time + if (CS%detangle_time > dt_in_T) Kh_scale = 0.5 * dt_in_T / CS%detangle_time do j=js-1,je+1 ; do i=is-1,ie+1 de_top(i,j,k_top) = 0.0 ; de_bot(i,j) = 0.0 @@ -1474,7 +1479,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_u(I,j,k) = (Kh_scale * Kh_u_CFL(I,j)) * jag_Rat**2 + KH_lay_u(I,j,k) = (Kh_scale * KH_u_CFL(I,j)) * jag_Rat**2 endif ; enddo ; enddo do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then @@ -1486,13 +1491,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_v(i,J,k) = (Kh_scale * Kh_v_CFL(i,J)) * jag_Rat**2 + KH_lay_v(i,J,k) = (Kh_scale * KH_v_CFL(i,J)) * jag_Rat**2 endif ; enddo ; enddo enddo ! Limit the diffusivities - I_4t = US%Z_to_m*Kh_scale / (4.0*dt) + I_4t = Kh_scale / (4.0 * dt_in_T) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1504,19 +1509,19 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (n==1) then ! This is a u-column. do i=ish,ie do_i(I) = (G%mask2dCu(I,j) > 0.0) - Kh_max_max(I) = Kh_u_CFL(I,j) + Kh_Max_max(I) = KH_u_CFL(I,j) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo else ! This is a v-column. do i=ish,ie - do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_max_max(I) = Kh_v_CFL(i,J) + do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_Max_max(I) = KH_v_CFL(i,J) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo @@ -1526,7 +1531,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = US%m_to_L * ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) + denom = ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1535,9 +1540,9 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) - sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) + sign = 1.0 ; if (dH < 0) sign = -1.0 + sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) + sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) ! Add the incremental diffusivites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1547,20 +1552,20 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_u(I,j,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_u(I,j,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = US%m_to_L * ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) + denom = ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) - sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) + sign = 1.0 ; if (dH < 0) sign = -1.0 + sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) + sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) ! Add the incremental diffusviites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1570,8 +1575,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_v(i,J,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_v(i,J,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_v(i,J,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_v(i,J,k) endif if (adH == 0.0) then @@ -1594,15 +1599,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / (Kh_Max_max(I))) Kh_min_m(I,K+1) = Fn_R ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = Rsl ; Kh0_max_m(I,K+1) = adH * I_sl Kh_min_p(I,K) = IRsl ; Kh0_min_p(I,K) = -adH * (I_sl*IRsl) Kh_max_p(I,K) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_p(I,K) = 0.0 elseif (sl_Kp1 < 0.0) then ! Opposite (nonzero) signs of slopes. - I_sl_K = 1e18 ; if (sl_K > 1e-18) I_sl_K = 1.0 / sl_K - I_sl_Kp1 = 1e18 ; if (-sl_Kp1 > 1e-18) I_sl_Kp1 = -1.0 / sl_Kp1 + I_sl_K = 1e18*US%Z_to_L ; if (sl_K > 1e-18*US%L_to_Z) I_sl_K = 1.0 / sl_K + I_sl_Kp1 = 1e18*US%Z_to_L ; if (-sl_Kp1 > 1e-18*US%L_to_Z) I_sl_Kp1 = -1.0 / sl_Kp1 Kh_min_m(I,K+1) = 0.0 ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = - sl_K*I_sl_Kp1 ; Kh0_max_m(I,K+1) = adH*I_sl_Kp1 @@ -1611,9 +1616,9 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! This limit does not use the slope weighting so that potentially ! sharp gradients in diffusivities are not forced to occur. - Kh_max = adH / (sl_K - sl_Kp1) - Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_max) - Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_max) + Kh_Max = adH / (sl_K - sl_Kp1) + Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_Max) + Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_Max) else ! Both slopes are of the same sign as dH. I_sl = 1.0 / sl_K Rsl = sl_Kp1 * I_sl ! 0 <= Rsl < 1 @@ -1622,7 +1627,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Rsl <= Fn_R <= 1 Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_Max_max(I)) Kh_min_m(I,K+1) = IRsl ; Kh0_min_m(I,K+1) = -adH * (I_sl*IRsl) Kh_max_m(I,K+1) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_m(I,K+1) = 0.0 @@ -1661,16 +1666,16 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do K=nz,k_top+1,-1 ; do i=ish,ie ; if (do_i(i)) then Kh(I,k) = max(Kh(I,K), min(Kh_min_p(I,K)*Kh(I,K+1) + Kh0_min_p(I,K), Kh(I,K+1))) - Kh_max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) - Kh(I,k) = min(Kh(I,k), Kh_max) + Kh_Max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) + Kh(I,k) = min(Kh(I,k), Kh_Max) endif ; enddo ; enddo ! I-loop & k-loop ! All non-zero min constraints on one diffusivity are max constraints on ! another layer, so the min constraints can now be discounted. ! Decrease the diffusivities to satisfy the max constraints. do K=k_top+1,nz ; do i=ish,ie ; if (do_i(i)) then - Kh_max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) - if (Kh(I,k) > Kh_max) Kh(I,k) = Kh_Max + Kh_Max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) + if (Kh(I,k) > Kh_Max) Kh(I,k) = Kh_Max endif ; enddo ; enddo ! i- and K-loops ! This code tests the solutions... @@ -1681,37 +1686,35 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! if (n==1) then ! u-point. ! if ((h(i+1,j,k) - h(i,j,k)) * & ! ((e(i+1,j,K)-e(i+1,j,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) -! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dy_Cu(I,j) -! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & +! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) +! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) +! if (abs(uh_here(k)) * min(G%IareaT(i,j), G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is up the thickness gradient.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(k)) - & -! (h(i+1,j,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i+1,j)*uh_here(k))) * & +! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(k)) - & +! (h(i+1,j,k) + 4.0*dt*G%IareaT(i+1,j)*uh_here(k))) * & ! (h(i,j,k) - h(i+1,j,k)) < 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is too large.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is too large.", .true.) ! endif ! endif ! endif ! else ! v-point ! if ((h(i,j+1,k) - h(i,j,k)) * & ! ((e(i,j+1,K)-e(i,j+1,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) -! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dx_Cv(i,J) -! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & +! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) +! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) +! if (abs(uh_here(K)) * min(G%IareaT(i,j), G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(K)) - & -! (h(i,j+1,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i,j+1)*uh_here(K))) * & +! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(K)) - & +! (h(i,j+1,k) + 4.0*dt*G%IareaT(i,j+1)*uh_here(K))) * & ! (h(i,j,k) - h(i,j+1,k)) < 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is too large.", .true.) @@ -1719,25 +1722,25 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! endif ! endif ! endif ! u- or v- selection. -! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) +! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! endif ! enddo ! enddo if (n==1) then ! This is a u-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(I,K) > Kh_u(I,j,K)) then - dKh = (Kh(I,K) - Kh_u(I,j,K)) + if (Kh(I,K) > KH_u(I,j,K)) then + dKh = (Kh(I,K) - KH_u(I,j,K)) int_slope_u(I,j,K) = dKh / Kh(I,K) - Kh_u(I,j,K) = Kh(I,K) + KH_u(I,j,K) = Kh(I,K) endif enddo ; enddo else ! This is a v-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(i,K) > Kh_v(i,J,K)) then - dKh = Kh(i,K) - Kh_v(i,J,K) + if (Kh(i,K) > KH_v(i,J,K)) then + dKh = Kh(i,K) - KH_v(i,J,K) int_slope_v(i,J,K) = dKh / Kh(i,K) - Kh_v(i,J,K) = Kh(i,K) + KH_v(i,J,K) = Kh(i,K) endif enddo ; enddo endif @@ -1761,7 +1764,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - real :: omega, strat_floor, flux_to_kg_per_s + real :: omega ! The Earth's rotation rate [T-1 ~> s-1] + real :: strat_floor if (associated(CS)) then call MOM_error(WARNING, & @@ -1778,17 +1782,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "coefficient of KHTH.", default=.false.) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX", CS%KHTH_Max, & "The maximum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX_CFL", CS%max_Khth_CFL, & "The maximum value of the local diffusive CFL ratio that "//& "is permitted for the thickness diffusivity. 1.0 is the "//& @@ -1810,14 +1814,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "DETANGLE_TIMESCALE", CS%detangle_time, & "A timescale over which maximally jagged grid-scale "//& "thickness variations are suppressed. This must be "//& - "longer than DT, or 0 to use DT.", units = "s", default=0.0) + "longer than DT, or 0 to use DT.", units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is "//& "not reliable and is scaled away.", units="nondim", default=0.01) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - default=1.0e-6, scale=US%m_to_Z**2) + default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of "//& "Ferrari et al., 2010, which effectively emphasizes "//& @@ -1836,9 +1840,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "streamfunction formulation, expressed as a fraction of planetary "//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mdl, "OMEGA",omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, do_not_log=.not.CS%use_FGNV_streamfn) + call get_param(param_file, mdl, "OMEGA", omega, & + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s, do_not_log=.not.CS%use_FGNV_streamfn) if (CS%use_FGNV_streamfn) CS%N2_floor = (strat_floor*omega)**2 call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -1854,7 +1858,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "MEKE_GEOMETRIC_EPSILON", CS%MEKE_GEOMETRIC_epsilon, & "Minimum Eady growth rate used in the calculation of \n"//& - "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7) + "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//& @@ -1874,16 +1878,15 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) endif - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif - CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & - 'Time Mean Diffusive Zonal Thickness Flux', 'kg s-1', & - y_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Zonal Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + y_cell_method='sum', v_extensive=.true.) if (CS%id_uhGM > 0) call safe_alloc_ptr(CDp%uhGM,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%id_vhGM = register_diag_field('ocean_model', 'vhGM', diag%axesCvL, Time, & - 'Time Mean Diffusive Meridional Thickness Flux', 'kg s-1', & - x_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Meridional Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + x_cell_method='sum', v_extensive=.true.) if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,G%ke) CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & @@ -1894,22 +1897,28 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v = register_diag_field('ocean_model', 'KHTH_v', diag%axesCvi, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t = register_diag_field('ocean_model', 'KHTH_t', diag%axesTL, Time, & - 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', 'm2 s-1',& + 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrblo', & cmor_long_name='Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & cmor_units='m2 s-1', & cmor_standard_name='ocean_tracer_diffusivity_due_to_parameterized_mesoscale_advection') CS%id_KH_u1 = register_diag_field('ocean_model', 'KHTH_u1', diag%axesCu1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v1 = register_diag_field('ocean_model', 'KHTH_v1', diag%axesCv1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t1 = register_diag_field('ocean_model', 'KHTH_t1', diag%axesT1, Time,& - 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim') @@ -1918,15 +1927,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'Meridional slope of neutral surface', 'nondim') if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & - 'Parameterized Zonal Overturning Streamfunction', 'm3 s-1') + 'Parameterized Zonal Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & - 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') + 'Parameterized Meridional Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) end subroutine thickness_diffuse_init From 4031ab9cab02d0b66de52e043d27870e9df98f37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 05:09:21 -0400 Subject: [PATCH 047/104] +Rescaled VarMix%L2u & VarMix%L2v to units of [L2] Rescaled the units of VarMix%L2u and VarMix%L2v to [L2] for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 ++++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 4 ++-- src/tracer/MOM_tracer_hor_diff.F90 | 4 ++-- 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 00112c3d15..d263db1a28 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -53,8 +53,8 @@ module MOM_lateral_mixing_coeffs real, dimension(:,:), pointer :: & SN_u => NULL(), & !< S*N at u-points [s-1] SN_v => NULL(), & !< S*N at v-points [s-1] - L2u => NULL(), & !< Length scale^2 at u-points [m2] - L2v => NULL(), & !< Length scale^2 at v-points [m2] + 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 [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]. @@ -1026,20 +1026,22 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCu(I,j) + CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) enddo; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCv(i,J) + CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) enddo; enddo else - CS%L2u(:,:) = CS%Visbeck_L_scale**2 - CS%L2v(:,:) = CS%Visbeck_L_scale**2 + CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 + CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & - 'Length scale squared for mixing coefficient, at u-points', 'm2') + 'Length scale squared for mixing coefficient, at u-points', & + 'm2', conversion=US%L_to_m**2) CS%id_L2v = register_diag_field('ocean_model', 'L2v', diag%axesCv1, Time, & - 'Length scale squared for mixing coefficient, at v-points', 'm2') + 'Length scale squared for mixing coefficient, at v-points', & + 'm2', conversion=US%L_to_m**2) endif if (CS%use_stored_slopes) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8fa5beb918..e160602be1 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -211,7 +211,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (use_Visbeck) then do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) + & - CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -291,7 +291,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) enddo ; enddo endif endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index a61af65ee9..58d64b6de4 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -210,7 +210,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) 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 (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) @@ -227,7 +227,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) 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 (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) From b4fa597aa5be153f0018efc184cc54e1a1895941 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 06:10:02 -0400 Subject: [PATCH 048/104] +Rescaled VarMix%SN_u and VarMix%SN_v to [T-1] Rescaled the units of VarMix%SN_u and VarMix%SN_v to [T-1] for more complete dimensional consistency testing. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 18 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 33 ++++++++++--------- .../lateral/MOM_thickness_diffuse.F90 | 10 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 4 +-- 4 files changed, 33 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 915290d90a..9f43034564 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -104,8 +104,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. @@ -189,7 +189,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%GM_src)) & call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) - call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) + call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif @@ -642,8 +642,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m 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. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. + 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 !! to the MEKE drag rate [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. @@ -678,7 +678,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m 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 = US%T_to_s * min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) + SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points @@ -801,8 +801,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & 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 - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 @@ -821,7 +821,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25 * US%T_to_s*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25 * ( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d263db1a28..89d7ecc92d 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -51,11 +51,11 @@ module MOM_lateral_mixing_coeffs logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. !! This parameter is set depending on other parameters. real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [s-1] - SN_v => NULL(), & !< S*N at v-points [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 [m s-1]. + 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 [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 @@ -418,7 +418,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) 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_v, 1) - call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -438,7 +438,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -446,6 +446,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables @@ -504,7 +505,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 N2 = max(0., N2_u(I,j,k)) - CS%SN_u(I,j) = CS%SN_u(I,j) + sqrt( S2*N2 )*H_geom + CS%SN_u(I,j) = CS%SN_u(I,j) + US%T_to_s*sqrt( S2*N2 )*H_geom S2_u(I,j) = S2_u(I,j) + S2*H_geom H_u(I) = H_u(I) + H_geom enddo ; enddo @@ -540,7 +541,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 N2 = max(0., N2_v(i,J,K)) - CS%SN_v(i,J) = CS%SN_v(i,J) + sqrt( S2*N2 )*H_geom + CS%SN_v(i,J) = CS%SN_v(i,J) + US%T_to_s*sqrt( S2*N2 )*H_geom S2_v(i,J) = S2_v(i,J) + S2*H_geom H_v(i) = H_v(i) + H_geom enddo ; enddo @@ -563,7 +564,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) if (CS%debug) then call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) - call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI) + call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI, scale=US%s_to_T) endif end subroutine calc_Visbeck_coeffs @@ -671,14 +672,14 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do j=js,je do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie - CS%SN_u(I,j) = CS%SN_u(I,j) + S2N2_u_local(I,j,k) + CS%SN_u(I,j) = CS%SN_u(I,j) + US%T_to_s*S2N2_u_local(I,j,k) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * US%s_to_T * sqrt( CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( US%s_to_T*CS%SN_u(I,j) / & (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 @@ -689,13 +690,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do J=js-1,je do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie - CS%SN_v(i,J) = CS%SN_v(i,J) + S2N2_v_local(i,J,k) + CS%SN_v(i,J) = CS%SN_v(i,J) + US%T_to_s*S2N2_v_local(i,J,k) enddo ; enddo do i=is,ie !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * US%s_to_T * sqrt( CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( US%s_to_T*CS%SN_v(i,J) / & (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 @@ -1008,9 +1009,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%SN_u(IsdB:IedB,jsd:jed)) ; CS%SN_u(:,:) = 0.0 allocate(CS%SN_v(isd:ied,JsdB:JedB)) ; CS%SN_v(:,:) = 0.0 CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & - 'Inverse eddy time-scale, S*N, at u-points', 's-1') + 'Inverse eddy time-scale, S*N, at u-points', 's-1', conversion=US%s_to_T) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & - 'Inverse eddy time-scale, S*N, at v-points', 's-1') + 'Inverse eddy time-scale, S*N, at v-points', 's-1', conversion=US%s_to_T) call get_param(param_file, mdl, "VARMIX_KTOP", CS%VarMix_Ktop, & "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index e160602be1..7c8ea4d79c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -211,7 +211,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (use_Visbeck) then do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) + & - CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -222,7 +222,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & - (US%T_to_s*VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) + (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie @@ -291,7 +291,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) enddo ; enddo endif endif @@ -301,7 +301,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do j=js-1,je ; do I=is,ie Khth_loc(I,j) = Khth_loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & - (US%T_to_s*VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) + (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie @@ -370,7 +370,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do j=js,je ; do I=is,ie !### This will not give bitwise rotational symmetry. Add parentheses. MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & - (0.25*US%T_to_s*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & + (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 58d64b6de4..7ca336bd91 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -210,7 +210,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*US%s_to_T*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) @@ -227,7 +227,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*US%s_to_T*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) From 8067dfa75ed1124bce29fe1f7dd3d7293093848f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 07:00:42 -0400 Subject: [PATCH 049/104] +Rescaled VarMix%cg1 to units of [L T-1] Rescaled the units of VarMix%cg1 to [L T-1] and the units of VarMix%Kh_u_QG and VarMix%Kh_v_QG to [L2 T-1] for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 72 ++++++++++--------- .../lateral/MOM_thickness_diffuse.F90 | 12 ++-- 2 files changed, 43 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 89d7ecc92d..c3feb9c4b4 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -55,7 +55,7 @@ module MOM_lateral_mixing_coeffs 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 [m s-1]. + 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 @@ -95,10 +95,10 @@ module MOM_lateral_mixing_coeffs Laplac3_const_v !< Laplacian metric-dependent constants [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - KH_u_QG !< QG Leith GM coefficient at u-points [m2 s-1] + KH_u_QG !< QG Leith GM coefficient at u-points [L2 T-1 ~> m2 s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - KH_v_QG !< QG Leith GM coefficient at v-points [m2 s-1] + KH_v_QG !< QG Leith GM coefficient at v-points [L2 T-1 ~> m2 s-1] ! Parameters logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity @@ -187,6 +187,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif + do j=js,je ; do i=is,ie + CS%cg1(i,j) = US%m_s_to_L_T*CS%cg1(i,j) + enddo ; enddo + call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) call do_group_pass(CS%pass_cg1, G%Domain) endif @@ -196,13 +200,11 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%calculate_rd_dx) then if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") -!$OMP parallel default(none) shared(is,ie,js,je,CS) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - CS%Rd_dx_h(i,j) = US%T_to_s*CS%cg1(i,j) / & - (sqrt(CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) + CS%Rd_dx_h(i,j) = US%L_to_m*CS%cg1(i,j) / & + (sqrt(CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) enddo ; enddo -!$OMP end parallel if (query_averaging_enabled(CS%diag)) then if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) endif @@ -243,8 +245,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_visc >= 100) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - if ((CS%Res_coef_visc * US%T_to_s*CS%cg1(i,j))**2 > dx_term) then + dx_term = CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j) + if ((CS%Res_coef_visc * US%L_to_m*CS%cg1(i,j))**2 > dx_term) then CS%Res_fn_h(i,j) = 0.0 else CS%Res_fn_h(i,j) = 1.0 @@ -252,7 +254,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = US%L_to_m * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) if ((CS%Res_coef_visc * cg1_q)**2 > dx_term) then @@ -264,12 +266,12 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_visc == 2) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * US%T_to_s*CS%cg1(i,j))**2) + dx_term = CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j) + CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * US%L_to_m*CS%cg1(i,j))**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = US%L_to_m * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) CS%Res_fn_q(I,J) = dx_term / (dx_term + (CS%Res_coef_visc * cg1_q)**2) @@ -278,13 +280,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_visc / 2 !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (US%s_to_T**2*CS%f2_dx2_h(i,j) + CS%cg1(i,j)*US%s_to_T*CS%beta_dx2_h(i,j))**power_2 + dx_term = (US%s_to_T**2*CS%f2_dx2_h(i,j) + US%s_to_T*US%L_T_to_m_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j))**power_2 CS%Res_fn_h(i,j) = dx_term / & - (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = (US%s_to_T**2*CS%f2_dx2_q(I,J) + cg1_q * US%s_to_T*CS%beta_dx2_q(I,J))**power_2 CS%Res_fn_q(I,J) = dx_term / & @@ -294,13 +296,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 dx_term = (US%s_to_T*sqrt(CS%f2_dx2_h(i,j) + & - US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc CS%Res_fn_h(i,j) = dx_term / & - (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = (US%s_to_T*sqrt(CS%f2_dx2_q(I,J) + & US%T_to_s*cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc @@ -320,7 +322,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_khth >= 100) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) if ((CS%Res_coef_khth * cg1_u)**2 > dx_term) then CS%Res_fn_u(I,j) = 0.0 @@ -330,7 +332,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) if ((CS%Res_coef_khth * cg1_v)**2 > dx_term) then CS%Res_fn_v(i,J) = 0.0 @@ -341,13 +343,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_khth == 2) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) CS%Res_fn_u(I,j) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_u)**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) CS%Res_fn_v(i,J) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_v)**2) enddo ; enddo @@ -355,14 +357,14 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_khth / 2 !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = (US%s_to_T**2*CS%f2_dx2_u(I,j) + cg1_u * US%s_to_T*CS%beta_dx2_u(I,j))**power_2 CS%Res_fn_u(I,j) = dx_term / & (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = (US%s_to_T**2*CS%f2_dx2_v(i,J) + cg1_v * US%s_to_T*CS%beta_dx2_v(i,J))**power_2 CS%Res_fn_v(i,J) = dx_term / & (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) @@ -370,7 +372,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) else !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = (US%s_to_T*sqrt(CS%f2_dx2_u(I,j) + & US%T_to_s*cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth CS%Res_fn_u(I,j) = dx_term / & @@ -378,7 +380,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = (US%s_to_T*sqrt(CS%f2_dx2_v(i,J) + & US%T_to_s*cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth CS%Res_fn_v(i,J) = dx_term / & @@ -834,10 +836,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_beta_in_QG_Leith) then beta_u(I,j) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) - CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & + CS%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & * CS%Laplac3_const_u(I,j) * inv_PI3 else - CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & + CS%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & * CS%Laplac3_const_u(I,j) * inv_PI3 endif enddo ; enddo @@ -850,10 +852,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_beta_in_QG_Leith) then beta_v(i,J) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) - CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & + CS%KH_v_QG(i,J,k) = US%m_to_L**2*US%T_to_s*MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & * CS%Laplac3_const_v(i,J) * inv_PI3 else - CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & + CS%KH_v_QG(i,J,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & * CS%Laplac3_const_v(i,J) * inv_PI3 endif enddo ; enddo @@ -1181,7 +1183,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_cg1) then in_use = .true. - allocate(CS%cg1(isd:ied,jsd:jed)); CS%cg1(:,:) = 0.0 + allocate(CS%cg1(isd:ied,jsd:jed)) ; CS%cg1(:,:) = 0.0 call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, mono_N2_depth=N2_filter_depth) endif @@ -1206,9 +1208,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! register diagnostics CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & - 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v_QG = register_diag_field('ocean_model', 'KH_v_QG', diag%axesCvL, Time, & - 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 7c8ea4d79c..0213ccb319 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -140,7 +140,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] + real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith @@ -270,7 +270,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do j=js,je ; do I=is-1,ie - KH_u(I,j,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_u_QG(I,j,k) + KH_u(I,j,k) = VarMix%KH_u_QG(I,j,k) enddo ; enddo ; enddo endif endif @@ -352,7 +352,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do J=js-1,je ; do i=is,ie - KH_v(i,J,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_v_QG(i,J,k) + KH_v(i,J,k) = VarMix%KH_v_QG(i,J,k) enddo ; enddo ; enddo endif endif @@ -528,7 +528,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] + real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion @@ -880,7 +880,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) c2_h_u(I,k) = CS%FGNV_scale * & - ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) + ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1130,7 +1130,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) c2_h_v(i,k) = CS%FGNV_scale * & - ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) + ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. From e026e6e830b7cd5fc4d493c61b5a02a97af308a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 16:16:28 -0400 Subject: [PATCH 050/104] Rescaled variables in MOM_lateral_mixing_coeffs.F90 Rescaled multiple internal variables in MOM_lateral_mixing_coeffs.F90 for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 232 +++++++++--------- 1 file changed, 115 insertions(+), 117 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index c3feb9c4b4..fa8d135b9b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -65,34 +65,35 @@ module MOM_lateral_mixing_coeffs Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic !! deformation radius to the grid spacing 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 [m T-1 ~> m s-1]. + !! 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 [m T-1 ~> m s-1]. + !! 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 [m T-1 ~> m s-1]. + !! 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 [m T-1 ~> m s-1]. + !! 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 [m2 T-2 ~> m2 s-2]. + !! 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 [m2 T-2 ~> m2 s-2]. + !! 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 [m2 T-2 ~> m2 s-2]. + !! 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 [m2 T-2 ~> m2 s-2]. + !! 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] + !### These are posted as diagnostics but are never set. N2_u => NULL(), & !< Brunt-Vaisala frequency at u-points [s-2] N2_v => NULL(), & !< Brunt-Vaisala frequency at v-points [s-2] ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Laplac3_const_u !< Laplacian metric-dependent constants [nondim] + Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Laplac3_const_v !< Laplacian metric-dependent constants [nondim] + Laplac3_const_v !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & KH_u_QG !< QG Leith GM coefficient at u-points [L2 T-1 ~> m2 s-1] @@ -202,8 +203,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) "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 - CS%Rd_dx_h(i,j) = US%L_to_m*CS%cg1(i,j) / & - (sqrt(CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) + CS%Rd_dx_h(i,j) = CS%cg1(i,j) / & + (sqrt(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))) enddo ; enddo if (query_averaging_enabled(CS%diag)) then if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) @@ -245,8 +246,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_visc >= 100) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - if ((CS%Res_coef_visc * US%L_to_m*CS%cg1(i,j))**2 > dx_term) then + dx_term = CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j) + if ((CS%Res_coef_visc * CS%cg1(i,j))**2 > dx_term) then CS%Res_fn_h(i,j) = 0.0 else CS%Res_fn_h(i,j) = 1.0 @@ -254,8 +255,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%L_to_m * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) if ((CS%Res_coef_visc * cg1_q)**2 > dx_term) then CS%Res_fn_q(I,J) = 0.0 @@ -266,13 +266,12 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_visc == 2) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * US%L_to_m*CS%cg1(i,j))**2) + dx_term = CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j) + CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%L_to_m * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) CS%Res_fn_q(I,J) = dx_term / (dx_term + (CS%Res_coef_visc * cg1_q)**2) enddo ; enddo @@ -280,34 +279,32 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_visc / 2 !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (US%s_to_T**2*CS%f2_dx2_h(i,j) + US%s_to_T*US%L_T_to_m_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j))**power_2 + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**power_2 CS%Res_fn_h(i,j) = dx_term / & (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (US%s_to_T**2*CS%f2_dx2_q(I,J) + cg1_q * US%s_to_T*CS%beta_dx2_q(I,J))**power_2 + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J)))**power_2 CS%Res_fn_q(I,J) = dx_term / & - (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo else !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_h(i,j) + & - US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_h(i,j) + & + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc CS%Res_fn_h(i,j) = dx_term / & (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_q(I,J) + & - US%T_to_s*cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_q(I,J) + & + cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc CS%Res_fn_q(I,J) = dx_term / & - (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo endif @@ -322,7 +319,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_khth >= 100) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) if ((CS%Res_coef_khth * cg1_u)**2 > dx_term) then CS%Res_fn_u(I,j) = 0.0 @@ -332,7 +329,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) if ((CS%Res_coef_khth * cg1_v)**2 > dx_term) then CS%Res_fn_v(i,J) = 0.0 @@ -343,13 +340,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_khth == 2) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) CS%Res_fn_u(I,j) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_u)**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) CS%Res_fn_v(i,J) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_v)**2) enddo ; enddo @@ -357,34 +354,34 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_khth / 2 !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (US%s_to_T**2*CS%f2_dx2_u(I,j) + cg1_u * US%s_to_T*CS%beta_dx2_u(I,j))**power_2 + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j)))**power_2 CS%Res_fn_u(I,j) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (US%s_to_T**2*CS%f2_dx2_v(i,J) + cg1_v * US%s_to_T*CS%beta_dx2_v(i,J))**power_2 + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J)))**power_2 CS%Res_fn_v(i,J) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo else !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_u(I,j) + & - US%T_to_s*cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_u(I,j) + & + cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth CS%Res_fn_u(I,j) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_v(i,J) + & - US%T_to_s*cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_v(i,J) + & + cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth CS%Res_fn_v(i,J) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo endif endif @@ -453,7 +450,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) ! Local variables real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency [s-1] + real :: N2 ! Positive Brunt-Vaisala frequency or zero [s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. integer :: is, ie, js, je, nz @@ -592,8 +589,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances. real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max @@ -613,7 +608,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) - Z_to_L = US%Z_to_m ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial @@ -625,12 +619,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*US%m_to_L*G%IdxCu(I,j) + E_x(I,j) = US%Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*US%m_to_L*G%IdyCv(i,J) + E_y(i,J) = US%Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo @@ -674,14 +668,14 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do j=js,je do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie - CS%SN_u(I,j) = CS%SN_u(I,j) + US%T_to_s*S2N2_u_local(I,j,k) + CS%SN_u(I,j) = CS%SN_u(I,j) + S2N2_u_local(I,j,k) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( US%s_to_T*CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 @@ -692,13 +686,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do J=js-1,je do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie - CS%SN_v(i,J) = CS%SN_v(i,J) + US%T_to_s*S2N2_v_local(i,J,k) + CS%SN_v(i,J) = CS%SN_v(i,J) + S2N2_v_local(i,J,k) enddo ; enddo do i=is,ie !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( US%s_to_T*CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 @@ -744,16 +738,16 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo ! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] - beta_v, & ! Beta at v-points [m-1 s-1] + beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_v, & ! mag. of vort. grad. at v-points [s-1] grad_div_mag_v ! mag. of div. grad. at v-points [s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & ! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - dslopex_dz, & ! z-derivative of x-slope at u-points [m-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] - beta_u, & ! Beta at u-points [m-1 s-1] + beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1 m-1] grad_div_mag_u ! mag. of div. grad. at u-points [s-1 m-1] ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] @@ -785,7 +779,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo h_at_slope_below = 2. * ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) * h(i+1,j,k+1) ) / & ( ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) & + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo @@ -798,7 +792,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo h_at_slope_below = 2. * ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) * h(i,j+1,k+1) ) / & ( ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) & + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo @@ -806,7 +800,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo !### do J=js-1,je ; do i=is-1,Ieq+1 do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) - vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_m * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) @@ -816,7 +810,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) !### I think that this should be vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & - vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_m * & + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_Z * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -829,34 +823,38 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_QG_Leith_GM) then do j=js,je ; do I=is-1,Ieq - grad_vort_mag_u(I,j) = US%m_to_L*US%s_to_T*SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & - + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) - grad_div_mag_u(I,j) = US%m_to_L*US%s_to_T*SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & - + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) + !### These expressions are not rotationally symmetric. Add parentheses and regroup, as in: + ! grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*((vort_xy_dx(i,J) + vort_xy_dx(i+1,J-1)) + + ! (vort_xy_dx(i+1,J) + vort_xy_dx(i,J-1))))**2 ) + grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) + grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then - beta_u(I,j) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) - CS%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & - * CS%Laplac3_const_u(I,j) * inv_PI3 + CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), 3.0*beta_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 else - CS%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & - * CS%Laplac3_const_u(I,j) * inv_PI3 + CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 endif enddo ; enddo do J=js-1,Jeq ; do i=is,ie - grad_vort_mag_v(i,J) = US%m_to_L*US%s_to_T*SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & - + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) - grad_div_mag_v(i,J) = US%m_to_L*US%s_to_T*SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & - + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + !### These expressions are not rotationally symmetric. Add parentheses and regroup. + grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) + grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) if (CS%use_beta_in_QG_Leith) then - beta_v(i,J) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) - CS%KH_v_QG(i,J,k) = US%m_to_L**2*US%T_to_s*MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & - * CS%Laplac3_const_v(i,J) * inv_PI3 + beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) + CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) * & + CS%Laplac3_const_v(i,J) * inv_PI3 else - CS%KH_v_QG(i,J,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & - * CS%Laplac3_const_v(i,J) * inv_PI3 + CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) * & + CS%Laplac3_const_v(i,J) * inv_PI3 endif enddo ; enddo ! post diagnostics @@ -886,8 +884,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use real :: MLE_front_length real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity - real :: grid_sp_u2, grid_sp_u3 - real :: grid_sp_v2, grid_sp_v3 ! Intermediate quantities for Leith metrics + real :: grid_sp_u2, grid_sp_v2 ! Intermediate quantities for Leith metrics [L2 ~> m2] + real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1125,35 +1123,35 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif do J=js-1,Jeq ; do I=is-1,Ieq - CS%f2_dx2_q(I,J) = US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * & + CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) - CS%beta_dx2_q(I,J) = oneOrTwo * US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & - ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & - (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2) ) )) + CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & + ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & + (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2) ) )) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * & + CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) - CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * (sqrt( & - 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2 + & - ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & - (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdxCv(i+1,J-1))**2 + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2) ) + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 )) + CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & + 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & + ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & + (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) ) + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 )) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * & + CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) - CS%beta_dx2_v(i,J) = oneOrTwo * ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & - 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdyCu(I-1,j+1))**2) + & - (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) + CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * (sqrt( & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & + 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & + (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif @@ -1169,15 +1167,15 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 - CS%f2_dx2_h(i,j) = ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*G%dyT(i,j))**2) * & + CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) - CS%beta_dx2_h(i,j) = oneOrTwo * ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*G%dyT(i,j))**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & - ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2) + & - (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) + CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * (sqrt(0.5 * & + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & + ((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) ) )) enddo ; enddo endif @@ -1214,14 +1212,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes - grid_sp_u2 = US%L_to_m*G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) - grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) + grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) + grid_sp_u3 = sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes !### The second factor here is wrong. It should be G%dxCv(i,J). - grid_sp_v2 = US%L_to_m*G%dyCv(i,J)*US%L_to_m*G%dxCu(i,J) + grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 enddo ; enddo From a4ffe033ba6be65ba03c5d1eff45cfecab96e1d8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 19:10:12 -0400 Subject: [PATCH 051/104] +Rescaled isoneutral & along layer tracer diffusion Rescaled variables used in isoneutral & along layer tracer diffusion for more complete dimensional consistency testing, including changing the units of the Coef_x and Coef_y arguments to neutral_diffusion to [L2]. This change also requires the addition of unit_scale_type argument to tracer_hor_diff_init. All answers are bitwise identical. --- src/core/MOM.F90 | 2 +- src/tracer/MOM_neutral_diffusion.F90 | 8 +- src/tracer/MOM_tracer_hor_diff.F90 | 141 ++++++++++++++------------- 3 files changed, 79 insertions(+), 72 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bde797c654..9f87cc45ed 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2352,7 +2352,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) - call tracer_hor_diff_init(Time, G, param_file, diag, CS%tv%eqn_of_state, & + call tracer_hor_diff_init(Time, G, US, param_file, diag, CS%tv%eqn_of_state, & CS%tracer_diff_CSp) call lock_tracer_registry(CS%tracer_Reg) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index f1f6191c74..a13eace934 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -412,8 +412,8 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) 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_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [m2] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry @@ -497,12 +497,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) enddo do k = 1, GV%ke tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & - ( US%m_to_L**2*G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) enddo if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then do k = 1, GV%ke - tendency(i,j,k) = dTracer(k) * US%m_to_L**2*G%IareaT(i,j) * Idt + tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 7ca336bd91..098a647ec8 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -103,8 +103,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(tracer_hor_diff_CS), pointer :: CS !< module control structure 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 type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields, including potential temp and @@ -125,25 +125,25 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a - ! grid cell [H-1 m-2 ~> m-3 or kg-1]. - Kh_h, & ! The tracer diffusivity averaged to tracer points [m2 s-1]. + ! grid cell [H-1 L-2 ~> m-3 or kg-1]. + Kh_h, & ! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of concentration [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2 ~> m2]. Coef_x, & ! The coefficients relating zonal tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_u ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_u ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2]. Coef_y, & ! The coefficients relating meridional tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_v ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. - real :: khdt_max ! The local limiting value of khdt_x or khdt_y [m2]. + real :: khdt_max ! The local limiting value of khdt_x or khdt_y [L2 ~> m2]. real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: S_idx, T_idx ! Indices for temperature and salinity if needed @@ -154,7 +154,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real :: Idt ! The inverse of the time step [s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: Kh_loc ! The local value of Kh [m2 s-1]. + real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. @@ -175,6 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online call cpu_clock_begin(id_clock_diffuse) ntr = Reg%ntr + dt_in_T = US%s_to_T*dt Idt = 1.0/dt h_neglect = GV%H_subroundoff @@ -210,16 +212,16 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*US%s_to_T*VarMix%SN_u(I,j) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + 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) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points - Kh_loc=Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Kh_loc = Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -227,16 +229,16 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*US%s_to_T*VarMix%SN_v(i,J) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + 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) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity - Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points - Kh_loc=Kh_v(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Rd_dx = 0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points + Kh_loc = Kh_v(i,J)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -244,48 +246,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -294,34 +296,34 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if ((CS%id_KhTr_u > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Kh_u(I,j) = khdt_x(I,j) / (dt_in_T*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) khdt_x(I,j) = min(khdt_x(I,j), khdt_max) enddo ; enddo endif if ((CS%id_KhTr_v > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Kh_v(i,J) = khdt_y(i,J) / (dt_in_T*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) khdt_y(i,J) = min(khdt_y(i,J), khdt_max) enddo ; enddo endif @@ -330,13 +332,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else ! .not. do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = read_khdt_x(I,j) + khdt_x(I,j) = US%m_to_L**2*read_khdt_x(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = read_khdt_y(i,J) + khdt_y(i,J) = US%m_to_L**2*read_khdt_y(i,J) enddo ; enddo - call pass_vector(khdt_x,khdt_y,G%Domain) + call pass_vector(khdt_x, khdt_y, G%Domain) endif ! do_online if (CS%check_diffusive_CFL) then @@ -344,7 +346,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online max_CFL = 0.0 do j=js,je ; do i=is,ie CFL(i,j) = 2.0*((khdt_x(I-1,j) + khdt_x(I,j)) + & - (khdt_y(i,J-1) + khdt_y(i,J))) * US%m_to_L**2*G%IareaT(i,j) + (khdt_y(i,J-1) + khdt_y(i,J))) * G%IareaT(i,j) if (max_CFL < CFL(i,j)) max_CFL = CFL(i,j) enddo ; enddo call cpu_clock_begin(id_clock_sync) @@ -434,7 +436,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online enddo do i=is,ie - Ihdxdy(i,j) = US%m_to_L**2*G%IareaT(i,j) / (h(i,j,k)+h_neglect) + Ihdxdy(i,j) = G%IareaT(i,j) / (h(i,j,k)+h_neglect) enddo enddo @@ -447,19 +449,19 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online Coef_y(i,J) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) enddo ; enddo if (associated(Reg%Tr(m)%df_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j) * & + Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + Coef_y(i,J) * & + Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + Coef_x(I,j) * & + Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + Coef_y(i,J) * & + Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif do j=js,je ; do i=is,ie @@ -520,10 +522,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%debug) then call uvchksum("After tracer diffusion khdt_[xy]", khdt_x, khdt_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) if (CS%use_neutral_diffusion) then call uvchksum("After tracer diffusion Coef_[xy]", Coef_x, Coef_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) endif endif @@ -546,8 +548,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, intent(in) :: dt !< time step type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< needs a comment - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< needs a comment + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< Zonal epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< Meridional epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] type(tracer_hor_diff_CS), intent(inout) :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic structure integer, intent(in) :: num_itts !< number of iterations (usually=1) @@ -576,7 +582,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - tr_flux_conv ! The flux convergence of tracers [conc H m2 ~> conc m3 or conc kg] + tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & @@ -620,12 +626,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] real :: Tr_av_L ! The average tracer concentrations on the left and right real :: Tr_av_R ! sides of a pairing [Conc]. - real :: Tr_flux ! The tracer flux from left to right in a pair [conc H m2 ~> conc m3 or conc kg]. + real :: Tr_flux ! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg]. real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing [conc H m2 ~> conc m3 or conc kg]. + ! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. - real :: vol ! A cell volume or mass [H m2 ~> m3 or kg]. + real :: vol ! A cell volume or mass [H L2 ~> m3 or kg]. logical, dimension(SZK_(G)) :: & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. @@ -1129,7 +1135,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Lu(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Lu(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i,j) + vol = hP_Lu(j)%p(I,k) * G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1164,7 +1170,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Ru(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Ru(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i+1,j) + vol = hP_Ru(j)%p(I,k) * G%areaT(i+1,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1266,7 +1272,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Lv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Lv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Lv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j) + vol = hP_Lv(J)%p(i,k) * G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1293,7 +1299,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Rv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Rv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j+1) + vol = hP_Rv(J)%p(i,k) * G%areaT(i,j+1) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1336,7 +1342,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,j,k) - Tr_adj_vert_L(i,j,k)) endif if (deep_wt_Rv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + tr_flux_3d(i,j,k) + tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,j,k) else kRa = k0a_Rv(J)%p(i,k) wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b @@ -1351,7 +1357,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & do k=1,PEmax_kRho ; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 0.0)) then Tr(m)%t(i,j,k) = Tr(m)%t(i,j,k) + tr_flux_conv(i,j,k) / & - (h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + (h(i,j,k)*G%areaT(i,j)) tr_flux_conv(i,j,k) = 0.0 endif enddo ; enddo ; enddo @@ -1377,9 +1383,10 @@ end subroutine tracer_epipycnal_ML_diff !> Initialize lateral tracer diffusion module -subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) +subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS type(param_file_type), intent(in) :: param_file !< parameter file @@ -1403,7 +1410,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "KHTR", CS%KhTr, & "The background along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & "The scaling coefficient for along-isopycnal tracer "//& "diffusivity using a shear-based (Visbeck-like) "//& @@ -1411,10 +1418,10 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_MIN", CS%KhTr_Min, & "The minimum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_MAX", CS%KhTr_Max, & "The maximum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & "The coefficient that scales deformation radius over "//& "grid-spacing in passivity, where passivity is the ratio "//& @@ -1465,19 +1472,19 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) CS%id_CFL = -1 CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1') + 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1') - CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time,& - 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', & + 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & + 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrelo', & cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) if (CS%check_diffusive_CFL) then CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& 'Grid CFL number for lateral/neutral tracer diffusion', 'nondim') From 90bbde24cf3a6fb5844a482a3cd40ac59a9c9fe2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 05:56:36 -0400 Subject: [PATCH 052/104] Correct rescaling diffu and diffv across restarts Corrected for changes in the rescaling of diffu and diffv across restarts. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 193062ac42..7a81fab535 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1011,6 +1011,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! 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_convert type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1146,10 +1148,23 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & - .not. query_initialized(CS%diffv,"diffv",restart_CS)) & + .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, & OBC=CS%OBC, BT=CS%barotropic_CSp) + else + if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then + accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) + enddo ; enddo ; enddo + endif + endif + if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then CS%u_av(:,:,:) = u(:,:,:) From cdbd580eb18fb12edfc2171cefa48e3269f477ae Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 06:00:21 -0400 Subject: [PATCH 053/104] +Return N2_u from calc_isoneutral_slopes in [T-2] Rescaled the units of N2_u and N2_v returned from calc_isoneutral_slopes to [T-2]. Also simplified some rescaling factors in calc_isoneutral_slopes and MOM_lateral_mixing_coeffs. Also noted that the diagnostics CS%N2_u and CS%N2_v do not appear to be set. All answers are bitwise identical. --- src/core/MOM_isopycnal_slopes.F90 | 25 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 50 ++++++++++--------- 2 files changed, 39 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 18c47b3e90..30a2a451a8 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -39,10 +39,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [[T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units @@ -79,19 +79,18 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. 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 ! in roundoff and can be neglected [Z ~> m]. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. @@ -111,9 +110,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = US%Z_to_m ; H_to_Z = GV%H_to_Z + Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z ! if (present(eta_to_m)) then - ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m + ! Z_to_L = eta_to_m*US%m_to_L ; H_to_Z = GV%H_to_m / eta_to_m ! endif L_to_Z = 1.0 / Z_to_L dz_neglect = GV%H_subroundoff * H_to_Z @@ -122,7 +121,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (US%L_to_Z*US%L_to_m*L_to_z*US%s_to_T**2*GV%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z*L_to_Z*GV%g_Earth) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -223,7 +222,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -237,7 +236,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) endif enddo ! I @@ -307,7 +306,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -321,7 +320,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) endif enddo ! i diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fa8d135b9b..1582b23615 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -111,7 +111,7 @@ module MOM_lateral_mixing_coeffs real :: Res_coef_visc !< A non-dimensional number that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] integer :: Res_fn_power_khth !< The power of dx/Ld in the KhTh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. @@ -156,10 +156,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some ! of the following variables have units that depend on that power. - real :: cg1_q ! The gravity wave speed interpolated to q points [m T-1 ~> m s-1] or [m s-1]. - real :: cg1_u ! The gravity wave speed interpolated to u points [m T-1 ~> m s-1] or [m s-1]. - real :: cg1_v ! The gravity wave speed interpolated to v points [m T-1 ~> m s-1] or [m s-1]. - real :: dx_term ! A term in the denominator [m2 T-2 ~> m2 s-2] or [m2 s-2] + real :: cg1_q ! The gravity wave speed interpolated to q points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_u ! The gravity wave speed interpolated to u points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_v ! The gravity wave speed interpolated to v points [L T-1 ~> m s-1] or [m s-1]. + real :: dx_term ! A term in the denominator [L2 T-2 ~> m2 s-2] or [m2 s-2] integer :: power_2 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k @@ -406,7 +406,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [s-2] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& @@ -415,7 +415,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%calculate_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, US%s_to_T*dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) @@ -430,6 +430,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) + !### I do not believe that CS%N2_u and CS%N2_v are ever set, but because the contents + ! of CS are public, they might be set somewhere outside of this module. if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, CS%N2_u, CS%diag) if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, CS%N2_v, CS%diag) endif @@ -442,15 +444,17 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency + !! at u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency + !! at v-points [T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Positive Brunt-Vaisala frequency or zero [s-2] + real :: N2 ! Positive buoyancy frequency or zero [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. integer :: is, ie, js, je, nz @@ -504,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 N2 = max(0., N2_u(I,j,k)) - CS%SN_u(I,j) = CS%SN_u(I,j) + US%T_to_s*sqrt( S2*N2 )*H_geom + CS%SN_u(I,j) = CS%SN_u(I,j) + sqrt( S2*N2 )*H_geom S2_u(I,j) = S2_u(I,j) + S2*H_geom H_u(I) = H_u(I) + H_geom enddo ; enddo @@ -540,7 +544,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 N2 = max(0., N2_v(i,J,K)) - CS%SN_v(i,J) = CS%SN_v(i,J) + US%T_to_s*sqrt( S2*N2 )*H_geom + CS%SN_v(i,J) = CS%SN_v(i,J) + sqrt( S2*N2 )*H_geom S2_v(i,J) = S2_v(i,J) + S2*H_geom H_v(i) = H_v(i) + H_geom enddo ; enddo @@ -562,7 +566,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) if (CS%debug) then call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) - call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) + call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI, scale=US%s_to_T**2) call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI, scale=US%s_to_T) endif @@ -707,14 +711,14 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo type(VarMix_CS), pointer :: 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [m s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence !! (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity !! (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] @@ -736,11 +740,11 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo real, dimension(SZI_(G),SZJB_(G)) :: & ! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-1] - grad_vort_mag_v, & ! mag. of vort. grad. at v-points [s-1] - grad_div_mag_v ! mag. of div. grad. at v-points [s-1] + grad_vort_mag_v, & ! Magnitude of vorticity gradient at v-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_v ! Magnitude of divergence gradient at v-points [T-1 L-1 ~> s-1 m-1] real, dimension(SZIB_(G),SZJ_(G)) :: & ! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] @@ -748,8 +752,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] - grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1 m-1] - grad_div_mag_u ! mag. of div. grad. at u-points [s-1 m-1] + grad_vort_mag_u, & ! Magnitude of vorticity gradient at u-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_u ! Magnitude of divergence gradient at u-points [T-1 L-1 ~> s-1 m-1] ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag real :: h_at_slope_above, h_at_slope_below, Ih @@ -850,7 +854,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_beta_in_QG_Leith) then beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) - CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) * & + CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), 3.0*beta_v(i,J)) * & CS%Laplac3_const_v(i,J) * inv_PI3 else CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) * & @@ -1001,7 +1005,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2) + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) endif if (CS%calculate_Eady_growth_rate) then From d1267c97f58df70ac33dae2aa85637616343f485 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 08:06:21 -0400 Subject: [PATCH 054/104] Rescaled variables in MOM_CoriolisAdv.F90 Applied dimensional rescaling to numerous internal variables in MOM_CoriolisAdv.F90 for expanded dimensional consistency testing and to prepare for velocities to passed in with units of [L T-1]. All answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 136 +++++++++++++++++++---------------- 1 file changed, 74 insertions(+), 62 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 9d27542e75..ed16010f39 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -108,11 +108,11 @@ 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) +subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_in !< Zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_in !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -127,11 +127,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + !### Temporary variables that will be removed later. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. + ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. - Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. + Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [L2 ~> m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities @@ -140,18 +144,18 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & - Area_h, & ! The ocean area at h points [m2]. Area_h is used to find the + Area_h, & ! The ocean area at h points [L2 ~> m2]. Area_h is used to find the ! average thickness in the denominator of q. 0 for land points. - KE ! Kinetic energy per unit mass [m2 s-2], KE = (u^2 + v^2)/2. + KE ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2], KE = (u^2 + v^2)/2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points - ! times the effective areas [H m2 ~> m3 or kg]. + ! times the effective areas [H L2 ~> m3 or kg]. KEx, & ! The zonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEx = d/dx KE. uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points - ! times the effective areas [H m2 ~> m3 or kg]. + ! 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 = 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] @@ -162,7 +166,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) 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]. real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx,dudy, &! Contributions to the circulation around q-points [m2 s-1] + dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1] abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. q2, & ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. max_fvq, & ! The maximum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. @@ -183,11 +187,11 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells - ! surrounding a q point [H m2 ~> m3 or kg]. + ! surrounding a q point [H L2 ~> m3 or kg]. 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 :: temp1, temp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. - real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. + real :: eps_vel ! A tiny, positive velocity [L T-1 ~> m s-1]. 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]. @@ -220,11 +224,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, 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 ; nz = G%ke h_neglect = GV%H_subroundoff + eps_vel = 1.0e-10*US%m_s_to_L_T h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 - Area_h(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) + Area_h(i,j) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo if (associated(OBC)) then ; do n=1,OBC%number_of_segments if (.not. OBC%segment(n)%on_pe) cycle @@ -256,14 +261,24 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,CS,AD,Area_h,Area_q,& !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC) do k=1,nz + + !## This is temporary code until the input velocities have been dimensionally rescaled. + do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 + u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo + do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 + v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo + + ! Here the second order accurate layer potential vorticities, q, ! are calculated. hq is second order accurate in space. Relative ! vorticity is second order accurate everywhere with free slip b.c.s, ! but only first order accurate at boundaries with no slip b.c.s. ! First calculate the contributions to the circulation around the q-point. do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = v(i+1,J,k)*US%L_to_m*G%dyCv(i+1,J) - v(i,J,k)*US%L_to_m*G%dyCv(i,J) - dudy(I,J) = u(I,j+1,k)*US%L_to_m*G%dxCu(I,j+1) - u(I,j,k)*US%L_to_m*G%dxCu(I,j) + dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J)) + dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k)) @@ -273,10 +288,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo 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) * US%m_s_to_L_T*u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * 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) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -294,16 +309,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*US%L_to_m*G%dxCu(I,j) + dudy(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dxCu(I,j+1) + dudy(I,J) = 2.0*(u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) endif enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -319,9 +334,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) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) + vh_center(i,J) = G%dx_Cv(i,J) * 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) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -334,16 +349,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*US%L_to_m*G%dyCv(i,J) + dvdx(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dyCv(i+1,J) + dvdx(I,J) = 2.0*(v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) endif enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif @@ -358,9 +373,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) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * 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) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i+1,j,k) endif enddo endif @@ -406,11 +421,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then - relative_vorticity = (2.0-G%mask2dBu(I,J)) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - US%m_to_L**2*G%IareaBu(I,J) + relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) else - relative_vorticity = G%mask2dBu(I,J) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - US%m_to_L**2*G%IareaBu(I,J) + relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) endif absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 @@ -423,10 +436,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Ih_q(I,J) = Ih if (CS%bound_Coriolis) then - fv1 = absolute_vorticity * US%m_s_to_L_T*v(i+1,J,k) - fv2 = absolute_vorticity * US%m_s_to_L_T*v(i,J,k) - fu1 = -absolute_vorticity * US%m_s_to_L_T*u(I,j+1,k) - fu2 = -absolute_vorticity * US%m_s_to_L_T*u(I,j,k) + fv1 = absolute_vorticity * v(i+1,J,k) + fv2 = absolute_vorticity * v(i,J,k) + fu1 = -absolute_vorticity * u(I,j+1,k) + fu2 = -absolute_vorticity * u(I,j,k) if (fv1 > fv2) then max_fvq(I,J) = fv1 ; min_fvq(I,J) = fv2 else @@ -618,16 +631,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) + Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (eps_vel+abs(v(i,J,k))) Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) + Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (eps_vel+abs(v(i,J-1,k))) Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) + Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (eps_vel+abs(v(i+1,J,k))) Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) + Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (eps_vel+abs(v(i+1,J-1,k))) Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then @@ -724,16 +737,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) + Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (eps_vel+abs(u(I,j,k))) Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) + Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (eps_vel+abs(u(I-1,j,k))) Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) + Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (eps_vel+abs(u(I,j+1,k))) Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) + Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (eps_vel+abs(u(I-1,j+1,k))) Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then @@ -835,10 +848,10 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [m2 s-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic @@ -848,9 +861,9 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables - real :: um, up, vm, vp ! Temporary variables [m s-1]. - real :: um2, up2, vm2, vp2 ! Temporary variables [m2 s-2]. - real :: um2a, up2a, vm2a, vp2a ! Temporary variables [m4 s-2]. + 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]. + real :: um2a, up2a, vm2a, vp2a ! Temporary variables [L4 T-2 ~> m4 s-2]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -863,11 +876,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( US%L_to_m**2*G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & - +US%L_to_m**2*G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & - +( US%L_to_m**2*G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & - +US%L_to_m**2*G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & - )*0.25*US%m_to_L**2*G%IareaT(i,j) + KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) + & + G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) + & + ( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) + & + 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 @@ -883,22 +895,22 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! The following discretization of KE is based on the one-dimensinal 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*US%L_to_m**2*G%areaCu(I-1,j) - um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*US%L_to_m**2*G%areaCu( I ,j) - vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*US%L_to_m**2*G%areaCv(i,J-1) - vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*US%L_to_m**2*G%areaCv(i, J ) - KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*US%m_to_L**2*G%IareaT(i,j) + up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*G%areaCu(I-1,j) + um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) + vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) + vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) + KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*G%IareaT(i,j) enddo ; enddo endif ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) + KEx(I,j) = (KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) + KEy(i,J) = (KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) enddo ; enddo if (associated(OBC)) then From d8208887ab5201ad0e1e8a657feff4727979dc00 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 10:19:14 -0400 Subject: [PATCH 055/104] +Rescaled OBC%segment%normal_vel to units of [L T-1] Rescaled the units of the normal_vel, tangential_vel and related elements of the OBC_segment type to [T-1 L-1] for more complete dimensional consistency testing. All answers are bitwise identical, but the units of 5 variables in a transparent type have been rescaled. --- src/core/MOM_CoriolisAdv.F90 | 8 +-- src/core/MOM_barotropic.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 11 +-- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_open_boundary.F90 | 71 ++++++++++--------- .../lateral/MOM_hor_visc.F90 | 8 +-- .../vertical/MOM_vert_friction.F90 | 4 +- src/user/DOME_initialization.F90 | 2 +- src/user/Kelvin_initialization.F90 | 22 +++--- src/user/dyed_channel_initialization.F90 | 4 +- src/user/shelfwave_initialization.F90 | 4 +- src/user/supercritical_initialization.F90 | 4 +- src/user/tidal_bay_initialization.F90 | 2 +- 13 files changed, 75 insertions(+), 73 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index ed16010f39..e734b1a00d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -309,9 +309,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) + dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = 2.0*(u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) + dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) endif enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB @@ -349,9 +349,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) + dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = 2.0*(v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) + dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) endif enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6438efc816..0e2e022e48 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2657,7 +2657,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B segment => OBC%segment(n) if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB - BT_OBC%ubt_outer(I,j) = US%m_s_to_L_T*segment%normal_vel_bt(I,j) + BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j) BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) enddo ; enddo endif @@ -2709,7 +2709,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B segment => OBC%segment(n) if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied - BT_OBC%vbt_outer(i,J) = US%m_s_to_L_T*segment%normal_vel_bt(i,J) + BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J) BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) enddo ; enddo endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 979edadcb0..63e7366a55 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -426,7 +426,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo if (local_specified_BC) then ; do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor(I,j,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + u_cor(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) enddo ; endif enddo ; endif ! u-corrected @@ -444,8 +444,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_u(I,j))%specified)) & - FAuI(I) = FAuI(I) + US%m_to_L*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & - OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + FAuI(I) = FAuI(I) + US%m_to_L**2*US%T_to_s * & + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & + OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo do I=ish-1,ieh ; if (do_I(I)) then BT_cont%FA_u_W0(I,j) = FAuI(I) ; BT_cont%FA_u_E0(I,j) = FAuI(I) @@ -1222,7 +1223,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo if (local_specified_BC) then ; do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor(i,J,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + v_cor(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) enddo ; endif enddo ; endif ! v-corrected endif @@ -1239,7 +1240,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + US%m_to_L * & + FAvi(i) = FAvi(i) + US%m_to_L**2*US%T_to_s * & OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 7a81fab535..4440e2fe72 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -619,7 +619,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) @@ -826,7 +826,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, dt) + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5689d48231..4e64342c2d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -145,15 +145,15 @@ module MOM_open_boundary real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [m s-1]. + !! segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [m s-1]. + !! OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential !! to the OB segment [m s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB !! segment [m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [m s-1]. + !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the !! segment [s-1] @@ -168,9 +168,9 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [m s-1]. + !! 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 [m s-1]. + !! 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 [s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. @@ -1520,7 +1520,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) end subroutine open_boundary_impose_land_mask !> Apply radiation conditions to 3D u,v at open boundaries -subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) +subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries @@ -1531,6 +1531,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) !! On entry, the old time-level v but !! including barotropic accelerations. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: dt !< Appropriate timestep ! Local variables real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 @@ -1616,7 +1617,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I-1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1640,7 +1641,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -1649,7 +1650,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = u_new(I-1,j,k) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -1676,7 +1677,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1748,7 +1749,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -1812,7 +1813,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I+1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1836,7 +1837,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -1845,7 +1846,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = u_new(I+1,j,k) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0. on inflow in oblique case @@ -1872,7 +1873,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1944,7 +1945,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2008,7 +2009,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J-1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) @@ -2033,7 +2034,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -2042,7 +2043,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = v_new(i,J-1,k) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2069,7 +2070,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2141,7 +2142,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2205,7 +2206,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J+1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) @@ -2229,7 +2230,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -2238,7 +2239,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = v_new(i,J+1,k) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2265,7 +2266,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2337,7 +2338,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2416,12 +2417,12 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) if (segment%is_E_or_W) then I=segment%HI%IsdB do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed - u(I,j,k) = segment%normal_vel(I,j,k) + u(I,j,k) = G%US%L_T_to_m_s*segment%normal_vel(I,j,k) enddo ; enddo elseif (segment%is_N_or_S) then J=segment%HI%JsdB do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied - v(i,J,k) = segment%normal_vel(i,J,k) + v(i,J,k) = G%US%L_T_to_m_s*segment%normal_vel(i,J,k) enddo ; enddo endif endif @@ -2921,7 +2922,7 @@ end subroutine open_boundary_test_extern_h subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness [m] @@ -3283,12 +3284,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do j=js_obc+1,je_obc normal_trans_bt(I,j) = 0.0 do k=1,G%ke - segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k) segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & US%L_to_m*G%dyCu(I,j) normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) enddo - segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & + segment%normal_vel_bt(I,j) = US%m_s_to_L_T*normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & US%L_to_m*G%dyCu(I,j)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo @@ -3297,12 +3298,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do i=is_obc+1,ie_obc normal_trans_bt(i,J) = 0.0 do k=1,G%ke - segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k) segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & US%L_to_m*G%dxCv(i,J) normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) enddo - segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & + segment%normal_vel_bt(i,J) = US%m_s_to_L_T*normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & US%L_to_m*G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo @@ -3311,7 +3312,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -3321,7 +3322,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 66aa64987a..4da86902b3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -589,10 +589,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & - (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & - (u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then @@ -611,10 +611,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & - (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & - (v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 930fcbdc6b..b0b2a88688 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -427,12 +427,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (OBC%segment(n)%is_N_or_S) then J = OBC%segment(n)%HI%JsdB do k=1,nz ; do i=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v(i,J,k) = OBC%segment(n)%normal_vel(i,J,k) + v(i,J,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(i,J,k) enddo ; enddo elseif (OBC%segment(n)%is_E_or_W) then I = OBC%segment(n)%HI%IsdB do k=1,nz ; do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u(I,j,k) = OBC%segment(n)%normal_vel(I,j,k) + u(I,j,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(I,j,k) enddo ; enddo endif endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 73d2f7905b..bf643536fc 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -317,7 +317,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) y2 = (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) - v_k = -US%L_T_to_m_s*sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & + 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))) * & log((2.0+Ri_trans)/(2.0-Ri_trans)) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 0b1eba8d0f..9956756559 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -256,7 +256,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val2 * (val1 * cff * cosa / & + segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) else ! Not rotated yet @@ -264,16 +264,16 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel_bt(I,j) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) - segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & + segment%normal_trans(I,j,k) = US%L_T_to_m_s*segment%normal_vel(I,j,k) * & h(i+1,j,k) * G%US%L_to_m*G%dyCu(I,j) enddo endif @@ -288,14 +288,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) if (CS%answers_2018) then ! Problem: val2 & cff could be functions of space, but are not set in this loop. if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val2 * (val1 * cff * sina / & + segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) )) enddo ; endif else cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val1 * val2 * cff * sina) / & + segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) enddo ; endif @@ -322,14 +322,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel_bt(i,J) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & + segment%normal_trans(i,J,k) = US%L_T_to_m_s*segment%normal_vel(i,J,k) * & h(i,j+1,k) * G%US%L_to_m*G%dxCv(i,J) enddo endif @@ -344,14 +344,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) if (CS%answers_2018) then ! Problem: val2 & cff could be functions of space, but are not set in this loop. if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val2 * (val1 * cff * sina / & + segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))))) enddo ; endif else cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * ((val1 * val2 * cff * sina) / & + segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) enddo ; endif endif diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 72dfc309e5..5e784ad57e 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -169,7 +169,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = flow + segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*flow endif if (segment%specified) then segment%normal_trans(I,j,k) = flow * G%US%L_to_m*G%dyCu(I,j) @@ -177,7 +177,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = flow + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index cd80514bea..928c8ae223 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -170,9 +170,9 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) cos_wt = cos(ll*x - omega*time_sec) sin_ky = sin(kk * y) cos_ky = cos(kk * y) - segment%normal_vel_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * & + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * exp(- alpha * y) * cos_wt * & (alpha * sin_ky + kk * cos_ky) -! segment%tangential_vel_bt(I,j) = my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky +! segment%tangential_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky ! segment%vorticity_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * sin_ky& ! (ll*ll + kk*kk + alpha*alpha) enddo ; enddo diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 0f204b6c6e..6d69fbb2b6 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -55,7 +55,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = zonal_flow + segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*zonal_flow endif if (segment%specified) then segment%normal_trans(I,j,k) = zonal_flow * G%US%L_to_m*G%dyCu(I,j) @@ -63,7 +63,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = zonal_flow + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*zonal_flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index d84da56f4b..67999fff40 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -110,7 +110,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux/total_area + segment%normal_vel_bt(:,:) = G%US%m_s_to_L_T*my_flux/total_area segment%eta(:,:) = cff enddo ! end segment loop From 6f5f24f2a2e429aaca00c77ed51f84aa2dff4f59 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 11:57:29 -0400 Subject: [PATCH 056/104] Rescaled OBC%segment%normal_trans to units of [H L2 T-1] Rescaled the units of the normal_trans element of the OBC_segment type to [T-1 L-1] for more complete dimensional consistency testing. Also simplified some expressions in dyed_channel_update_flow, supercritical_set_OBC_data and DOME_set_OBC_data. All answers are bitwise identical, but the units of an element in a transparent type has been rescaled. --- src/core/MOM_barotropic.F90 | 4 ++-- src/core/MOM_continuity_PPM.F90 | 18 ++++++++--------- src/core/MOM_open_boundary.F90 | 24 +++++++++++------------ src/user/DOME_initialization.F90 | 4 ++-- src/user/Kelvin_initialization.F90 | 6 ++---- src/user/dyed_channel_initialization.F90 | 10 +++++----- src/user/supercritical_initialization.F90 | 10 +++++----- 7 files changed, 35 insertions(+), 41 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 0e2e022e48..b83e0c34da 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2622,7 +2622,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%uhbt(I,j) = 0. enddo ; enddo do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB - BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + US%T_to_s*US%m_to_L**2*segment%normal_trans(I,j,k) + BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k) enddo ; enddo ; enddo endif enddo @@ -2674,7 +2674,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%vhbt(i,J) = 0. enddo ; enddo do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied - BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + US%T_to_s*US%m_to_L**2*segment%normal_trans(i,J,k) + BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k) enddo ; enddo ; enddo endif enddo diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 63e7366a55..3a6021e6b5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -319,7 +319,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) + uh(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) enddo endif enddo @@ -391,8 +391,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i+1,j)) + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) @@ -444,9 +444,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_u(I,j))%specified)) & - FAuI(I) = FAuI(I) + US%m_to_L**2*US%T_to_s * & - OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & - OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + FAuI(I) = FAuI(I) + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & + OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo do I=ish-1,ieh ; if (do_I(I)) then BT_cont%FA_u_W0(I,j) = FAuI(I) ; BT_cont%FA_u_E0(I,j) = FAuI(I) @@ -1120,7 +1119,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - vh(i,J,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) + vh(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) enddo endif enddo ! k-loop @@ -1240,9 +1239,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + US%m_to_L**2*US%T_to_s * & - OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & - OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + FAvi(i) = FAvi(i) + OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & + OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo do i=ish,ieh ; if (do_I(i)) then BT_cont%FA_v_S0(i,J) = FAvi(i) ; BT_cont%FA_v_N0(i,J) = FAvi(i) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 4e64342c2d..622cf75de0 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -142,8 +142,8 @@ module MOM_open_boundary logical :: salt_segment_data_exists !< true if salinity data arrays are present real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [m s-1] !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] 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 @@ -151,7 +151,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential !! to the OB segment [m s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [m3 s-1]. + !! 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 [m]. @@ -3285,12 +3285,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) normal_trans_bt(I,j) = 0.0 do k=1,G%ke segment%normal_vel(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k) - segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & - US%L_to_m*G%dyCu(I,j) - normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) + segment%normal_trans(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & + G%dyCu(I,j) + normal_trans_bt(I,j) = normal_trans_bt(I,j) + segment%normal_trans(I,j,k) enddo - segment%normal_vel_bt(I,j) = US%m_s_to_L_T*normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & - US%L_to_m*G%dyCu(I,j)) + segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) / (max(segment%Htot(I,j),1.e-12) * G%dyCu(I,j)) if (associated(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 @@ -3299,12 +3298,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) normal_trans_bt(i,J) = 0.0 do k=1,G%ke segment%normal_vel(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k) - segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & - US%L_to_m*G%dxCv(i,J) - normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) + segment%normal_trans(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & + G%dxCv(i,J) + normal_trans_bt(i,J) = normal_trans_bt(i,J) + segment%normal_trans(i,J,k) enddo - segment%normal_vel_bt(i,J) = US%m_s_to_L_T*normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & - US%L_to_m*G%dxCv(i,J)) + segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) / (max(segment%Htot(i,J),1.e-12) * G%dxCv(i,J)) if (associated(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. & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index bf643536fc..7a2a6bfd90 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -269,7 +269,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! 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. + ! thickness D_edge, in the same units as lat [m]. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. @@ -292,7 +292,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) g_prime_tot = (GV%g_Earth / GV%Rho0)*2.0 Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%s_to_T*US%L_to_m*Def_Rad) * GV%Z_to_H + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%m_to_L*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 9956756559..c211341493 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -273,8 +273,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) - segment%normal_trans(I,j,k) = US%L_T_to_m_s*segment%normal_vel(I,j,k) * & - h(i+1,j,k) * G%US%L_to_m*G%dyCu(I,j) + segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) enddo endif endif @@ -329,8 +328,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) do k=1,nz segment%normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - segment%normal_trans(i,J,k) = US%L_T_to_m_s*segment%normal_vel(i,J,k) * & - h(i,j+1,k) * G%US%L_to_m*G%dxCv(i,J) + segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) enddo endif endif diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 5e784ad57e..da4751b3fa 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -162,22 +162,22 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) jsd = segment%HI%jsd ; jed = segment%HI%jed IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB if (CS%frequency == 0.0) then - flow = CS%zonal_flow + flow = G%US%m_s_to_L_T*CS%zonal_flow else - flow = CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) + flow = G%US%m_s_to_L_T*CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) endif do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*flow + segment%normal_vel(I,j,k) = flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = flow * G%US%L_to_m*G%dyCu(I,j) + segment%normal_trans(I,j,k) = flow * G%dyCu(I,j) endif enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*flow + segment%normal_vel_bt(I,j) = flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 6d69fbb2b6..19aacab72d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -31,7 +31,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) 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. - real :: zonal_flow + real :: zonal_flow ! Inflow speed [L T-1 ~> m s-1] integer :: i, j, k, l integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -41,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, 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) + units="m/s", default=8.57, scale=G%US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) @@ -55,15 +55,15 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*zonal_flow + segment%normal_vel(I,j,k) = zonal_flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = zonal_flow * G%US%L_to_m*G%dyCu(I,j) + segment%normal_trans(I,j,k) = zonal_flow * G%dyCu(I,j) endif enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*zonal_flow + segment%normal_vel_bt(I,j) = zonal_flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied From b84e8cadcd0e9758f444ce2a0a1a7cd0673ecb21 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 16:21:23 -0400 Subject: [PATCH 057/104] +Rescaled OBC%segment%tangential_grad to [T-1] Rescaled the units of the tangential_grad element of the OBC_segment type to [T-1] for more complete dimensional consistency testing. All answers are bitwise identical, but the units of an element in a transparent type has been rescaled. --- src/core/MOM_CoriolisAdv.F90 | 8 +-- src/core/MOM_open_boundary.F90 | 56 +++++++++++-------- .../lateral/MOM_hor_visc.F90 | 8 +-- 3 files changed, 40 insertions(+), 32 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e734b1a00d..e57850e82c 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -316,9 +316,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -356,9 +356,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 622cf75de0..b7b21d312d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -149,7 +149,7 @@ module MOM_open_boundary 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 [m s-1]. + !! 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 @@ -172,7 +172,7 @@ module MOM_open_boundary 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 [s-1]. + !! 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_InvLscale3_out !< An effective inverse length scale cubed [m-3] @@ -1707,8 +1707,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) + & - rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1774,9 +1774,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*US%m_s_to_L_T*G%IdxBu(I-1,J) & + + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*US%m_s_to_L_T*G%IdxBu(I-2,J)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -1903,8 +1905,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) + & - rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1970,9 +1972,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*US%m_s_to_L_T*G%IdxBu(I+1,J) & + + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*US%m_s_to_L_T*G%IdxBu(I+2,J)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2100,8 +2104,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) + & - rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2167,9 +2171,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) & - + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + segment%tangential_grad(I,J,k) = ( US%m_s_to_L_T* & + (cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2296,8 +2302,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) + & - rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2363,9 +2369,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) & - + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + segment%tangential_grad(I,J,k) = (US%m_s_to_L_T * & + (cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -3330,7 +3338,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & @@ -3338,7 +3346,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4da86902b3..29b050b148 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -596,9 +596,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -618,9 +618,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) endif endif enddo From c20db368cd27169d63bb3ad35cfa5e4244dd8a4c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 17:42:24 -0400 Subject: [PATCH 058/104] +Rescaled OBC%segment%grad_gradient to [m s-1 L-1] Rescaled the units of the grad_gradient element of the OBC_segment type to [T-1] for more complete dimensional consistency testing. Also rearranged scaling arguments in MOM_open_boundary.F90. All answers are bitwise identical, but the units of an element in a transparent type has been rescaled. --- src/core/MOM_open_boundary.F90 | 137 ++++++++++++++++++--------------- 1 file changed, 73 insertions(+), 64 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b7b21d312d..93eb0005e5 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -160,7 +160,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the !! segment [s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment [m-1 s-1] + !! segment times a grid spacing [m s-1 L-1 ~> s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -1699,11 +1699,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I-1,J) +! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) +! rx_avg = US%m_s_to_L_T*u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) +! rx_avg = US%m_s_to_L_T*u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif @@ -1774,12 +1774,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*US%m_s_to_L_T*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*US%m_s_to_L_T*G%IdxBu(I-2,J)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1897,11 +1897,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I+1,J) +! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) +! rx_avg = US%m_s_to_L_T*u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) +! rx_avg = US%m_s_to_L_T*u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif @@ -1972,12 +1972,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*US%m_s_to_L_T*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*US%m_s_to_L_T*G%IdxBu(I+2,J)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2038,9 +2038,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) + segment%normal_vel(i,J,k) = US%m_s_to_L_T * & + ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -2096,15 +2098,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1)) +! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = v_new(i,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) +! rx_avg = US%m_s_to_L_T*v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) +! rx_avg = US%m_s_to_L_T*v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif @@ -2146,9 +2149,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2171,12 +2176,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ( US%m_s_to_L_T* & - (cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & - rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2294,11 +2299,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%US%m_to_L*G%IdyBu(I,J+1) +! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = v_new(i,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) +! rx_avg = US%m_s_to_L_T*v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = v_new(i+1,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) +! rx_avg = US%m_s_to_L_T*v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif @@ -2344,9 +2349,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2359,7 +2366,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) endif gamma_2 = dt / (tau + dt) segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) + gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo ; enddo endif if (segment%oblique_grad) then @@ -2369,12 +2376,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = (US%m_s_to_L_T * & - (cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & - rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2500,10 +2507,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & - (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%US%m_to_L*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) - segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J)) - & - (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%US%m_to_L*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) enddo enddo endif @@ -2526,10 +2533,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & - (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%US%m_to_L*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) - segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J)) - & - (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%US%m_to_L*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) enddo enddo endif @@ -2554,10 +2561,11 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%US%m_to_L*G%IdxBu(I,J-2)) - & - (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%US%m_to_L*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) - segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1)) - & - (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%US%m_to_L*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? + segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & + (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) + segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) enddo enddo endif @@ -2580,10 +2588,11 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%US%m_to_L*G%IdxBu(I,J+2)) - & - (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%US%m_to_L*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) - segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%US%m_to_L*G%IdxBu(I,J+1)) - & - (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%US%m_to_L*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? + segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & + (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) + segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) enddo enddo endif From ce21fd0d88cecfacdf9be87bece3c9209f24e2dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 19:47:58 -0400 Subject: [PATCH 059/104] Unit scaling term cleanup in set_viscous_BBL Rearranged and canceled out common unit scaling factors in set_viscous_BBL and set_viscous_ML, partly in preparation to rescale velocities. All answers are bitwise identical. --- .../vertical/MOM_set_viscosity.F90 | 58 ++++++++++--------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8b4101eb62..26c0c41758 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -171,7 +171,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 kg m-3 ~> 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 m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -231,9 +231,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Vol_quit ! The volume error below which to quit iterating [H ~> m or kg m-2]. real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2]. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at - ! the depth of each interface, nondimensional. + ! the depth of each interface [nondim]. real :: L_direct ! The value of L above volume Vol_direct [nondim]. - real :: L_max, L_min ! Upper and lower bounds on the correct value for L. + real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. real :: Vol_err_max ! The volume errors for the upper and lower bounds on real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. @@ -246,7 +246,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: ustH ! ustar converted to units of H T-1 [H T-1 ~> m s-1 or kg m-2 s-1]. real :: root ! A temporary variable [H T-1 ~> m s-1 or kg m-2 s-1]. - real :: Cell_width ! The transverse width of the velocity cell [m]. + 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]. @@ -291,9 +291,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS OBC => CS%OBC - U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel + U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. @@ -521,9 +521,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*US%m_s_to_L_T*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -533,7 +533,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -822,7 +822,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acting on each layer. + ! and the Raleigh 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 @@ -831,12 +831,12 @@ 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 = US%L_to_m*G%dy_Cu(I,j) - else ; Cell_width = US%L_to_m*G%dx_Cv(i,J) ; endif + if (m==1) then ; Cell_width = G%dy_Cu(I,j) + else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = US%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + 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 + & - GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + US%L_to_Z*GV%Z_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -844,13 +844,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh*US%T_to_s*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*US%m_s_to_L_T*sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh*US%T_to_s*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*US%m_s_to_L_T*sqrt(v(i,J,k)*v(i,J,k) + & u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif @@ -913,7 +913,7 @@ end subroutine set_viscous_BBL function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -922,7 +922,8 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G)),& intent(in) :: mask2dCv !< A multiplicative mask of the v-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_v_at_u !< The retur value of v at u points [m s-1]. + real :: set_v_at_u !< The return value of v at u points points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of v at the u-points. real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -956,7 +957,7 @@ end function set_v_at_u function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -965,7 +966,8 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: mask2dCu !< A multiplicative mask of the u-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_u_at_v !< The return value of u at v points [m s-1]. + real :: set_u_at_v !< The return value of u at v points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of u at the v-points. real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1091,7 +1093,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 kg m-3 ~> 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 m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -1132,9 +1134,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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 + U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1336,9 +1338,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot + ustar(I) = cdrag_sqrt_Z * US%m_s_to_L_T*hutot/hwtot else - ustar(I) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1573,9 +1575,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot + ustar(i) = cdrag_sqrt_Z * US%m_s_to_L_T*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1922,7 +1924,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& "velocity magnitude. DRAG_BG_VEL is only used when "//& - "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0) + "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) 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 "//& From 32aa6d5ff098b1a9c0995b5e1b86478403838dfa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 11 Aug 2019 05:13:17 -0400 Subject: [PATCH 060/104] Simplified scaling terms in find_uv_at_h Canceled out corresponding dimensional scaling factors in the numerator and denominator of two expressions in find_uv_at_h. All answers are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6354ca8d71..96652a9f45 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -582,7 +582,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open ! ocean, nondimensional. - real :: s, Idenom + real :: sum_area, Idenom logical :: mix_vertically integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -598,20 +598,20 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) !$OMP private(s,Idenom,a_w,a_e,a_s,a_n,b_denom_1,b1,d1,c1) do j=js,je do i=is,ie - s = US%L_to_m**2*G%areaCu(I-1,j)+US%L_to_m**2*G%areaCu(I,j) - if (s>0.0) then - Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_w(i) = US%L_to_m**2*G%areaCu(I-1,j)*Idenom - a_e(i) = US%L_to_m**2*G%areaCu(I,j)*Idenom + sum_area = G%areaCu(I-1,j) + G%areaCu(I,j) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_w(i) = G%areaCu(I-1,j) * Idenom + a_e(i) = G%areaCu(I,j) * Idenom else a_w(i) = 0.0 ; a_e(i) = 0.0 endif - s = US%L_to_m**2*G%areaCv(i,J-1)+US%L_to_m**2*G%areaCv(i,J) - if (s>0.0) then - Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_s(i) = US%L_to_m**2*G%areaCv(i,J-1)*Idenom - a_n(i) = US%L_to_m**2*G%areaCv(i,J)*Idenom + sum_area = G%areaCv(i,J-1) + G%areaCv(i,J) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_s(i) = G%areaCv(i,J-1) * Idenom + a_n(i) = G%areaCv(i,J) * Idenom else a_s(i) = 0.0 ; a_n(i) = 0.0 endif From 54db6d33fc480353cff5c5883294261e71168e20 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 11 Aug 2019 10:51:18 -0400 Subject: [PATCH 061/104] Rescaled variables in MOM_internal_tides.F90 Applied dimensional rescaling to numerous internal variables in MOM_internal_tides.F90 for expanded dimensional consistency testing and to prepare for wave speeds to passed in with units of [L T-1]. All answers are bitwise identical. --- .../lateral/MOM_internal_tides.F90 | 294 +++++++++--------- 1 file changed, 140 insertions(+), 154 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 5a6837c1ad..918b0d142c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -65,7 +65,7 @@ module MOM_internal_tides !! is possible (i.e. ridge cells) ! (could be in G control structure) real, allocatable, dimension(:,:,:,:) :: cp - !< horizontal phase speed [m s-1] + !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss !< energy lost due to misc background processes [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_quad_loss @@ -74,7 +74,7 @@ module MOM_internal_tides !< energy lost due to wave breaking [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed !< fixed part of the energy lost due to small-scale drag - !! [kg Z-2 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] + !! [kg m L-2 Z-1 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, @@ -106,7 +106,7 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle,frequency,mode) real, dimension(:,:,:), pointer :: En_restart => NULL() !< The internal wave energy density as a function of (i,j,angle); temporary for restart - real, allocatable, dimension(:) :: frequency !< The frequency of each band [s-1]. + 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. @@ -172,7 +172,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & test real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only - Ub, Umax ! near-bottom & max horizontal velocity of wave (modal) + Ub, & ! near-bottom horizontal velocity of wave (modal) [m s-1] + Umax ! Maximum horizontal velocity of wave (modal) [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & flux_heat_y, & flux_prec_y @@ -183,9 +184,12 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & drag_scale, & ! bottom drag scale, s-1 itidal_loss_mode, allprocesses_loss_mode ! energy loss rates for a given mode and frequency (summed over angles) - real :: frac_per_sector, f2, I_rho0, I_D_here, freq2, Kmag2 - real :: c_phase, loss_rate, Fr2_max - real, parameter :: cn_subRO = 1e-100 ! to prevent division by zero + real :: frac_per_sector, f2, I_rho0, I_D_here, Kmag2 + real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: c_phase ! The phase speed [m s-1] + real :: loss_rate, Fr2_max + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] + real :: dt_in_T ! The timestep [T ~> s] real :: En_new, En_check ! for debugging real :: En_initial, Delta_E_check ! for debugging real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! for debugging @@ -198,6 +202,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 + dt_in_T = US%s_to_T*dt + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** ! This is wrong, of course, but it works reasonably in some cases. @@ -210,8 +216,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%energized_angle <= 0) then frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -220,8 +226,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) a = CS%energized_angle do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -241,7 +247,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%nAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -267,7 +274,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, US, CS, CS%NAngle) + call propagate(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), dt_in_T, & + G, US, CS, CS%NAngle) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -288,7 +296,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%NAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -378,14 +387,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then 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), & + call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, US%s_to_T*CS%frequency(fr), & CS%wave_structure_CSp, 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)) + Ub(i,j,fr,m) = US%m_s_to_L_T * CS%wave_structure_CSp%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = US%m_s_to_L_T * maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -417,14 +426,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) + f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + Kmag2 = (freq2 - f2) / (US%m_s_to_L_T**2*cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Fr2_max = (Umax(i,j,fr,m)/c_phase)**2 + 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 En_initial = sum(CS%En(i,j,:,fr,m)) ! for debugging @@ -626,9 +635,9 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, intent(in) :: Nb !< Near-bottom stratification [s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal - !! mode velocity [m s-1]. + !! mode velocity [L T-1 ~> m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg Z-2 ~> kg m-2] + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg m L-2 Z-1 ~> kg m-2] !! (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves [J m-2]. @@ -666,7 +675,8 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, enddo ! Calculate TKE loss rate; units of [W m-2] here. - TKE_loss_tot = q_itides * US%Z_to_m**2 * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + TKE_loss_tot = q_itides * US%Z_to_m**3*US%s_to_T**3 * TKE_loss_fixed(i,j) * & + US%T_to_s*Nb(i,j) * Ub(i,j,fr,m)**2 ! Update energy remaining (this is a pseudo implicit calc) ! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero @@ -726,7 +736,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -735,9 +745,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. @@ -753,15 +763,14 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) Flux_E real, dimension(SZI_(G),SZJ_(G),1-stencil:NAngle+stencil) :: & CFL_ang - real :: f2 ! The squared Coriolis parameter [s-2]. - real :: favg ! The average Coriolis parameter at a point [s-1]. - real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter [s-2 m-1]. - real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. + real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. + real :: favg ! The average Coriolis parameter at a point [T-1 ~> s-1]. + real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [T-1 L-1 ~> s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [m-1]. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [m-1]. real :: Angle_size, dt_Angle_size, angle real :: Ifreq, Kmag2, I_Kmag - real, parameter :: cn_subRO = 1e-100 + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] integer :: is, ie, js, je, asd, aed, na integer :: i, j, a @@ -769,9 +778,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) asd = 1-stencil ; aed = NAngle+stencil Ifreq = 1.0 / freq - + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. Angle_size = (8.0*atan(1.0)) / (real(NAngle)) - dt_Angle_size = dt / Angle_size + dt_Angle_size = dt_in_T / Angle_size do A=asd,aed angle = (real(A) - 0.5) * Angle_size @@ -792,29 +801,21 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Do the refraction. do i=is,ie - f2 = 0.25*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + f2 = 0.25* ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdxT(i,j) - df_dx = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & - (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & - G%IdxT(i,j) - dlnCn_dx = 0.5*( US%m_to_L*G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & + favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) + df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * G%IdxT(i,j) + dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & - US%m_to_L*G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & + G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdyT(i,j) - df_dy = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & - G%IdyT(i,j) - dlnCn_dy = 0.5*( US%m_to_L*G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & + df_dy = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * G%IdyT(i,j) + dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & (0.5*(cn(i,j+1) + cn(i,j)) + cn_subRO) + & - US%m_to_L*G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & + G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & (0.5*(cn(i,j) + cn(i,j-1)) + cn_subRO) ) Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cn_subRO**2) if (Kmag2 > 0.0) then @@ -829,8 +830,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Determine the energy fluxes in angular orientation space. do A=asd,aed ; do i=is,ie - CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * & - dt_Angle_size + CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * dt_Angle_size if (abs(CFL_ang(i,j,A)) > 1.0) then call MOM_error(WARNING, "refract: CFL exceeds 1.", .true.) if (CFL_ang(i,j,A) > 0.0) then ; CFL_ang(i,j,A) = 1.0 ; else ; CFL_ang(i,j,A) = -1.0 ; endif @@ -850,7 +850,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) else ! Use PPM do i=is,ie - call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt,stencil) + call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt_in_T,stencil) enddo endif @@ -866,10 +866,10 @@ end subroutine refract !> This subroutine calculates the 1-d flux for advection in angular space using a monotonic !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. -subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) +subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a @@ -887,7 +887,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer :: a real :: aR, aL, dMx, dMn, Ep, Ec, Em, dA, mA, a6 - I_dt = 1 / dt + I_dt = 1 / dt_in_T Angle_size = (8.0*atan(1.0)) / (real(NAngle)) I_Angle_size = 1 / Angle_size Flux_En(:) = 0 @@ -916,7 +916,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aR - 0.5 * CFL_ang(A) * ( ( aR - aL ) - a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux else ! Implementation of PPM-H3 @@ -940,14 +940,14 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aL + 0.5 * CFL_ang(A) * ( ( aR - aL ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux endif enddo end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -956,28 +956,28 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. 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. ! 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 [m s-1]. + speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. integer, parameter :: stencil = 2 real, dimension(SZIB_(G),SZJ_(G)) :: & - speed_x ! The magnitude of the group velocity at the Cu points [m s-1]. + speed_x ! The magnitude of the group velocity at the Cu points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - speed_y ! The magnitude of the group velocity at the Cv points [m s-1]. + speed_y ! The magnitude of the group velocity at the Cv points [L T-1 ~> m s-1]. real, dimension(0:NAngle) :: & cos_angle, sin_angle real, dimension(NAngle) :: & Cgx_av, Cgy_av, dCgx, dCgy real :: f2 ! The squared Coriolis parameter [s-2]. real :: Angle_size, I_Angle_size, angle - real :: Ifreq, freq2 - real, parameter :: cn_subRO = 1e-100 + real :: Ifreq ! The inverse of the frequency [T ~> s] + real :: freq2 ! The frequency squared [T-2 ~> s-2] type(loop_bounds_type) :: LB integer :: is, ie, js, je, asd, aed, na integer :: ish, ieh, jsh, jeh @@ -1010,14 +1010,14 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Fix indexing here later speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do a=1,na ! Apply the propagation WITH CORNER ADVECTION/FINITE VOLUME APPROACH. LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie - call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt, G, CS, LB) + call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt_in_T, G, CS, LB) enddo ! a-loop else ! IMPLEMENT PPM ADVECTION IN HORIZONTAL----------------------- @@ -1040,19 +1040,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) enddo do j=jsh,jeh ; do I=ish-1,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do J=jsh-1,jeh ; do i=ish,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, US, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1063,29 +1063,29 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, US, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') - endif + end subroutine propagate !> This subroutine does first-order corner advection. It was written with the hopes !! of smoothing out the garden sprinkler effect, but is too numerically diffusive to !! be of much use as of yet. It is not yet compatible with reflection schemes (BDM). -subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS, LB) +subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, G, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(inout) :: En !< The energy density integrated over an angular !! band [W m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & intent(in) :: speed !< The magnitude of the group velocity at the cell - !! corner points [m s-1]. + !! corner points [L T-1 ~> m s-1]. integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous !! call to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1123,12 +1123,16 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS energized_angle = Angle_size * real(energized_wedge - 1) ! for a=1 aligned with x-axis !energized_angle = Angle_size * real(energized_wedge - 1) + 2.0*Angle_size ! !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! - x = G%geoLonBu - y = G%geoLatBu - Idx = G%US%m_to_L*G%IdxBu ; dx = G%US%L_to_m*G%dxBu - Idy = G%US%m_to_L*G%IdyBu ; dy = G%US%L_to_m*G%dyBu + do J=jsh-1,jeh ; do I=ish-1,ieh + ! This will only work for a Cartesian grid for which G%geoLonBu is in the same units has dx. + ! This needs to be extensively revised to work for a general grid. + x(I,J) = G%US%m_to_L*G%geoLonBu(I,J) + y(I,J) = G%US%m_to_L*G%geoLatBu(I,J) + Idx(I,J) = G%IdxBu(I,J) ; dx(I,J) = G%dxBu(I,J) + Idy(I,J) = G%IdyBu(I,J) ; dy(I,J) = G%dyBu(I,J) + enddo ; enddo - do j=jsh,jeh; do i=ish,ieh + do j=jsh,jeh ; do i=ish,ieh do m=1,int(Nsubrays) theta = energized_angle - 0.5*Angle_size + real(m - 1)*Angle_size*I_Nsubwedges if (theta < 0.0) then @@ -1136,8 +1140,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS elseif (theta > TwoPi) then theta = theta - TwoPi endif - cos_thetaDT = cos(theta)*dt - sin_thetaDT = sin(theta)*dt + cos_thetaDT = cos(theta)*dt_in_T + sin_thetaDT = sin(theta)*dt_in_T ! corner point coordinates of advected fluid parcel ---------- xg = x(I,J); yg = y(I,J) @@ -1335,7 +1339,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1344,11 +1348,11 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the - !! Cu points [m s-1]. + !! Cu points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< 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. @@ -1382,25 +1386,19 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt, G, US, j, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*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_in_T*flux_x(I-1,j) ! left face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_x(I,j) ! right face influx (J) enddo ; enddo - ! test with old (take out later) - !do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) @@ -1408,18 +1406,15 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_x: OutFlux>Available") - ! endif - !enddo - En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) + En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1428,11 +1423,11 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & intent(in) :: speed_y !< The magnitude of the group velocity at the - !! Cv points [m s-1]. + !! Cv points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< 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. @@ -1467,14 +1462,14 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt, G, US, J, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + Fdt_m(i,j,a) = dt_in_T*flux_y(i,J-1) ! south face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_y(i,J) ! north face influx (J) + !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), & ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a)) @@ -1482,45 +1477,36 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !endif enddo ; enddo - ! test with old (take out later) - !do j=jsh,jeh ; do i=ish,ieh - ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(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) ! Update reflected energy (Jm-2) - do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.) - ! endif - !enddo - En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) - enddo ; enddo + En(i,j,a) = En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a)) + enddo ; enddo ; enddo end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction !! [J m-2]. - real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. @@ -1536,16 +1522,16 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i,j)) - else ; CFL = u(I) * dt * US%m_to_L*G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) - uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * US%m_to_L*G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) - uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (hL(i+1) + CFL * (0.5*(hR(i+1)-hL(i+1)) + curv_3*(CFL - 1.5))) else uh(I) = 0.0 @@ -1556,15 +1542,15 @@ end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the !! fluxes [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the !! reconstruction [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the !! reconstruction [J m-2]. - real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. @@ -1580,16 +1566,16 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j)) - else ; CFL = v(i) * dt * US%m_to_L*G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) - vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * US%m_to_L*G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) - vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) else vh(i) = 0.0 @@ -2126,7 +2112,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! array for temporary storage of flags ! of cells with double-reflecting ridges logical :: use_int_tides, use_temperature - integer :: num_angle, num_freq, num_mode, m, fr, period_1 + real :: period_1 ! The period of the gravest modeled mode [T ~> s] + integer :: num_angle, num_freq, num_mode, m, fr integer :: isd, ied, jsd, jed, a, id_ang, i, j type(axes_grp) :: axes_ang ! This include declares and sets the variable "version". @@ -2180,7 +2167,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) - call read_param(param_file, "FIRST_MODE_PERIOD", period_1); ! ADDED BDM + call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, units="s", scale=US%s_to_T) do fr=1,num_freq CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM enddo @@ -2284,7 +2271,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=US%L_to_m) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) @@ -2319,8 +2306,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] - CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * h2(i,j) + CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) enddo ; enddo deallocate(h2) @@ -2510,14 +2496,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Near-bottom horizonal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 2-D horizonal phase velocity for each freq and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Horizonal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) enddo ; enddo From 58cf1a949af92ee42f96aa940e1155a1fa5081bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 11 Aug 2019 10:52:07 -0400 Subject: [PATCH 062/104] +Rescaled CDp%uhGM diagnostics to [H L2 T-1] Rescalded the CDp%uhGM and CDp%vhGM diagnostic arrays to units of [H L2 T-1] and added simplifying conversion factors to several diagnostics. Also the diffusivities returned by thickness_diffuse_get_KH are now being given in units of [L2 T-1]. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 12 ++++----- src/diagnostics/MOM_diagnostics.F90 | 26 +++++++++---------- .../lateral/MOM_hor_visc.F90 | 4 +-- .../lateral/MOM_thickness_diffuse.F90 | 20 +++++++------- 4 files changed, 31 insertions(+), 31 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 5ee7cd9056..fc5118a448 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -156,8 +156,8 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] - diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] + diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] @@ -186,10 +186,10 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] - vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] + vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] ! Each of the following fields is found at nz+1 interfaces. real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity [H s-1 ~> m s-1 or kg m-2 s-1] diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index eef2955ee0..211e8d7741 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -506,13 +506,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%uh_Rlay(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = US%L_to_m**2*US%s_to_T*uh(I,j,k) + CS%uh_Rlay(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) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt - CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*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 enddo ; enddo enddo @@ -528,12 +528,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%vh_Rlay(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vh_Rlay(i,J,k) = US%L_to_m**2*US%s_to_T*vh(i,J,k) + CS%vh_Rlay(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) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt - CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*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 enddo ; enddo enddo @@ -558,7 +558,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo ; enddo enddo - if (CS%id_uh_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, CS%uhGM_Rlay, CS%diag) endif if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then @@ -1603,22 +1603,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 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=convert_H) + 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=convert_H) + 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=convert_H) + '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=convert_H) + '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 diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 29b050b148..1fc98f111a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -295,9 +295,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! These 3-d arrays are unused. ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & - ! KH_u_GME !< interface height diffusivities in u-columns [m2 s-1] + ! KH_u_GME !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & - ! KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] + ! KH_v_GME !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0213ccb319..2b4cdfadee 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -78,8 +78,8 @@ module MOM_thickness_diffuse real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [m2 s-1] - KH_v_GME => NULL() !< interface height diffusivities in v-columns [m2 s-1] + 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] !>@{ !! Diagnostic identifier @@ -278,7 +278,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then do k=1,nz+1 ; do j=js,je ; do I=is-1,ie - CS%KH_u_GME(I,j,k) = US%L_to_m**2*US%s_to_T*KH_u(I,j,k) + CS%KH_u_GME(I,j,k) = KH_u(I,j,k) enddo ; enddo ; enddo endif @@ -360,7 +360,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then do k=1,nz+1 ; do J=js-1,je ; do i=is,ie - CS%KH_v_GME(i,J,k) = US%L_to_m**2*US%s_to_T*KH_v(i,J,k) + CS%KH_v_GME(i,J,k) = KH_v(i,J,k) enddo ; enddo ; enddo endif @@ -481,11 +481,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do k=1,nz do j=js,je ; do I=is-1,ie uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T - if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = US%L_to_m**2*US%s_to_T*uhD(I,j,k) + if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T - if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = US%L_to_m**2*US%s_to_T*vhD(i,J,k) + if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & @@ -1946,10 +1946,10 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) type(thickness_diffuse_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME!< interface height - !! diffusivities in u-columns [m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME!< interface height - !! diffusivities in v-columns [m2 s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME !< interface height + !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME !< interface height + !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! Local variables integer :: i,j,k From 561cf9523604b29473cdacdf537dbd9c17830f35 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 04:40:12 -0400 Subject: [PATCH 063/104] +Pass internal wave speeds in [L T-1] Chnaged wave_speeds, wave_structure and propagate_int_tide to pass the internal wave speeds in rescaled units of [L T-1] and pass frequency to wave_structure in [T-1]. All answers in the MOM6-examples test suite are bitwise identical, but the internal waves code is not being aggressively tested in this test suite. --- src/diagnostics/MOM_wave_speed.F90 | 12 +++++---- src/diagnostics/MOM_wave_structure.F90 | 25 ++++++++++--------- .../lateral/MOM_internal_tides.F90 | 13 +++++----- .../vertical/MOM_diabatic_driver.F90 | 4 +-- 4 files changed, 29 insertions(+), 25 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 5c7dabeed9..f8fc9b7cf9 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -522,7 +522,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes - real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [m s-1] + 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 logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. @@ -577,7 +577,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. - real, dimension(SZK_(G)+1) :: z_int, N2 + real, dimension(SZK_(G)+1) :: z_int + ! real, dimension(SZK_(G)+1) :: N2 integer :: nsub ! number of subintervals used for root finding integer, parameter :: sub_it_max = 4 ! maximum number of times to subdivide interval @@ -778,12 +779,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + ! N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) - N2(1) = N2(2) ; N2(kc+1) = N2(kc) - ! Calcualte depth at bottom + ! N2(1) = N2(2) ; N2(kc+1) = N2(kc) + ! Calculate depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then @@ -940,6 +941,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) else cn(i,j,2:nmodes) = 0.0 ! else too small to worry about endif ! if nmodes>1 .and. kc>nmodes .and. c1>c1_thresh + do m=1,nmodes ; cn(i,j,m) = US%m_s_to_L_T*cn(i,j,m) ; enddo else cn(i,j,:) = 0.0 endif ! if more than 2 layers diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0b7155826a..796413b47c 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -96,9 +96,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal - !! gravity wave speed [m s-1]. + !! gravity wave speed [L T-1 ~> m s-1]. integer, intent(in) :: ModeNum !< Mode number - real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. + 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. real, dimension(SZI_(G),SZJ_(G)), & @@ -130,14 +130,14 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector - real, parameter :: cg_subRO = 1e-100 ! a very small number + real :: cg_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real, parameter :: a_int = 0.5 ! value of normalized integral: \int(w_strct^2)dz = a_int real :: I_a_int ! inverse of a_int - real :: f2 ! squared Coriolis frequency + real :: f2 ! squared Coriolis frequency [T-2 ~> s-2] real :: Kmag2 ! magnitude of horizontal wave number squared logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. @@ -179,6 +179,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo S => tv%S ; T => tv%T g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth /GV%Rho0 + cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%Z_to_H*GV%H_to_Pa @@ -248,7 +249,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !----------------------------------- if (G%mask2dT(i,j) > 0.5) then - lam = 1/(cn(i,j)**2) + lam = 1/(US%L_T_to_m_s**2 * cn(i,j)**2) ! Calculate drxh_sum if (use_EOS) then @@ -421,7 +422,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo do itt=1,max_itt call tridiag_solver(a_diag(1:kc-1),b_diag(1:kc-1),c_diag(1:kc-1), & -lam_z(1:kc-1),e_guess(1:kc-1),"TDMA_H",e_itt) - e_guess(1:kc-1) = e_itt(1:kc-1)/sqrt(sum(e_itt(1:kc-1)**2)) + e_guess(1:kc-1) = e_itt(1:kc-1) / sqrt(sum(e_itt(1:kc-1)**2)) enddo ! itt-loop w_strct(2:kc) = e_guess(1:kc-1) w_strct(1) = 0.0 ! rigid lid at surface @@ -459,10 +460,10 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 !f2 = 0.25*US%s_to_T**2 *((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & ! (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) + Kmag2 = US%m_to_L**2 * (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) ! Calculate terms in vertically integrated energy equation int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 @@ -477,8 +478,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (Kmag2 > 0.0) then - KE_term = 0.25*GV%Rho0*( (1+f2/freq**2)/Kmag2*int_dwdz2 + int_w2 ) - PE_term = 0.25*GV%Rho0*( int_N2w2/freq**2 ) + KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) + PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then W0 = sqrt( En(i,j)/(KE_term + PE_term) ) else @@ -490,7 +491,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo W_profile = W0*w_strct dWdz_profile = W0*u_strct ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile = abs(dWdz_profile) * sqrt((1+f2/freq**2)/(2.0*Kmag2)) + Uavg_profile = abs(dWdz_profile) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) else W_profile = 0.0 dWdz_profile = 0.0 diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 918b0d142c..9014cb1dbb 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -166,7 +166,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & - intent(in) :: cn !< The internal wave speeds of each mode [m s-1]. + intent(in) :: cn !< The internal wave speeds of each + !! mode [L T-1 ~> m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & test @@ -247,7 +248,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo @@ -274,7 +275,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), dt_in_T, & + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt_in_T, & G, US, CS, CS%NAngle) enddo ; enddo @@ -296,7 +297,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo @@ -387,7 +388,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then 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, US%s_to_T*CS%frequency(fr), & + 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.) ! Pick out near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied @@ -428,7 +429,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Calculate horizontal phase velocity magnitudes f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - Kmag2 = (freq2 - f2) / (US%m_s_to_L_T**2*cn(i,j,m)**2 + cn_subRO**2) + Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a0def608fd..95ec82349c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -121,7 +121,7 @@ module MOM_diabatic_driver !! shear and ePBL diffusivities are used. integer :: nMode = 1 !< Number of baroclinic modes to consider real :: uniform_test_cg !< Uniform group velocity of internal tide - !! for testing internal tides [m s-1] (BDM) + !! for testing internal tides [L T-1 ~> m s-1] logical :: useALEalgorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical !! passed by argument to diabatic_driver_init. @@ -3291,7 +3291,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "that will be calculated.", default=1, do_not_log=.true.) call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & "If positive, a uniform group velocity of internal tide for test case", & - default=-1., units="m s-1") + default=-1., units="m s-1", scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & From 38ce6acd37de926ebbf4e007338938f64419f40b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 15:32:03 -0400 Subject: [PATCH 064/104] Rescaled variables in MOM_bulk_mixed_layer.F90 Applied dimensional rescaling to numerous internal variables in MOM_bulk_mixed_layer.F90 for expanded dimensional consistency testing and to prepare for velocities to passed in with units of [L T-1]. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 182 +++++++++--------- 1 file changed, 95 insertions(+), 87 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 48287bb86c..9494e6aaf1 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -119,7 +119,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, ppt. - ! These are terms in the mixed layer TKE budget, all in [Z m2 T-3 ~> m3 s-3] except as noted. + ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. diag_TKE_wind, & !< The wind source of TKE. @@ -247,8 +247,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, R0, & ! The potential density referenced to the surface [kg m-3]. Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & - u, & ! The zonal velocity [m s-1]. - v, & ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v, & ! The meridional velocity [L T-1 ~> m s-1]. h_orig, & ! The original thickness [H ~> m or kg m-2]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -263,9 +263,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, h_miss ! The summed absolute mismatch [Z ~> m]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step [Z m2 T-2 ~> m3 s-2]. + ! time step [Z L2 T-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection [Z m2 T-2 ~> m3 s-2]. + ! the depth of free convection [Z L2 T-2 ~> m3 s-2]. htot, & ! The total depth of the layers being considered for ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface @@ -277,7 +277,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the @@ -301,7 +301,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. TKE_river ! The source of turbulent kinetic energy available for mixing - ! at rivermouths [Z m2 T-3 ~> m3 s-3]. + ! at rivermouths [Z L2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -320,13 +320,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection - ! [Z m2 T-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-2]. h_CA ! The depth to which convective adjustment has gone [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment [Z m2 T-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment [Z m2 T-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) ! after entrainment but before any buffer layer detrainment [Z ~> m]. @@ -450,7 +450,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie - h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) + h(i,k) = h_3d(i,j,k) ; u(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v(i,k) = US%m_s_to_L_T*v_3d(i,j,k) h_orig(i,k) = h_3d(i,j,k) 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) @@ -514,7 +514,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (US%L_to_m**2*GV%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -544,7 +544,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, R0(:,1:), Rcv(:,1:), eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) @@ -573,7 +573,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) 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) + 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) @@ -808,9 +808,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to @@ -825,10 +825,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 T-2 ~> m3 s-2]. + !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 T-2 ~> m3 s-2]. + !! [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. @@ -853,19 +853,19 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + 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 m2 s-2. + ! convection, [H L2 T-2 ~> H m2 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]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in [m5 Z T-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! in [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -915,7 +915,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ih = 1.0 / h(i,k1) R0(i,k1) = R0_tot(i) * Ih u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih - dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * US%T_to_s**2*(CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * & (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))) Rcv(i,k1) = Rcv_tot(i) * Ih T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih @@ -937,7 +937,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -955,17 +955,17 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced !! to 0 pressure [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate !! variable potential density [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1004,10 +1004,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! band [degC H ~> degC m or degC kg m-2]. real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 T-2 ~> m3 s-2]. + real, dimension(SZI_(G)), intent(out) :: Conv_En !< The buoyant turbulent kinetic energy source + !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection [Z m2 T-2 ~> m3 s-2]. + !! energy due to free convection [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. @@ -1053,7 +1053,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! [m7 T-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1] real :: sum_Pen_En ! The potential energy change due to penetrating @@ -1068,7 +1068,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0 / dt_in_T is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1286,12 +1286,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & - US%T_to_s**2*((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) + ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent h(i,k) = h(i,k) - h_ent d_eb(i,k) = d_eb(i,k) - h_ent uhtot(i) = u(i,k)*h_ent ; vhtot(i) = v(i,k)*h_ent + !### I think that the line above should instead be: + ! uhtot(i) = uhtot(i) + h_ent*u(i,k) ; vhtot(i) = vhtot(i) + h_ent*v(i,k) endif @@ -1317,25 +1319,25 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 T-2 ~> m3 s-2]. + !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection - !! [Z m2 T-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 T-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 T-2 ~> m3 s-2]. + !! 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]. 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 !! available for driving mixing at river mouths - !! [Z m2 T-3 ~> m3 s-3]. + !! [Z L2 T-3 ~> m3 s-3]. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. @@ -1351,13 +1353,13 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convection to drive mechanical entrainment. ! Local variables - real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 T-2 ~> m3 s-2]. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z L2 T-2 ~> m3 s-2]. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2 [nondim]. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2 [nondim]. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive [Z m2 T-2 ~> m3 s-2]. + ! that release is positive [Z L2 T-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment [nondim], 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection [nondim], 0 to 1. real :: totEn_Z ! The total potential energy released by convection, [Z3 T-2 ~> m3 s-2]. @@ -1366,7 +1368,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real :: absf ! The absolute value of f averaged to thickness points [T-1 ~> s-1]. real :: U_star ! The friction velocity [Z T-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. - real :: wind_TKE_src ! The surface wind source of TKE [Z m2 T-3 ~> m3 s-3]. + real :: wind_TKE_src ! The surface wind source of TKE [Z L2 T-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls) [nondim]. integer :: is, ie, nz, i @@ -1418,7 +1420,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA) if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & @@ -1430,14 +1432,14 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & sqrt(0.5 * dt_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) @@ -1462,7 +1464,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_m**2*(U_star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_L**2*(U_star*U_Star*U_Star))*exp_kh) + & (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) if (CS%do_rivermix) then ! Add additional TKE at river mouths @@ -1470,7 +1472,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(US%Z_to_L**2*U_star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag @@ -1508,17 +1510,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density !! referenced to 0 pressure [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable !! potential density [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1575,22 +1577,22 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, - ! in [m5 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! in [L2 m3 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained - ! [Z m2 T-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [m2 T-2 ~> m2 s-2]. + ! across the mixed layer [L2 T-2 ~> L2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [m2 T2 ~> m2 s-2]. - real :: Cpen1 ! A temporary variable [m2 T-2 ~> m2 s-2]. + ! TKE, divided by layer thickness in m [L2 T2 ~> 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 m2 T-2 ~> m4 s-2 or kg m s-2] - real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 T-2 ~> m3 s-2]. + ! kinetic energy [H Z L2 T-2 ~> m4 s-2 or kg m s-2] + real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z L2 T-2 ~> m3 s-2]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy [Z m2 T-2 ~> m3 s-2]. - real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. + ! release of mean kinetic energy [Z L2 T-2 ~> m3 s-2]. + real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z L2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to - ! dTKE_dh [m2 T-2 ~> m2 s-2]. + ! dTKE_dh [L2 T-2 ~> m2 s-2]. real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1609,7 +1611,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - g_H_2Rho0 = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1622,7 +1624,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_avail = h(i,k) - eps(i,k) if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) ) - dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * US%T_to_s**2 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) ! Find the TKE that would remain if the entire layer were entrained. @@ -1677,7 +1679,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (CS%TKE_diagnostics) then E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)* TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & MKE_rate*dMKE*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(GV%H_to_Z*h_ent)*dRL @@ -1689,7 +1691,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & TKE(i) = TKE_full_ent !### The minimum TKE value in this line may be problematically small. - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%T_to_s**2*US%m_to_Z + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z*US%m_s_to_L_T**2 else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1748,7 +1750,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Cpen1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0) - TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) + TKE_ent1 = exp_kh* TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh) HpE = htot(i)+h_ent MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) @@ -1790,7 +1792,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)* TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & dMKE*MKE_rate*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(h_ent*GV%H_to_Z)*dRL @@ -2291,7 +2293,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers [kg H2 Z T-2 m-3 ~> J m-2 or J kg2 m-8]. + ! buffer layers [kg H2 Z T-2 L-2 m-1 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. @@ -2330,8 +2332,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! [degC ppt-1] and [ppt degC-1]. real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. - real :: g_2 ! 1/2 g_Earth [m2 Z-1 T-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 T-2 ~> kg m-2 s-2]. + real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg L2 m-3 Z-1 T-2 ~> kg m-2 s-2]. real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z ! divided by the time step [Z2 H-2 T-1 ~> s-1 or m6 kg-2 s-1]. @@ -2340,7 +2342,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea 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 kg m T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [H2 L2 kg m-1 T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. 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. @@ -2359,8 +2361,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - g_2 = 0.5 * US%L_to_m**2*GV%g_Earth - Rho0xG = GV%Rho0 * US%L_to_m**2*GV%g_Earth + g_2 = 0.5 * GV%g_Earth + Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -3146,10 +3148,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time - ! step [m7 T-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: g_H2_2dt ! Half the gravitational acceleration times the square of the - ! conversion from H to m divided by the diagnostic time step - ! [m4 Z-1 H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. + ! conversion from H to Z divided by the diagnostic time step + ! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3161,8 +3163,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea "CS%nkbl must be 1 in mixedlayer_detrain_1.") dt_Time = dt_in_T / CS%BL_detrain_time - g_H2_2Rho0dt = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml @@ -3579,28 +3581,34 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) 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, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Wind-stirring source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Mean kinetic energy source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & - 'm3 s-3', conversion=US%Z_to_m) + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'TKE consumed by mixing that deepens the mixed layer', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Mechanical energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Convective energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Spurious source of mixed layer TKE from sigma2', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer detrainment', & - 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & From 8cf18977f6edf6d373be4ad86353ef530bcc5f0d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 18:24:34 -0400 Subject: [PATCH 065/104] Rescaled velocities in MOM_energetic_PBL.F90 Changed the units of internal velocity variables in MOM_energetic_PBL.F90 to [L T-1] to prepare for velocities to passed in with units of [L T-1]. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 485ae1e942..6659adbd68 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -323,8 +323,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS TKE_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. - u_2d, & ! A 2-d slice of the zonal velocity [m s-1]. - v_2d ! A 2-d slice of the meridional velocity [m s-1]. + u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1]. + v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & @@ -334,8 +334,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. - u, & ! The zonal velocity [m s-1]. - v ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v ! The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1]. @@ -404,7 +404,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie - h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = u_3d(i,j,k) ; v_2d(i,k) = v_3d(i,j,k) + h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v_2d(i,k) = US%m_s_to_L_T*v_3d(i,j,k) T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) TKE_forced_2d(i,k) = TKE_forced(i,j,k) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) @@ -607,7 +607,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. real :: uhtot ! The depth integrated zonal and meridional velocities in the - real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + real :: vhtot ! layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. @@ -1085,7 +1085,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then ! This is the energy that would be available from homogenizing the ! velocities between layer k and the layers above. - dMKE_max = (US%m_to_Z**3*US%T_to_s**2)*(GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + dMKE_max = (US%L_to_Z**2*US%m_to_Z*GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & (h(k) / ((htot + h(k))*htot)) * & ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be From a8c41f52987222e0d49d9da84f597a0e34ff3fec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 19:02:45 -0400 Subject: [PATCH 066/104] +Pass velocities to set_diffusivity in [L T-1] Passed the velocity arguments to set_diffusivity, calc_kappa_shear, calc_kappa_shear_vertex, add_drag_diffusivity, add_LOTW_BBL_diffusivity, set_BBL_TKE and calculate_CVMix_shear in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of multiple arguments in public interfaces have changed. --- .../vertical/MOM_CVMix_shear.F90 | 15 +++---- .../vertical/MOM_diabatic_driver.F90 | 17 ++++---- .../vertical/MOM_kappa_shear.F90 | 16 ++++---- .../vertical/MOM_set_diffusivity.F90 | 41 +++++++++---------- 4 files changed, 44 insertions(+), 45 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6b6bf32bf7..3ab0567db1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -59,17 +59,18 @@ module MOM_CVMix_shear subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points [m s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T + !! points [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. - type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous + !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] @@ -118,8 +119,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) do k = 1, G%ke km1 = max(1, k-1) kk = 2*(k-1) - DU = (u_h(i,j,k))-(u_h(i,j,km1)) - DV = (v_h(i,j,k))-(v_h(i,j,km1)) + DU = US%L_T_to_m_s*(u_h(i,j,k) - u_h(i,j,km1)) + DV = US%L_T_to_m_s*(v_h(i,j,k) - v_h(i,j,km1)) DRHO = (GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) ) DZ = ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) N2 = DRHO/DZ diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 95ec82349c..797e1beacc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -324,7 +324,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + call set_BBL_TKE(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, fluxes, visc, G, GV, US, CS%set_diff_CSp) call cpu_clock_end(id_clock_set_diffusivity) ! Frazil formation keeps the temperature above the freezing point. @@ -609,8 +609,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & + US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1394,8 +1395,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & + US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US,CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -2136,8 +2138,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & + US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 547840732d..f5343f86e2 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -98,9 +98,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & 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) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -189,7 +189,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_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 - u_2d(i,k) = u_in(i,j,k)*US%m_s_to_L_T ; v_2d(i,k) = v_in(i,j,k)*US%m_s_to_L_T + u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k) enddo ; enddo if (use_temperature) then ; do k=1,nz ; do i=is,ie T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) @@ -361,9 +361,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -462,13 +462,11 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Interpolate the various quantities to the corners, using masks. do k=1,nz ; do I=IsB,IeB - u_2d(I,k) = US%m_s_to_L_T * & - (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + & + u_2d(I,k) = (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + & u_in(I,j+1,k) * (G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) ) / & ((G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k)) + & G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) + GV%H_subroundoff) - v_2d(I,k) = US%m_s_to_L_T * & - (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + & + v_2d(I,k) = (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + & v_in(i+1,J,k) * (G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) ) / & ((G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k)) + & G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) + GV%H_subroundoff) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index dee3422a7a..7d118bc00a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -208,15 +208,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h !< Zonal velocity interpolated to h points [m s-1]. + intent(in) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h !< Meridional velocity interpolated to h points [m s-1]. + intent(in) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -493,7 +493,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & Kd_lay, Kd_int, dd%Kd_BBL) else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & + call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -530,8 +530,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, enddo ! j-loop if (CS%debug) then - call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -1106,9 +1105,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1262,8 +1261,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & - US%m_to_Z**2 * US%T_to_s**2 * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1342,9 +1340,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & 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_(G)), & - intent(in) :: u !< u component of flow [m s-1] + intent(in) :: u !< u component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< v component of flow [m s-1] + intent(in) :: v !< v component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1443,8 +1441,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - US%m_to_Z**2 * US%T_to_s**2 * & - 0.5*CS%BBL_effic * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1643,9 +1640,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -1661,15 +1658,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! integrated thickness in the BBL [Z ~> m]. real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] + uhtot, & ! running integral of u in the BBL [Z L T-1 ~> m2 s-1] ustar, & ! bottom boundary layer turbulence speed [Z T-1 ~> m s-1]. - u2_bbl ! square of the mean zonal velocity in the BBL [m2 s-2] + u2_bbl ! square of the mean zonal velocity in the BBL [L2 T-2 ~> m2 s-2] - real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z m s-1 ~> m2 s-1] + real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z L T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & vstar, & ! ustar at at v-points [Z T-1 ~> m s-1]. - v2_bbl ! square of average meridional velocity in BBL [m2 s-2] + v2_bbl ! square of average meridional velocity in BBL [L2 T-2 ~> m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: hvel ! thickness at velocity points [Z ~> m]. @@ -1764,7 +1761,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%T_to_s**2 * US%m_to_Z**2 * & + visc%TKE_BBL(i,j) = US%L_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & From 55aeaef5e42589402ad8db63e52704981f7de5bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 19:40:18 -0400 Subject: [PATCH 067/104] +Pass velocities to bulkmixedlayer in [L T-1] Passed the velocity arguments to bulkmixedlayer, energetic_PBL, and KPP_compute_BLD in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of multiple arguments in public interfaces have changed. --- .../vertical/MOM_CVMix_KPP.F90 | 28 +++++++++---------- .../vertical/MOM_bulk_mixed_layer.F90 | 6 ++-- .../vertical/MOM_diabatic_driver.F90 | 19 +++++++------ .../vertical/MOM_energetic_PBL.F90 | 6 ++-- 4 files changed, 31 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 6a9a23c057..2ff0b3efe1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -890,8 +890,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity [ppt] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [L T-1 ~> m s-1] type(EOS_type), pointer :: EOS !< Equation of state 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_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] @@ -965,8 +965,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (G%mask2dT(i,j)==0.) cycle do k=1,G%ke - U_H(k) = 0.5 * (U(i,j,k)+U(i-1,j,k)) - V_H(k) = 0.5 * (V(i,j,k)+V(i,j-1,k)) + U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) + V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) enddo ! things independent of position within the column @@ -1023,8 +1023,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH - surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH - surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + 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*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH surfHvs = surfHvs + 0.5*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH @@ -1041,8 +1041,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! vertical shear between present layer and ! surface layer averaged surfU,surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then @@ -1217,15 +1217,15 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = h(i,j,1) ! surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot ! surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - ! surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - ! surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + ! surfU = 0.5*US%L_T_to_m_s*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + ! surfV = 0.5*US%L_T_to_m_s*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot ! pRef = 0.0 ! do k = 2, G%ke ! ! Recalculate differences with surface layer - ! Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - ! Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + ! Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + ! Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV ! deltaU2(k) = Uk**2 + Vk**2 ! pRef = pRef + GV%H_to_Pa * h(i,j,k) ! call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) @@ -1238,8 +1238,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = hTot + delH ! surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot ! surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - ! surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - ! surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + ! surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + ! surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot ! endif ! enddo diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 9494e6aaf1..cbf42d2b8b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -193,10 +193,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, intent(inout) :: h_3d !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -450,7 +450,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie - h(i,k) = h_3d(i,j,k) ; u(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v(i,k) = US%m_s_to_L_T*v_3d(i,j,k) + h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) h_orig(i,k) = h_3d(i,j,k) 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) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 797e1beacc..fc126b94a2 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -665,7 +665,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & + US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & @@ -844,7 +845,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -1450,7 +1451,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & + US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & @@ -1575,7 +1577,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -2084,7 +2086,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T*CS%ML_mix_first, & + call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T*CS%ML_mix_first, & eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & @@ -2092,7 +2094,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e dt*CS%ML_mix_first, CS%id_brine_lay) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T, eaml, ebml, & + call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) endif @@ -2185,7 +2187,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo ; enddo endif - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & + US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & @@ -2478,7 +2481,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & + call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 6659adbd68..b486e1e2ca 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -247,10 +247,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature @@ -404,7 +404,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie - h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v_2d(i,k) = US%m_s_to_L_T*v_3d(i,j,k) + h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = u_3d(i,j,k) ; v_2d(i,k) = v_3d(i,j,k) T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) TKE_forced_2d(i,k) = TKE_forced(i,j,k) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) From e8c84a66eb34fbdb0515e19480d9d792fde609c1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 05:42:43 -0400 Subject: [PATCH 068/104] +Added thickness rescaling in MOM_state_stats Added dimensional rescaling of the volumes in MOM_state_stats so that the reported statistics are invariant across rescaling, and so that sum_across_PEs can use fixed-point arithmetic without changing answers. This change required the addition of verticalGrid_type and unit_scale_type arguments to MOM_state_stats. Also added an optional unit_scale_type argument to MOM_state_chksum_3arg. All answers are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 87 +++++++++++++++++------------- 1 file changed, 50 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 795885e817..36d69a8179 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -59,7 +59,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: is, ie, js, je, nz, hs logical :: sym @@ -79,30 +79,34 @@ end subroutine MOM_state_chksum_5arg ! ============================================================================= !> Write out chksums for the model's basic state variables. -subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) - character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. +subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] or [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - 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 - !! computationoal domain. - + 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 + !! 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 :: is, ie, js, je, nz, hs logical :: sym + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + 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) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=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 @@ -138,7 +142,7 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. 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 - !! computationoal domain. + !! computational domain. integer :: hs logical :: sym @@ -195,7 +199,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in !! the barotropic solver [L T-2 ~> m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: is, ie, js, je, nz logical :: sym @@ -219,47 +223,56 @@ end subroutine MOM_accel_chksum ! ============================================================================= !> Monitor and write out statistics for the model's state variables. -subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing) +subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, permitDiminishing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature [degC]. real, pointer, dimension(:,:,:), & intent(in) :: Salt !< Salinity [ppt]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: allowChange !< do not flag an error !! if the statistics change. - logical, optional, intent(in) :: permitDiminishing !< do not flag error - !!if the extrema are diminishing. + logical, optional, intent(in) :: permitDiminishing !< do not flag error if the + !! extrema are diminishing. + ! Local variables - integer :: is, ie, js, je, nz, i, j, k - real :: Vol, dV, Area, h_minimum + real :: Vol, dV ! The total ocean volume and its change [m3] (unscaled to permit reproducing sum). + real :: Area ! The total ocean surface area [m2] (unscaled to permit reproducing sum). + real :: h_minimum ! The minimum layer thicknesses [H ~> m or kg m-2] + logical :: do_TS ! If true, evaluate statistics for temperature and salinity type(stats) :: T, S, delT, delS - type(stats), save :: oldT, oldS ! NOTE: save data is not normally allowed but - logical, save :: firstCall = .true. ! we use it for debugging purposes here on the - logical :: do_TS - real, save :: oldVol ! assumption we will not turn this on with threads + + ! NOTE: save data is not normally allowed but we use it for debugging purposes here on the + ! assumption we will not turn this on with threads + type(stats), save :: oldT, oldS + logical, save :: firstCall = .true. + real, save :: oldVol ! The previous total ocean volume [m3] + character(len=80) :: lMsg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: is, ie, js, je, nz, i, j, k + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do_TS = associated(Temp) .and. associated(Salt) ! First collect local stats Area = 0. ; Vol = 0. do j = js, je ; do i = is, ie - Area = Area + G%US%L_to_m**2*G%areaT(i,j) + Area = Area + US%L_to_m**2*G%areaT(i,j) enddo ; enddo T%minimum = 1.E34 ; T%maximum = -1.E34 ; T%average = 0. S%minimum = 1.E34 ; S%maximum = -1.E34 ; S%average = 0. - h_minimum = 1.E34 + h_minimum = 1.E34*GV%m_to_H do k = 1, nz ; do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then - dV = G%US%L_to_m**2*G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV + dV = US%L_to_m**2*G%areaT(i,j)*GV%H_to_m*h(i,j,k) ; Vol = Vol + dV if (do_TS .and. h(i,j,k)>0.) then T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) T%average = T%average + dV*Temp(i,j,k) @@ -282,7 +295,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi delT%average = T%average - oldT%average delS%minimum = S%minimum - oldS%minimum ; delS%maximum = S%maximum - oldS%maximum delS%average = S%average - oldS%average - write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =',Vol/Area,' frac. delta=',dV/Vol + write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =', Vol/Area,' frac. delta=',dV/Vol call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum @@ -295,12 +308,12 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi call MOM_mesg(lMsg//trim(mesg)) endif else - write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =',Vol/Area + write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =', Vol/Area call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then - write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =', T%minimum, T%average, T%maximum call MOM_mesg(lMsg//trim(mesg)) - write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =',S%minimum,S%average,S%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =', S%minimum, S%average, S%maximum call MOM_mesg(lMsg//trim(mesg)) endif endif @@ -312,10 +325,10 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi if (do_TS .and. T%minimum<-5.0) then do j = js, je ; do i = is, ie if (minval(Temp(i,j,:)) == T%minimum) then - write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) + write(0,'(a,2f12.5)') 'x,y=', G%geoLonT(i,j), G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Extremum detected' endif @@ -328,7 +341,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Negative thickness detected' endif From a2cbca6853f4bdd0e2ee81f5f0790fba7dccd3f9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 05:43:51 -0400 Subject: [PATCH 069/104] +Pass velocities to diabatic in [L T-1] Passed the velocity arguments to diabatic and set_int_tide_input in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in public interfaces have changed. --- src/core/MOM.F90 | 16 ++ .../vertical/MOM_diabatic_driver.F90 | 184 +++++++++--------- .../vertical/MOM_internal_tide_input.F90 | 4 +- 3 files changed, 107 insertions(+), 97 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 9f87cc45ed..13dcc7dcce 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1186,9 +1186,25 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + 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, Waves=Waves) fluxes%fluxes_used = .true. + + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_diabatic) if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fc126b94a2..52dfe4f845 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -259,8 +259,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -315,16 +315,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & dt_in_T = dt * US%s_to_T if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug_energy_req) & call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) call cpu_clock_end(id_clock_set_diffusivity) ! Frazil formation keeps the temperature above the freezing point. @@ -352,7 +352,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call disable_averaging(CS%diag) endif ! associated(tv%T) .AND. associated(tv%frazil) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G, GV, US) if (CS%use_int_tides) then @@ -371,7 +371,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides - if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -384,7 +383,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif - call cpu_clock_begin(id_clock_pass) if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) @@ -414,7 +412,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G, GV, US) call disable_averaging(CS%diag) endif ! endif for frazil @@ -438,7 +436,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) end subroutine diabatic @@ -451,8 +449,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -489,7 +487,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -578,7 +576,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -591,7 +589,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(CS%optics)) & call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) - if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then @@ -609,8 +607,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & - US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -639,7 +636,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + 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 hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -665,8 +662,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & - US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & @@ -703,7 +699,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + 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 hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -727,10 +723,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, 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) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + 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) endif @@ -746,7 +742,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -806,7 +802,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_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea_s, "after calc_entrain ea_s", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after calc_entrain eb_s", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -845,8 +841,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -914,10 +910,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. @@ -948,12 +944,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + 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) 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) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -1038,10 +1034,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -1192,7 +1188,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, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1236,8 +1232,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -1274,7 +1270,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -1365,7 +1361,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -1378,7 +1374,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (associated(CS%optics)) & call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) - if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then @@ -1396,14 +1392,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & - US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & visc, dt_in_T, G, GV, US,CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + 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 hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -1451,8 +1446,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & - US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & @@ -1470,7 +1464,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + 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 hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -1494,10 +1488,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, 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) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + 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) endif @@ -1513,7 +1507,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -1563,7 +1557,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then @@ -1577,8 +1571,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -1634,13 +1628,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) 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) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -1722,10 +1716,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -1863,7 +1857,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, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1917,8 +1911,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -1950,7 +1944,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -2018,6 +2012,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] real :: Idt ! The inverse time step [s-1] + real :: Idt_accel ! The inverse time step times rescaling factors [m T L-1 s-2 ~> s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. @@ -2057,7 +2052,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -2086,7 +2081,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T*CS%ML_mix_first, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T*CS%ML_mix_first, & eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & @@ -2094,7 +2089,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e dt*CS%ML_mix_first, CS%id_brine_lay) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, eaml, ebml, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) endif @@ -2109,16 +2104,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) call cpu_clock_end(id_clock_mixedlayer) if (CS%debug) then - call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("After mixedlayer", fluxes, G, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif endif if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eaml, ebml) @@ -2140,14 +2135,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & - US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + 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 hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -2187,8 +2181,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo ; enddo endif - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & - US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & @@ -2223,7 +2216,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + 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 hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -2256,10 +2249,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, 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) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + 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) endif @@ -2273,7 +2266,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -2303,7 +2296,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + 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) endif @@ -2352,12 +2345,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call diag_update_remap_grids(CS%diag) if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + 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) 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) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! Here, T and S are updated according to ea and eb. ! If using the bulk mixed layer, T and S are also updated @@ -2449,7 +2442,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_tridiag) endif ! endif for associated(T) - if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G, GV, US) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then ! The mixed layer code has already been called, but there is some needed @@ -2476,12 +2469,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! (5) Possibly splits the buffer layer into two isopycnal layers. call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) - if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, US, haloshift=0) dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) - call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_mix, ea, eb, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) @@ -2500,7 +2493,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_mixedlayer) if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif else ! following block for when NOT using BULKMIXEDLAYER @@ -2550,12 +2543,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) endif ! endif for the BULKMIXEDLAYER block if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + 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 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) @@ -2565,7 +2558,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) call cpu_clock_end(id_clock_remap) if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. @@ -2702,7 +2695,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -2769,12 +2762,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! advection on velocity field. It is assumed that water leaves ! or enters the ocean with the surface velocity. if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) endif call cpu_clock_begin(id_clock_tridiag) + Idt_accel = US%L_T_to_m_s / dt !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq @@ -2796,16 +2790,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e do k=nz-1,1,-1 ; do I=Isq,Ieq u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt_accel enddo ; enddo if (associated(ADp%du_dt_dia)) then do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt_accel enddo endif enddo if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, US, haloshift=0) endif !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do J=Jsq,Jeq @@ -2828,17 +2822,17 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e do k=nz-1,1,-1 ; do i=is,ie v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt_accel enddo ; enddo if (associated(ADp%dv_dt_dia)) then do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt_accel enddo endif enddo call cpu_clock_end(id_clock_tridiag) if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, US, haloshift=0) endif call disable_averaging(CS%diag) @@ -3441,9 +3435,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostics for values prior to diabatic and prior to ALE CS%id_u_predia = register_diag_field('ocean_model', 'u_predia', diag%axesCuL, Time, & - 'Zonal velocity before diabatic forcing', 'm s-1') + 'Zonal velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_predia = register_diag_field('ocean_model', 'v_predia', diag%axesCvL, Time, & - 'Meridional velocity before diabatic forcing', 'm s-1') + 'Meridional velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_h_predia = register_diag_field('ocean_model', 'h_predia', diag%axesTL, Time, & 'Layer Thickness before diabatic forcing', thickness_units, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2f51d22b91..79c1b744f0 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -75,8 +75,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields From e35c52af1b93fa10e182a709755ed4aec00c9693 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 09:04:08 -0400 Subject: [PATCH 070/104] +Added optional vel_scale argument to MOM_state_chksum_5arg Added an optional velocity rescaling argument, vel_scale, to MOM_state_chksum_5arg. All answers are bitwise identical. --- src/core/MOM.F90 | 12 ++++++------ src/core/MOM_checksum_packages.F90 | 18 +++++++++++------- src/core/MOM_dynamics_split_RK2.F90 | 18 +++++++++--------- src/core/MOM_dynamics_unsplit.F90 | 8 ++++---- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- src/core/MOM_variables.F90 | 4 ++-- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- .../vertical/MOM_diabatic_driver.F90 | 8 ++++---- 8 files changed, 41 insertions(+), 37 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 13dcc7dcce..20ccc33694 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -1179,7 +1179,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) - ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) + ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) @@ -1225,7 +1225,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1252,7 +1252,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) @@ -1272,7 +1272,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & - ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) + ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1, vel_scale=1.0) 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, & diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 36d69a8179..e8347881f7 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -39,15 +39,15 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, vel_scale) character(len=*), & intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -60,17 +60,21 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computational domain. + real, optional, intent(in) :: vel_scale !< The scaling factor to convert velocities to [m s-1] - integer :: is, ie, js, je, nz, hs + real :: scale_vel ! The scaling factor to convert velocities to [m s-1] logical :: sym + integer :: is, ie, js, je, nz, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ! 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//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym) + hs = 1 ; if (present(haloshift)) hs=haloshift + sym = .false. ; if (present(symmetric)) sym=symmetric + scale_vel = US%L_T_to_m_s ; if (present(vel_scale)) scale_vel = vel_scale + + call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, scale=scale_vel) call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 4440e2fe72..5cc361913b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -355,7 +355,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -568,11 +568,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & - symmetric=sym) + symmetric=sym, vel_scale=1.0) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) endif @@ -677,10 +677,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -772,7 +772,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -867,10 +867,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI,haloshift=1, symmetric=sym) + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 286aa96c77..7d06f3efb7 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -249,7 +249,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) endif ! diffu = horizontal viscosity terms (u,h) @@ -333,7 +333,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -400,7 +400,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -484,7 +484,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index c3faabf8ba..afc2bf3a29 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -260,7 +260,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) endif ! diffu = horizontal viscosity terms (u,h) @@ -361,7 +361,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) ! 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) @@ -423,7 +423,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index fc5118a448..33797198a5 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -164,8 +164,8 @@ module MOM_variables PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] - du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] - dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [m s-2] + du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [L T-2 ~> m s-2] + dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() !< Zonal velocity changes due to any other processes that are !! not due to any explicit accelerations [m s-1]. diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 211e8d7741..9662eb0985 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*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) * & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 52dfe4f845..0d977319e5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2012,7 +2012,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] real :: Idt ! The inverse time step [s-1] - real :: Idt_accel ! The inverse time step times rescaling factors [m T L-1 s-2 ~> s-1] + real :: Idt_accel ! The inverse time step times rescaling factors [T-1 ~> s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. @@ -2768,7 +2768,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) endif call cpu_clock_begin(id_clock_tridiag) - Idt_accel = US%L_T_to_m_s / dt + Idt_accel = 1.0 / dt_in_T !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq @@ -3375,9 +3375,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%id_wd > 0) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & - 'Zonal Acceleration from Diapycnal Mixing', 'm s-2') + 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & - 'Meridional Acceleration from Diapycnal Mixing', 'm s-2') + 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model','cn1', diag%axesT1, & From 9fa6d390ced46022abff47e39d9be394468372da Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 09:56:24 -0400 Subject: [PATCH 071/104] +Pass velocities to set_viscous_BBL in [L T-1] Passed the velocity arguments to set_viscous_BBL and ALE_main in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in public interfaces have changed. --- src/ALE/MOM_ALE.F90 | 22 +++++----- src/core/MOM.F90 | 44 ++++++++++--------- .../vertical/MOM_set_viscosity.F90 | 18 ++++---- 3 files changed, 43 insertions(+), 41 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index b9aedb7a1c..33b498a60a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -307,8 +307,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [L T-1 ~> m s-1] 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 @@ -639,16 +639,16 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, 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 + intent(inout) :: h !< Original thicknesses [H ~> m or kg-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)), & - intent(inout) :: u !< Zonal velocity + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] type(tracer_registry_type), & optional, pointer :: Reg !< Tracer registry to remap onto new grid - real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding + real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding [s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions logical, optional, intent(in) :: initial !< Whether we're being called from an initialization @@ -732,11 +732,11 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, optional, intent(in) :: dxInterface !< Change in interface position !! [H ~> m or kg-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(inout) :: u !< Zonal velocity component [m s-1] + 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 component [m s-1] - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + 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 ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -900,7 +900,7 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid !! [H ~> m or kg-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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid !! [H ~> m or kg-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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 20ccc33694..89be275d70 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -940,7 +940,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(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, & + call set_viscous_BBL(US%m_s_to_L_T*CS%u(:,:,:), US%m_s_to_L_T*CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") @@ -1155,6 +1155,14 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & use_ice_shelf = .false. if (associated(fluxes%frac_shelf_h)) use_ice_shelf = .true. + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + call enable_averaging(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then @@ -1186,27 +1194,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo 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, Waves=Waves) fluxes%fluxes_used = .true. - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - call cpu_clock_end(id_clock_diabatic) - if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") ! Regridding/remapping is done here, at end of thermodynamics time step @@ -1225,7 +1217,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1252,7 +1244,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) @@ -1267,12 +1259,12 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, dtdia) if (CS%debug) then - call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) + call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & - ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1, vel_scale=1.0) + ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) 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, & @@ -1283,6 +1275,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call check_redundant("Post-diabatic ", u, v, G) endif call disable_averaging(CS%diag) + + call cpu_clock_end(id_clock_diabatic) else ! complement of "if (.not.CS%adiabatic)" call cpu_clock_begin(id_clock_diabatic) @@ -1305,6 +1299,14 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call disable_averaging(CS%diag) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if (showCallTree) call callTree_leave("step_MOM_thermo(), MOM.F90") end subroutine step_MOM_thermo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 26c0c41758..99e6d54683 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -111,9 +111,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -191,12 +191,12 @@ 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 m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H T 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 ! of the bottom [H ~> m or kg m-2]. - real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. + real :: v_at_u, u_at_v ! v at a u point or vice versa [L T-1 ~> m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. @@ -282,7 +282,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif if (CS%debug) then - call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1) + call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1) @@ -291,7 +291,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS OBC => CS%OBC - U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel + U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) @@ -521,7 +521,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt_Z*US%m_s_to_L_T*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif @@ -844,13 +844,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh*US%m_s_to_L_T*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh*US%m_s_to_L_T*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*sqrt(v(i,J,k)*v(i,J,k) + & u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif From 972f2cf0665fa7a668b9484942907cde9922bc12 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 11:18:01 -0400 Subject: [PATCH 072/104] +Pass velocities to step_MOM_thermo in [L T-1] Passed the velocity arguments to step_MOM_thermo in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM.F90 | 52 +++++++++++++++++++++++++++++++----------------- 1 file changed, 34 insertions(+), 18 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 89be275d70..c45d017036 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -644,11 +644,27 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & end_time_thermo = Time_local + real_to_time(dtdia-dt) endif + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") @@ -743,11 +759,27 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! by the call to step_MOM_thermo, noting that they end at the same time. if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia @@ -1127,9 +1159,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< meridional velocity [m s-1] + intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables @@ -1155,14 +1187,6 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & use_ice_shelf = .false. if (associated(fluxes%frac_shelf_h)) use_ice_shelf = .true. - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - call enable_averaging(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then @@ -1299,14 +1323,6 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call disable_averaging(CS%diag) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if (showCallTree) call callTree_leave("step_MOM_thermo(), MOM.F90") end subroutine step_MOM_thermo From ccdd50890d338c08b336fcf60526137efc637008 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 13:51:13 -0400 Subject: [PATCH 073/104] +Pass velocities to continuity in [L T-1] Passed the velocity arguments to continuity in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_continuity.F90 | 33 ++++----------------------- src/core/MOM_dynamics_split_RK2.F90 | 24 +++++++++++++++---- src/core/MOM_dynamics_unsplit.F90 | 8 ++++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 7 +++--- 4 files changed, 33 insertions(+), 39 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 47dcf3d365..7e8d2d1843 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -44,9 +44,9 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -80,23 +80,14 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocities that - !! give uhbt as the depth-integrated transport [m s-1]. + !! give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that - !! give vhbt as the depth-integrated transport [m s-1]. + !! 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. - ! Local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_tmp ! Rescaled version of u [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_tmp ! Rescaled version of V [L T-1 ~> m s-1] - integer :: is, ie, js, je, nz, stencil - integer :: i, j, k - - logical :: x_first - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & "MOM_continuity: Either both visc_rem_u and visc_rem_v or neither"// & " one must be present in call to continuity.") @@ -105,22 +96,8 @@ 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 - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_tmp(I,j,k) = US%m_s_to_L_T * u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_tmp(i,J,k) = US%m_s_to_L_T * v(i,J,k) - enddo ; enddo ; enddo - - call continuity_PPM(u_tmp, v_tmp, 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_CSp, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) - - if (present(u_cor)) then ; do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_cor(I,j,k) = US%L_T_to_m_s * u_cor(I,j,k) - enddo ; enddo ; enddo ; endif - if (present(v_cor)) then ; do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_cor(i,J,k) = US%L_T_to_m_s * v_cor(i,J,k) - enddo ; enddo ; enddo ; endif else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 5cc361913b..834ebeb3c5 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -518,8 +518,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, 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(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & + OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -606,9 +606,16 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_continuity) if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") @@ -810,8 +817,15 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*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) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo 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 @@ -1175,7 +1189,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 h_tmp(:,:,:) = h(:,:,:) - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) else diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 7d06f3efb7..0b0b58212d 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -263,7 +263,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -354,7 +354,8 @@ 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(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -417,7 +418,8 @@ 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(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index afc2bf3a29..62c66cbb39 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -279,7 +279,8 @@ 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(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -350,7 +351,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(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -407,7 +408,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(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_in, h_in, uh, vh,dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) From a7e54908b717af5822f83f108ff2a6d3e4291760 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 14:30:38 -0400 Subject: [PATCH 074/104] +Pass velocities to CorAdCalc in [L T-1] Passed the velocity arguments to CorAdCalc and horizontal_viscosity in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_CoriolisAdv.F90 | 19 +- src/core/MOM_dynamics_split_RK2.F90 | 8 +- src/core/MOM_dynamics_split_RK2.F90.bad1 | 1319 +++++++++++++++++ src/core/MOM_dynamics_unsplit.F90 | 8 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- .../lateral/MOM_hor_visc.F90 | 19 +- 6 files changed, 1336 insertions(+), 43 deletions(-) create mode 100644 src/core/MOM_dynamics_split_RK2.F90.bad1 diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e57850e82c..e044ea5f6d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -108,11 +108,11 @@ module MOM_CoriolisAdv contains !> Calculates the Coriolis and momentum advection contributions to the acceleration. -subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) +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 type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_in !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_in !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -127,10 +127,6 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv - !### Temporary variables that will be removed later. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. - ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. @@ -262,15 +258,6 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC) do k=1,nz - !## This is temporary code until the input velocities have been dimensionally rescaled. - do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 - u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo - do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 - v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo - - ! Here the second order accurate layer potential vorticities, q, ! are calculated. hq is second order accurate in space. Relative ! vorticity is second order accurate everywhere with free slip b.c.s, diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 834ebeb3c5..12c2dfb386 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -439,7 +439,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! 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, & + call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, Gv, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -694,7 +694,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! 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, & + call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) call cpu_clock_end(id_clock_horvisc) @@ -702,7 +702,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! 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, & + call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1163,7 +1163,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, & + call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) else diff --git a/src/core/MOM_dynamics_split_RK2.F90.bad1 b/src/core/MOM_dynamics_split_RK2.F90.bad1 new file mode 100644 index 0000000000..8064680d90 --- /dev/null +++ b/src/core/MOM_dynamics_split_RK2.F90.bad1 @@ -0,0 +1,1319 @@ +!> Time step the adiabatic dynamic core of MOM using RK2 method. +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 : 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 + +use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT +use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE +use MOM_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr +use MOM_diag_mediator, only : register_diag_field, register_static_field +use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids +use MOM_domains, only : MOM_domains_init +use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR +use MOM_domains, only : To_North, To_East, Omit_Corners +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : start_group_pass, complete_group_pass, pass_var +use MOM_debugging, only : hchksum, uvchksum +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery +use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_get_input, only : directories +use MOM_io, only : MOM_io_init, vardesc, var_desc +use MOM_restart, only : register_restart_field, query_initialized, save_restart +use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) +use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) + +use MOM_ALE, only : ALE_CS +use MOM_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source +use MOM_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_CS +use MOM_boundary_update, only : update_OBC_data, update_OBC_CS +use MOM_continuity, only : continuity, continuity_init, continuity_CS +use MOM_continuity, only : continuity_stencil +use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS +use MOM_debugging, only : check_redundant +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS +use MOM_interface_heights, only : find_eta +use MOM_lateral_mixing_coeffs, only : VarMix_CS +use MOM_MEKE_types, only : MEKE_type +use MOM_open_boundary, only : ocean_OBC_type, radiation_open_bdry_conds +use MOM_open_boundary, only : open_boundary_zero_normal_flow +use MOM_open_boundary, only : open_boundary_test_extern_h +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_remnant +use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS +use MOM_vert_friction, only : updateCFLtruncationValue +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units +use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units +use MOM_wave_interface, only: wave_parameters_CS + +implicit none ; private + +#include + +!> MOM_dynamics_split_RK2 module control structure +type, public :: MOM_dyn_split_RK2_CS ; private + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] + + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] + + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u + !< Both the fraction of the zonal momentum originally in a + !! layer that remains after a time-step of viscosity, and the + !! fraction of a time-step worth of a barotropic acceleration + !! that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above). + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt + !< The zonal layer accelerations due to the difference between + !! the barotropic accelerations and the baroclinic accelerations + !! that were fed into the barotopic calculation [m s-2] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v + !< Both the fraction of the meridional momentum originally in + !! a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step worth of a barotropic acceleration + !! that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above). + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt + !< The meridional layer accelerations due to the difference between + !! the barotropic accelerations and the baroclinic accelerations + !! that were fed into the barotopic calculation [m s-2] + + ! The following variables are only used with the split time stepping scheme. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq + !! mode) or column mass anomaly (in non-Boussinesq + !! mode) [H ~> m or kg m-2] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep [L T-1 ~> m s-1] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep [L T-1 ~> m s-1] + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer + !! thicknesses [H ~> m or kg m-2] + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and + !! PFv [H ~> m or kg m-2] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. + !! uhbt is roughly equal to the vertical sum of uh. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. + !! vhbt is roughly equal to vertical sum of vh. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure + !! anomaly in each layer due to free surface height + !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. + + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] + type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the + !! effective summed open face areas as a function + !! of barotropic flow. + + ! This is to allow the previous, velocity-based coupling with between the + ! baroclinic and barotropic modes. + logical :: BT_use_layer_fluxes !< If true, use the summed layered fluxes plus + !! an adjustment due to a changed barotropic + !! velocity in the barotropic continuity equation. + logical :: split_bottom_stress !< If true, provide the bottom stress + !! calculated by the vertical viscosity to the + !! barotropic solver. + logical :: calc_dtbt !< If true, calculate the barotropic time-step + !! dynamically. + + real :: be !< A nondimensional number from 0.5 to 1 that controls + !! the backward weighting of the time stepping scheme. + 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. + 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. + + !>@{ Diagnostic IDs + integer :: id_uh = -1, id_vh = -1 + integer :: id_umo = -1, id_vmo = -1 + integer :: id_umo_2d = -1, id_vmo_2d = -1 + integer :: id_PFu = -1, id_PFv = -1 + integer :: id_CAu = -1, id_CAv = -1 + + ! Split scheme only. + integer :: id_uav = -1, id_vav = -1 + integer :: id_u_BT_accel = -1, id_v_BT_accel = -1 + !!@} + + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + type(accel_diag_ptrs), pointer :: ADp !< A structure pointing to the various + !! accelerations in the momentum equations, + !! which can later be used to calculate + !! derived diagnostics like energy budgets. + type(cont_diag_ptrs), pointer :: CDp !< A structure with pointers to various + !! terms in the continuity equations, + !! which can later be used to calculate + !! derived diagnostics like energy budgets. + + ! 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() + !> 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() + !> 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() + !> 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 tidal forcing control structure + type(tidal_forcing_CS), pointer :: tides_CSp => NULL() + !> A pointer to the ALE control structure. + type(ALE_CS), pointer :: ALE_CSp => NULL() + + type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary + !! condition type that specifies whether, where, and what open boundary + !! conditions are used. If no open BCs are used, this pointer stays + !! nullified. Flather OBCs use open boundary_CS as well. + !> A pointer to the update_OBC control structure + type(update_OBC_CS), pointer :: update_OBC_CSp => NULL() + + type(group_pass_type) :: pass_eta !< Structure for group halo pass + type(group_pass_type) :: pass_visc_rem !< Structure for group halo pass + type(group_pass_type) :: pass_uvp !< Structure for group halo pass + type(group_pass_type) :: pass_hp_uv !< Structure for group halo pass + type(group_pass_type) :: pass_uv !< Structure for group halo pass + type(group_pass_type) :: pass_h !< Structure for group halo pass + type(group_pass_type) :: pass_av_uvh !< Structure for group halo pass + +end type MOM_dyn_split_RK2_CS + + +public step_MOM_dyn_split_RK2 +public register_restarts_dyn_split_RK2 +public initialize_dyn_split_RK2 +public end_dyn_split_RK2 + +!>@{ CPU time clock IDs +integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc +integer :: id_clock_horvisc, id_clock_mom_update +integer :: id_clock_continuity, id_clock_thick_diff +integer :: id_clock_btstep, id_clock_btcalc, id_clock_btforce +integer :: id_clock_pass, id_clock_pass_init +!!@} + +contains + +!> 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: v !< merid velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type + type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related + type(time_type), intent(in) :: Time_local !< model time at end of time step + real, intent(in) :: dt !< time step [s] + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic + !! time step [Pa] + real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic + !! time step [Pa] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + !! since last tracer advection [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< accumulatated merid volume/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 + !! 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 + !! interface height diffusivities + type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing + !! fields related to the surface wave conditions + + ! local variables + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel + ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each + ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in + ! 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]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj + ! u_adj and v_adj are the zonal or meridional velocities after u and v + ! have been barotropically adjusted so the resulting transports match + ! uhbt_out and vhbt_out [m s-1]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC + ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are + ! saved for use in the Flather open boundary condition code [m s-1]. + + real :: Pa_to_eta ! A factor that converts pressures to the units of eta. + real, pointer, dimension(:,:) :: & + p_surf => NULL(), eta_PF_start => NULL(), & + taux_bot => NULL(), tauy_bot => NULL(), & + eta => NULL() + + real, pointer, dimension(:,:,:) :: & + uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & + u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. + 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 :: Idt + logical :: dyn_p_surf + logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the + ! relative weightings of the layers in calculating + ! the barotropic accelerations. + !---For group halo pass + logical :: showCallTree, sym + + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: cont_stencil + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta + Idt = 1.0 / dt + + sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums + + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") + + !$OMP parallel do default(shared) + do k = 1, nz + do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo + do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo + do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo + enddo + + ! Update CFL truncation value as function of time + call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) + + if (CS%debug) then + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call check_redundant("Start predictor u ", u, v, G) + call check_redundant("Start predictor uh ", uh, vh, G) + endif + + dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) + if (dyn_p_surf) then + p_surf => p_surf_end + call safe_alloc_ptr(eta_PF_start,G%isd,G%ied,G%jsd,G%jed) + eta_PF_start(:,:) = 0.0 + else + p_surf => forces%p_surf + endif + + if (associated(CS%OBC)) then + if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) + + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) + enddo ; enddo ; enddo + endif + + BT_cont_BT_thick = .false. + if (associated(CS%BT_cont)) BT_cont_BT_thick = & + (allocated(CS%BT_cont%h_u) .and. allocated(CS%BT_cont%h_v)) + + if (CS%split_bottom_stress) then + taux_bot => CS%taux_bot ; tauy_bot => CS%tauy_bot + endif + + !--- begin set up for group halo pass + + cont_stencil = continuity_stencil(CS%continuity_CSp) + !### Apart from circle_OBCs halo for eta could be 1, but halo>=3 is required + !### to match circle_OBCs solutions. Why? + call cpu_clock_begin(id_clock_pass) + call create_group_pass(CS%pass_eta, eta, G%Domain) !### , halo=1) + call create_group_pass(CS%pass_visc_rem, CS%visc_rem_u, CS%visc_rem_v, G%Domain, & + To_All+SCALAR_PAIR, CGRID_NE, halo=max(1,cont_stencil)) + call create_group_pass(CS%pass_uvp, up, vp, G%Domain, halo=max(1,cont_stencil)) + call create_group_pass(CS%pass_hp_uv, hp, G%Domain, halo=2) + call create_group_pass(CS%pass_hp_uv, u_av, v_av, G%Domain, halo=2) + call create_group_pass(CS%pass_hp_uv, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) + + call create_group_pass(CS%pass_uv, u, v, G%Domain, halo=max(2,cont_stencil)) + call create_group_pass(CS%pass_h, h, G%Domain, halo=max(2,cont_stencil)) + call create_group_pass(CS%pass_av_uvh, u_av, v_av, G%Domain, halo=2) + call create_group_pass(CS%pass_av_uvh, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) + call cpu_clock_end(id_clock_pass) + !--- end set up for group halo pass + + +! PFu = d/dx M(h,T,S) +! pbce = dM/deta + if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) + call cpu_clock_begin(id_clock_pres) + call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & + CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) + if (dyn_p_surf) then + Pa_to_eta = 1.0 / GV%H_to_Pa + !$OMP parallel do default(shared) + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + eta_PF_start(i,j) = CS%eta_PF(i,j) - Pa_to_eta * & + (p_surf_begin(i,j) - p_surf_end(i,j)) + enddo ; enddo + endif + call cpu_clock_end(id_clock_pres) + call disable_averaging(CS%diag) + if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)") + + if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) + endif; endif + if (associated(CS%OBC) .and. CS%debug_OBC) & + call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) + + if (G%nonblocking_updates) & + call start_group_pass(CS%pass_eta, G%Domain, clock=id_clock_pass) + +! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av + call cpu_clock_begin(id_clock_Cor) + call CorAdCalc(US%L_T_to_m_s*u_av, US%L_T_to_m_s*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + G, Gv, US, CS%CoriolisAdv_CSp) + call cpu_clock_end(id_clock_Cor) + if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + +! u_bc_accel = CAu + PFu + diffu(u[n-1]) + call cpu_clock_begin(id_clock_btforce) + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) + enddo ; enddo + enddo + if (associated(CS%OBC)) then + call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) + endif + call cpu_clock_end(id_clock_btforce) + + if (CS%debug) then + call MOM_accel_chksum("pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & + symmetric=sym) + call check_redundant("pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) + call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) + call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) + call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + endif + + call cpu_clock_begin(id_clock_vertvisc) + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) + enddo ; enddo + enddo + + call enable_averaging(dt, Time_local, CS%diag) + call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & + CS%set_visc_CSp) + call disable_averaging(CS%diag) + + if (CS%debug) then + call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) + endif + call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) + call cpu_clock_end(id_clock_vertvisc) + if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") + + + call cpu_clock_begin(id_clock_pass) + if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_eta, G%Domain) + call start_group_pass(CS%pass_visc_rem, G%Domain) + else + call do_group_pass(CS%pass_eta, G%Domain) + call do_group_pass(CS%pass_visc_rem, G%Domain) + endif + call cpu_clock_end(id_clock_pass) + + call cpu_clock_begin(id_clock_btcalc) + ! Calculate the relative layer weights for determining barotropic quantities. + if (.not.BT_cont_BT_thick) & + call btcalc(h, G, GV, CS%barotropic_CSp, OBC=CS%OBC) + call bt_mass_source(h, eta, .true., G, GV, CS%barotropic_CSp) + call cpu_clock_end(id_clock_btcalc) + + if (G%nonblocking_updates) & + call complete_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) + +! 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 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, & + OBC=CS%OBC) + endif + if (showCallTree) call callTree_wayPoint("done with continuity[BT_cont] (step_MOM_dyn_split_RK2)") + endif + + if (CS%BT_use_layer_fluxes) then + uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + endif + + u_init => u ; v_init => v + call cpu_clock_begin(id_clock_btstep) + 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, & + US%L_T_to_m_s*u_av, US%L_T_to_m_s*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, & + 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) + if (showCallTree) call callTree_leave("btstep()") + call cpu_clock_end(id_clock_btstep) + +! up = u + dt_pred*( u_bc_accel + u_accel_bt ) + dt_pred = dt * CS%be + call cpu_clock_begin(id_clock_mom_update) + + !$OMP parallel do default(shared) + do k=1,nz + do J=Jsq,Jeq ; do i=is,ie + vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + enddo ; enddo + do j=js,je ; do I=Isq,Ieq + up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + enddo ; enddo + enddo + call cpu_clock_end(id_clock_mom_update) + + if (CS%debug) then + call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) + call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) + call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) + call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) + call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & + symmetric=sym, vel_scale=1.0) + call check_redundant("Predictor 1 up", up, vp, G) + call check_redundant("Predictor 1 uh", uh, vh, G) + endif + +! up <- up + dt_pred d/dz visc d/dz up +! u_av <- u_av + dt_pred d/dz visc d/dz u_av + call cpu_clock_begin(id_clock_vertvisc) + if (CS%debug) then + call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) + endif + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + CS%OBC) + call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") + if (G%nonblocking_updates) then + call cpu_clock_end(id_clock_vertvisc) + call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) + call cpu_clock_begin(id_clock_vertvisc) + endif + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) + call cpu_clock_end(id_clock_vertvisc) + + call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) + if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) + else + call do_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) + endif + + ! 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, & + 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)") + + call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) + + if (associated(CS%OBC)) then + + if (CS%debug) & + call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + + !### Remove this later + u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) + v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + !### Remove this later + u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) + v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) + + if (CS%debug) & + call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + + ! These should be done with a pass that excludes uh & vh. +! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) + endif + + if (G%nonblocking_updates) then + call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + endif + + ! h_av = (h + hp)/2 + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 + h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) + enddo ; enddo ; enddo + + ! The correction phase of the time step starts here. + call enable_averaging(dt, Time_local, CS%diag) + + ! Calculate a revised estimate of the free-surface height correction to be + ! used in the next call to btstep. This call is at this point so that + ! hp can be changed if CS%begw /= 0. + ! eta_cor = ... (hidden inside CS%barotropic_CSp) + call cpu_clock_begin(id_clock_btcalc) + call bt_mass_source(hp, eta_pred, .false., G, GV, CS%barotropic_CSp) + call cpu_clock_end(id_clock_btcalc) + + if (CS%begw /= 0.0) then + ! hp <- (1-begw)*h_in + begw*hp + ! Back up hp to the value it would have had after a time-step of + ! begw*dt. hp is not used again until recalculated by continuity. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + hp(i,j,k) = (1.0-CS%begw)*h(i,j,k) + CS%begw*hp(i,j,k) + enddo ; enddo ; enddo + + ! PFu = d/dx M(hp,T,S) + ! pbce = dM/deta + call cpu_clock_begin(id_clock_pres) + call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & + CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) + call cpu_clock_end(id_clock_pres) + if (showCallTree) call callTree_wayPoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)") + endif + + if (G%nonblocking_updates) & + call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + + if (BT_cont_BT_thick) then + call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & + OBC=CS%OBC) + if (showCallTree) call callTree_wayPoint("done with btcalc[BT_cont_BT_thick] (step_MOM_dyn_split_RK2)") + endif + + if (CS%debug) then + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US,) + call check_redundant("Predictor up ", up, vp, G) + call check_redundant("Predictor uh ", uh, vh, G) + endif + +! diffu = horizontal viscosity terms (u_av) + call cpu_clock_begin(id_clock_horvisc) + call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & + MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & + OBC=CS%OBC, BT=CS%barotropic_CSp) + call cpu_clock_end(id_clock_horvisc) + if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") + +! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av + call cpu_clock_begin(id_clock_Cor) + call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + G, GV, US, CS%CoriolisAdv_CSp) + call cpu_clock_end(id_clock_Cor) + if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + +! Calculate the momentum forcing terms for the barotropic equations. + +! u_bc_accel = CAu + PFu + diffu(u[n-1]) + call cpu_clock_begin(id_clock_btforce) + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) + enddo ; enddo + enddo + if (associated(CS%OBC)) then + call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) + endif + call cpu_clock_end(id_clock_btforce) + + if (CS%debug) then + call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & + symmetric=sym) + call check_redundant("corr pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) + call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) + call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) + call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + endif + + ! u_accel_bt = layer accelerations due to barotropic solver + ! pbce = dM/deta + call cpu_clock_begin(id_clock_btstep) + if (CS%BT_use_layer_fluxes) then + !### Remove this later + u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) ; v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) + uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av + endif + + 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, 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) + do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo + call cpu_clock_end(id_clock_btstep) + if (showCallTree) call callTree_leave("btstep()") + + if (CS%BT_use_layer_fluxes) then + !### Remove this later + u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) ; v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) + endif + + if (CS%debug) then + call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G) + endif + + ! u = u + dt*( u_bc_accel + u_accel_bt ) + call cpu_clock_begin(id_clock_mom_update) + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + enddo ; enddo + enddo + call cpu_clock_end(id_clock_mom_update) + + if (CS%debug) then + call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) + call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) + call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) + call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & + symmetric=sym) + endif + + ! u <- u + dt d/dz visc d/dz u + ! u_av <- u_av + dt d/dz visc d/dz u_av + call cpu_clock_begin(id_clock_vertvisc) + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & + CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) + if (G%nonblocking_updates) then + call cpu_clock_end(id_clock_vertvisc) + call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) + call cpu_clock_begin(id_clock_vertvisc) + endif + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) + call cpu_clock_end(id_clock_vertvisc) + if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") + +! Later, h_av = (h_in + h_out)/2, but for now use h_av to store h_in. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 + h_av(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + + call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) + if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) + else + call do_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) + endif + + ! uh = u_av * h + ! 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 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 + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") + + if (G%nonblocking_updates) then + call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + else + call do_group_pass(CS%pass_av_uvh, G%domain, clock=id_clock_pass) + endif + + if (associated(CS%OBC)) then + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) + endif + +! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 + h_av(i,j,k) = 0.5*(h_av(i,j,k) + h(i,j,k)) + enddo ; enddo ; enddo + + if (G%nonblocking_updates) & + call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + + !$OMP parallel do default(shared) + do k=1,nz + do j=js-2,je+2 ; do I=Isq-2,Ieq+2 + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt + enddo ; enddo + do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt + enddo ; enddo + enddo + + ! The time-averaged free surface height has already been set by the last + ! call to btstep. + + ! Here various terms used in to update the momentum equations are + ! offered for time averaging. + if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) + if (CS%id_PFv > 0) call post_data(CS%id_PFv, CS%PFv, CS%diag) + if (CS%id_CAu > 0) call post_data(CS%id_CAu, CS%CAu, CS%diag) + if (CS%id_CAv > 0) call post_data(CS%id_CAv, CS%CAv, CS%diag) + + ! Here the thickness fluxes are offered for time averaging. + if (CS%id_uh > 0) call post_data(CS%id_uh , uh, CS%diag) + if (CS%id_vh > 0) call post_data(CS%id_vh , vh, CS%diag) + if (CS%id_uav > 0) call post_data(CS%id_uav, u_av, CS%diag) + if (CS%id_vav > 0) call post_data(CS%id_vav, v_av, CS%diag) + 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) + + if (CS%debug) then + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) + endif + + if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") + +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 +!! 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 + 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] + 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] + + type(vardesc) :: vd + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. + character(len=48) :: thickness_units, flux_units + + integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB + + ! This is where a control structure specific to this module would be allocated. + if (associated(CS)) then + call MOM_error(WARNING, "register_restarts_dyn_split_RK2 called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ALLOC_(CS%diffu(IsdB:IedB,jsd:jed,nz)) ; CS%diffu(:,:,:) = 0.0 + ALLOC_(CS%diffv(isd:ied,JsdB:JedB,nz)) ; CS%diffv(:,:,:) = 0.0 + ALLOC_(CS%CAu(IsdB:IedB,jsd:jed,nz)) ; CS%CAu(:,:,:) = 0.0 + ALLOC_(CS%CAv(isd:ied,JsdB:JedB,nz)) ; CS%CAv(:,:,:) = 0.0 + ALLOC_(CS%PFu(IsdB:IedB,jsd:jed,nz)) ; CS%PFu(:,:,:) = 0.0 + ALLOC_(CS%PFv(isd:ied,JsdB:JedB,nz)) ; CS%PFv(:,:,:) = 0.0 + + ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 + ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 + ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 + ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H + + thickness_units = get_thickness_units(GV) + flux_units = get_flux_units(GV) + + if (GV%Boussinesq) then + vd = var_desc("sfc",thickness_units,"Free surface Height",'h','1') + else + vd = var_desc("p_bot",thickness_units,"Bottom Pressure",'h','1') + endif + call register_restart_field(CS%eta, vd, .false., restart_CS) + + vd = var_desc("u2","m s-1","Auxiliary Zonal velocity",'u','L') + call register_restart_field(CS%u_av, vd, .false., restart_CS) + + vd = var_desc("v2","m s-1","Auxiliary Meridional velocity",'v','L') + call register_restart_field(CS%v_av, vd, .false., restart_CS) + + vd = var_desc("h2",thickness_units,"Auxiliary Layer Thickness",'h','L') + call register_restart_field(CS%h_av, vd, .false., restart_CS) + + vd = var_desc("uh",flux_units,"Zonal thickness flux",'u','L') + call register_restart_field(uh, vd, .false., restart_CS) + + vd = var_desc("vh",flux_units,"Meridional thickness flux",'v','L') + call register_restart_field(vh, vd, .false., restart_CS) + + vd = var_desc("diffu","m s-2","Zonal horizontal viscous acceleration",'u','L') + call register_restart_field(CS%diffu, vd, .false., restart_CS) + + vd = var_desc("diffv","m s-2","Meridional horizontal viscous acceleration",'v','L') + call register_restart_field(CS%diffv, vd, .false., restart_CS) + + call register_barotropic_restarts(HI, GV, param_file, CS%barotropic_CSp, & + restart_CS) + +end subroutine register_restarts_dyn_split_RK2 + +!> This subroutine initializes all of the variables that are used by this +!! dynamic core, including diagnostics and the cpu clocks. +subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & + 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) + 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_(G)), & + intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< merid velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] + type(time_type), target, intent(in) :: Time !< current model time + 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 + real, intent(in) :: dt !< time step [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(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(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 + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. + 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 :: 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 :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. + real :: H_convert + type(group_pass_type) :: pass_av_h_uvh + logical :: use_tides, debug_truncations + + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: IsdB, IedB, JsdB, JedB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 + + if (.not.associated(CS)) call MOM_error(FATAL, & + "initialize_dyn_split_RK2 called with an unassociated control structure.") + if (CS%module_is_initialized) then + call MOM_error(WARNING, "initialize_dyn_split_RK2 called with a control "// & + "structure that has already been initialized.") + return + endif + CS%module_is_initialized = .true. + + CS%diag => diag + + call get_param(param_file, mdl, "TIDES", use_tides, & + "If true, apply tidal momentum forcing.", default=.false.) + call get_param(param_file, mdl, "BE", CS%be, & + "If SPLIT is true, BE determines the relative weighting "//& + "of a 2nd-order Runga-Kutta baroclinic time stepping "//& + "scheme (0.5) and a backward Euler scheme (1) that is "//& + "used for the Coriolis and inertial terms. BE may be "//& + "from 0.5 to 1, but instability may occur near 0.5. "//& + "BE is also applicable if SPLIT is false and USE_RK2 "//& + "is true.", units="nondim", default=0.6) + call get_param(param_file, mdl, "BEGW", CS%begw, & + "If SPLIT is true, BEGW is a 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. "//& + "If SPLIT is false and USE_RK2 is true, BEGW can be "//& + "between 0 and 0.5 to damp gravity waves.", & + units="nondim", default=0.0) + + call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & + "If true, provide the bottom stress calculated by the "//& + "vertical viscosity to the barotropic solver.", default=.false.) + call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & + "If true, use the summed layered fluxes plus an "//& + "adjustment due to the change in the barotropic velocity "//& + "in the barotropic continuity equation.", default=.true.) + call get_param(param_file, mdl, "DEBUG", CS%debug, & + "If true, write out verbose debugging data.", & + default=.false., debuggingParam=.true.) + call get_param(param_file, mdl, "DEBUG_OBC", CS%debug_OBC, default=.false.) + call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & + default=.false.) + + allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 + allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + + ALLOC_(CS%uhbt(IsdB:IedB,jsd:jed)) ; CS%uhbt(:,:) = 0.0 + ALLOC_(CS%vhbt(isd:ied,JsdB:JedB)) ; CS%vhbt(:,:) = 0.0 + ALLOC_(CS%visc_rem_u(IsdB:IedB,jsd:jed,nz)) ; CS%visc_rem_u(:,:,:) = 0.0 + ALLOC_(CS%visc_rem_v(isd:ied,JsdB:JedB,nz)) ; CS%visc_rem_v(:,:,:) = 0.0 + ALLOC_(CS%eta_PF(isd:ied,jsd:jed)) ; CS%eta_PF(:,:) = 0.0 + ALLOC_(CS%pbce(isd:ied,jsd:jed,nz)) ; CS%pbce(:,:,:) = 0.0 + + ALLOC_(CS%u_accel_bt(IsdB:IedB,jsd:jed,nz)) ; CS%u_accel_bt(:,:,:) = 0.0 + ALLOC_(CS%v_accel_bt(isd:ied,JsdB:JedB,nz)) ; CS%v_accel_bt(:,:,:) = 0.0 + + MIS%diffu => CS%diffu + MIS%diffv => CS%diffv + MIS%PFu => CS%PFu + MIS%PFv => CS%PFv + MIS%CAu => CS%CAu + MIS%CAv => CS%CAv + MIS%pbce => CS%pbce + MIS%u_accel_bt => CS%u_accel_bt + MIS%v_accel_bt => CS%v_accel_bt + MIS%u_av => CS%u_av + MIS%v_av => CS%v_av + + CS%ADp => Accel_diag + CS%CDp => Cont_diag + Accel_diag%diffu => CS%diffu + Accel_diag%diffv => CS%diffv + Accel_diag%PFu => CS%PFu + Accel_diag%PFv => CS%PFv + Accel_diag%CAu => CS%CAu + Accel_diag%CAv => CS%CAv + +! Accel_diag%pbce => CS%pbce +! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt +! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av + + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & + CS%tides_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) + 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, & + activate=is_new_run(restart_CS) ) + + if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp + if (associated(OBC)) CS%OBC => OBC + if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp + + eta_rest_name = "sfc" ; if (.not.GV%Boussinesq) eta_rest_name = "p_bot" + if (.not. query_initialized(CS%eta, trim(eta_rest_name), restart_CS)) then + ! Estimate eta based on the layer thicknesses - h. With the Boussinesq + ! approximation, eta is the free surface height anomaly, while without it + ! eta is the mass of ocean per unit area. eta always has the same + ! dimensions as h, either m or kg m-3. + ! CS%eta(:,:) = 0.0 already from initialization. + if (GV%Boussinesq) then + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo + endif + do k=1,nz ; do j=js,je ; do i=is,ie + CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) + enddo ; enddo ; enddo + elseif ((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 j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo + endif + ! Copy eta into an output array. + do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo + + call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & + CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & + CS%tides_CSp) + + 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, & + OBC=CS%OBC, BT=CS%barotropic_CSp) + elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then + accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) + enddo ; enddo ; enddo + endif + + if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & + .not. query_initialized(CS%u_av,"v2", restart_CS)) then + CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) + CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) + elseif ( (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) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%u_av(i,J,k) = vel_rescale * CS%u_av(i,J,k) + enddo ; enddo ; enddo + endif + + ! This call is just here to initialize uh and vh. + if (.not. query_initialized(uh,"uh",restart_CS) .or. & + .not. query_initialized(vh,"vh",restart_CS)) then + h_tmp(:,:,:) = h(:,:,:) + call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) + CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) + else + if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then + CS%h_av(:,:,:) = h(:,:,:) + elseif ((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 ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo + endif + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then + uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo + endif + endif + + call cpu_clock_begin(id_clock_pass_init) + call create_group_pass(pass_av_h_uvh, CS%u_av, CS%v_av, G%Domain, halo=2) + call create_group_pass(pass_av_h_uvh, CS%h_av, G%Domain, halo=2) + call create_group_pass(pass_av_h_uvh, uh, vh, G%Domain, halo=2) + call do_group_pass(pass_av_h_uvh, G%Domain) + call cpu_clock_end(id_clock_pass_init) + + flux_units = get_flux_units(GV) + H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 + CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & + 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & + conversion=H_convert*US%L_to_m**2*US%s_to_T) + CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & + 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & + conversion=H_convert*US%L_to_m**2*US%s_to_T) + + CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & + 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & + 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & + '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_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & + 'Barotropic-step Averaged Zonal Velocity', 'm s-1') + CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & + 'Barotropic-step Averaged Meridional Velocity', 'm s-1') + + CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & + 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & + 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + + id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) + id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) + id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=CLOCK_MODULE) + id_clock_vertvisc = cpu_clock_id('(Ocean vertical viscosity)', grain=CLOCK_MODULE) + id_clock_horvisc = cpu_clock_id('(Ocean horizontal viscosity)', grain=CLOCK_MODULE) + id_clock_mom_update = cpu_clock_id('(Ocean momentum increments)', grain=CLOCK_MODULE) + id_clock_pass = cpu_clock_id('(Ocean message passing)', grain=CLOCK_MODULE) + id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', grain=CLOCK_ROUTINE) + id_clock_btcalc = cpu_clock_id('(Ocean barotropic mode calc)', grain=CLOCK_MODULE) + id_clock_btstep = cpu_clock_id('(Ocean barotropic mode stepping)', grain=CLOCK_MODULE) + id_clock_btforce = cpu_clock_id('(Ocean barotropic forcing calc)', grain=CLOCK_MODULE) + +end subroutine initialize_dyn_split_RK2 + + +!> Close the dyn_split_RK2 module +subroutine end_dyn_split_RK2(CS) + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + + DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) + DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) + DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) + + if (associated(CS%taux_bot)) deallocate(CS%taux_bot) + if (associated(CS%tauy_bot)) deallocate(CS%tauy_bot) + DEALLOC_(CS%uhbt) ; DEALLOC_(CS%vhbt) + DEALLOC_(CS%u_accel_bt) ; DEALLOC_(CS%v_accel_bt) + DEALLOC_(CS%visc_rem_u) ; DEALLOC_(CS%visc_rem_v) + + DEALLOC_(CS%eta) ; DEALLOC_(CS%eta_PF) ; DEALLOC_(CS%pbce) + DEALLOC_(CS%h_av) ; DEALLOC_(CS%u_av) ; DEALLOC_(CS%v_av) + + call dealloc_BT_cont_type(CS%BT_cont) + + deallocate(CS) +end subroutine end_dyn_split_RK2 + + +!> \namespace mom_dynamics_split_rk2 +!! +!! This file time steps the adiabatic dynamic core by splitting +!! between baroclinic and barotropic modes. It uses a pseudo-second order +!! Runge-Kutta time stepping scheme for the baroclinic momentum +!! equation and a forward-backward coupling between the baroclinic +!! momentum and continuity equations. This split time-stepping +!! scheme is described in detail in Hallberg (JCP, 1997). Additional +!! issues related to exact tracer conservation and how to +!! ensure consistency between the barotropic and layered estimates +!! of the free surface height are described in Hallberg and +!! Adcroft (Ocean Modelling, 2009). This was the time stepping code +!! that is used for most GOLD applications, including GFDL's ESM2G +!! Earth system model, and all of the examples provided with the +!! MOM code (although several of these solutions are routinely +!! verified by comparison with the slower unsplit schemes). +!! +!! The subroutine step_MOM_dyn_split_RK2 actually does the time +!! stepping, while register_restarts_dyn_split_RK2 sets the fields +!! that are found in a full restart file with this scheme, and +!! initialize_dyn_split_RK2 initializes the cpu clocks that are +!! used in this module. For largely historical reasons, this module +!! does not have its own control structure, but shares the same +!! control structure with MOM.F90 and the other MOM_dynamics_... +!! modules. + +end module MOM_dynamics_split_RK2 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 0b0b58212d..ce39c5cf06 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -255,7 +255,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & + call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, Varmix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -299,7 +299,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, & + call CorAdCalc(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -367,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, & + call CorAdCalc(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -449,7 +449,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, & + call CorAdCalc(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 62c66cbb39..ad0ba9774f 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -266,7 +266,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! diffu = horizontal viscosity terms (u,h) call enable_averaging(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, & + call horizontal_viscosity(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -295,7 +295,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, & + call CorAdCalc(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -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, & + call CorAdCalc(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1fc98f111a..d94ed1f178 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -197,14 +197,14 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV, US, & +subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, & CS, OBC, BT) 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_(G)), & - intent(in) :: u_in !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v_in !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -224,10 +224,6 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing !! barotropic velocities. - !### Temporary variables that will be removed later. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. - ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] @@ -526,15 +522,6 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz - ! This is temporary code until the input velocities have been dimensionally rescaled. - do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 - u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo - do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 - v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo - - ! The following are the forms of the horizontal tension and horizontal ! shearing strain advocated by Smagorinsky (1993) and discussed in ! Griffies and Hallberg (2000). From 9d5855378692fb5fb06baf89197d7b8e0bf91a7f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 16:32:18 -0400 Subject: [PATCH 075/104] +Pass velocities to btstep in [L T-1] Passed the velocity arguments to btstep and barotropic_init in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_barotropic.F90 | 61 ++++++++++++++++------------- src/core/MOM_dynamics_split_RK2.F90 | 25 ++++++++---- 2 files changed, 51 insertions(+), 35 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b83e0c34da..b3b0b1925c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -241,7 +241,7 @@ module MOM_barotropic real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. real :: maxvel !< Velocity components greater than maxvel are - !! truncated to maxvel [m s-1]. + !! 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. @@ -389,8 +389,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal + !! velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over. @@ -407,9 +409,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! eta_PF_start is provided [H ~> m or kg m-2]. !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal-velocities used to - !! calculate the Coriolis terms in bc_accel_u [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due !! to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer @@ -446,10 +449,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! from ocean to the seafloor [Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] + real, dimension(:,:,:), optional, 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 !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate + !! vh0 [L T-1 ~> m s-1] ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -615,7 +620,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing ! squared [H L-2 ~> m-1 or kg m-4]. - real :: vel_tmp ! A temporary velocity [m s-1]. real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1]. real :: Htot ! The total thickness [H ~> m or kg m-2]. real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. @@ -914,11 +918,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is-1,ie+1 ; vbt_Cor(i,J) = 0.0 ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_Cor(I,j,k) + ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * U_Cor(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_Cor(i,J,k) + vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * V_Cor(i,J,k) enddo ; enddo ; enddo ! The gtot arrays are the effective layer-weighted reduced gravities for @@ -1026,23 +1030,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) - ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) - vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * v_vh0(i,J,k) enddo ; enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) - ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) + ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) - vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) + vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * v_vh0(i,J,k) enddo ; enddo ; enddo endif if (use_BT_cont) then @@ -1104,11 +1108,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_in(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * U_in(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_in(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie @@ -2377,16 +2381,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of !! the argument arrays. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [m s-1]. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in !! transport [L T-1 ~> m s-1]. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic velocity + !! [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in - !! transports [m s-1]. + !! transports [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or !! column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic @@ -3055,7 +3060,7 @@ function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1]. The result !! is not allowed to be dramatically larger than guess. - real :: ubt !< The result - The velocity that gives uhbt transport [m s-1]. + real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]. ! Local variables real :: ubt_min, ubt_max, uhbt_err, derr_du @@ -3391,12 +3396,12 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & G, US, MS, halo) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), & - intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. + intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & - intent(in) :: vbt !< The linearization meridional barotropic velocity [m s-1]. + intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -3701,9 +3706,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & @@ -4290,10 +4295,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call btcalc(h, G, GV, CS, may_use_default=.true.) CS%ubtav(:,:) = 0.0 ; CS%vbtav(:,:) = 0.0 do k=1,nz ; do j=js,je ; do I=is-1,ie - CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u(I,j,k) + CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * u(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie - CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v(i,J,k) + CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k) enddo ; enddo ; enddo elseif ((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 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 12c2dfb386..c5210ea081 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -529,7 +529,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%BT_use_layer_fluxes) then - uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + ! uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + uh_ptr => uh_in; vh_ptr => vh_in + call safe_alloc_ptr(u_ptr, G%IsdB,G%IedB,G%jsd,G%jed,G%ke) + call safe_alloc_ptr(v_ptr, G%isd,G%ied,G%JsdB,G%JedB,G%ke) + u_ptr(:,:,:) = US%m_s_to_L_T*u(:,:,:) + v_ptr(:,:,:) = US%m_s_to_L_T*v(:,:,:) endif u_init => u ; v_init => v @@ -537,8 +542,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & 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, & + call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & + US%m_s_to_L_T*u_av, US%m_s_to_L_T*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, & OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & @@ -739,19 +744,25 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! pbce = dM/deta call cpu_clock_begin(id_clock_btstep) if (CS%BT_use_layer_fluxes) then - uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av + uh_ptr => uh ; vh_ptr => vh ! ; u_ptr => u_av ; v_ptr => v_av + u_ptr(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) + v_ptr(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) endif 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, & + call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & + CS%eta_PF, US%m_s_to_L_T*u_av, US%m_s_to_L_T*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, 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) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo + + if (associated(u_ptr)) deallocate(u_ptr) + if (associated(v_ptr)) deallocate(v_ptr) + call cpu_clock_end(id_clock_btstep) if (showCallTree) call callTree_leave("btstep()") @@ -1157,7 +1168,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & + call barotropic_init(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%eta, Time, G, GV, US, param_file, diag, & CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) From 64f691cfdf108d7fc84ab1700bdee2d373759f4f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 18:36:49 -0400 Subject: [PATCH 076/104] +Pass velocities to set_viscous_ML in [L T-1] Passed the velocity arguments to set_viscous_ML in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 35 ++++++++++--------- 4 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c5210ea081..843aafaf44 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -482,7 +482,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & + call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, tv, forces, visc, dt, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index ce39c5cf06..9460a74a4f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & + call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index ad0ba9774f..1694544eff 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -338,7 +338,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 99e6d54683..92466266b8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -47,7 +47,7 @@ module MOM_set_visc real :: c_Smag !< The Laplacian Smagorinsky coefficient for !! calculating the drag in channels. real :: drag_bg_vel !< An assumed unresolved background velocity for - !! calculating the bottom drag [m s-1]. + !! calculating the bottom drag [L T-1 ~> m s-1]. real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2]. !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. @@ -1007,9 +1007,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -1024,6 +1024,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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)) :: & htot, & ! The total depth of the layers being that are within the @@ -1036,7 +1037,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. @@ -1066,7 +1067,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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 m s-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 :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m]. @@ -1077,8 +1078,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: S_lay ! The layer salinity at velocity points [ppt]. real :: Rlay ! The layer potential density at velocity points [kg m-3]. real :: Rlb ! The potential density of the layer below [kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point [m s-1]. - real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. + real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. + real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. @@ -1104,7 +1105,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the present layer [H ~> m or kg m-2]. real :: U_bg_sq ! The square of an assumed background velocity, for ! calculating the mean magnitude near the top for use in - ! the quadratic surface drag [m2 s-2]. + ! the quadratic surface drag [L2 T-2 ~> m2 s-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points [T-1 ~> s-1]. @@ -1134,7 +1135,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri endif ; endif Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H - U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel + U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) @@ -1204,8 +1205,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(I) = .true. ; do_any = .true. k_massive(I) = nkml Thtot(I) = 0.0 ; Shtot(I) = 0.0 ; Rhtot(i) = 0.0 - uhtot(I) = dt_Rho0 * forces%taux(I,j) - vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & + uhtot(I) = US%m_s_to_L_T*dt_Rho0 * forces%taux(I,j) + vhtot(I) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else @@ -1241,7 +1242,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i+1,j,k)) v_at_u = 0.5 * (h(i,j,k) * (v(i,J,k) + v(i,J-1,k)) + & h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k))) * I_2hlay - Uh2 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) + Uh2 = ((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) if (use_EOS) then T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i+1,j,k)*tv%T(i+1,j,k)) * I_2hlay @@ -1338,7 +1339,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z * US%m_s_to_L_T*hutot/hwtot + ustar(I) = cdrag_sqrt_Z * hutot/hwtot else ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif @@ -1439,8 +1440,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(i) = .true. ; do_any = .true. k_massive(i) = nkml Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; Rhtot(i) = 0.0 - vhtot(i) = dt_Rho0 * forces%tauy(i,J) - uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & + vhtot(i) = US%m_s_to_L_T*dt_Rho0 * forces%tauy(i,J) + uhtot(i) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & (forces%taux(I-1,j) + forces%taux(I,j+1))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else @@ -1478,7 +1479,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i,j+1,k)) u_at_v = 0.5 * (h(i,j,k) * (u(I-1,j,k) + u(I,j,k)) + & h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k))) * I_2hlay - Uh2 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) + Uh2 = ((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) if (use_EOS) then T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i,j+1,k)*tv%T(i,j+1,k)) * I_2hlay @@ -1575,7 +1576,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z * US%m_s_to_L_T*hutot/hwtot + ustar(i) = cdrag_sqrt_Z * hutot/hwtot else ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif From b74e2d3d80b589be24c404a30b1e19f966ca2a5b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 06:25:01 -0400 Subject: [PATCH 077/104] +Pass velocities to vertvisc_coef in [L T-1] Passed the velocity arguments to vertvisc_coef in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +++--- src/core/MOM_dynamics_unsplit.F90 | 6 +++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 843aafaf44..d8e6ad386b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif - call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -588,7 +588,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -799,7 +799,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 9460a74a4f..54471d53f2 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -344,7 +344,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) @@ -408,7 +408,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) @@ -479,7 +479,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 1694544eff..5f37ab63c2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) @@ -393,11 +393,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b0b2a88688..d517223f7d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -568,9 +568,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) 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)), & - intent(in) :: u !< Zonal velocity [m s-1] + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< Meridional velocity [m s-1] + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces From e15389d1a201fd41715130ede7b020f6f3275136 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 06:29:24 -0400 Subject: [PATCH 078/104] Code style modifications in wave_structure Made minor modifications in wave_structure to make it clear where array syntax is being used. Although the use of array syntax is discouraged in MOM6 with some specific exceptions, silent use of array syntax is strongly discouraged. All answers are bitwise identical. --- src/diagnostics/MOM_wave_structure.F90 | 28 ++++++++++++++------------ 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 796413b47c..ac28a8d012 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -131,7 +131,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. - real :: rescale, I_rescale + ! real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector real :: cg_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] @@ -183,7 +183,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%Z_to_H*GV%H_to_Pa - rescale = 1024.0**4 ; I_rescale = 1.0/rescale + ! rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -449,15 +449,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo enddo !### Some mathematical cancellations could occur in the next two lines. w2avg = w2avg / htot(i,j) - w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int) + w_strct(:) = w_strct(:) / sqrt(htot(i,j)*w2avg*I_a_int) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 u_strct(K) = 0.5*((w_strct(K-1) - w_strct(K) )/dz(k-1) + & - (w_strct(K) - w_strct(K+1))/dz(k)) + (w_strct(K) - w_strct(K+1))/dz(k)) enddo u_strct(1) = (w_strct(1) - w_strct(2) )/dz(1) - u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) + u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude f2 = G%CoriolisBu(I,J)**2 @@ -467,8 +467,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Calculate terms in vertically integrated energy equation int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 - u_strct2 = u_strct(1:nzm)**2 - w_strct2 = w_strct(1:nzm)**2 + u_strct2(:) = u_strct(1:nzm)**2 + w_strct2(:) = w_strct(1:nzm)**2 ! vertical integration with Trapezoidal rule do k=1,nzm-1 int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1))*dz(k) @@ -478,6 +478,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (Kmag2 > 0.0) then + !### This should be simpified to use a single division. KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then @@ -488,14 +489,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo W0 = 0.0 endif ! Calculate actual vertical velocity profile and derivative - W_profile = W0*w_strct - dWdz_profile = W0*u_strct + W_profile(:) = W0*w_strct(:) + dWdz_profile(:) = W0*u_strct(:) ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile = abs(dWdz_profile) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) + !### This should be simpified to use a single division. + Uavg_profile(:) = abs(dWdz_profile(:)) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) else - W_profile = 0.0 - dWdz_profile = 0.0 - Uavg_profile = 0.0 + W_profile(:) = 0.0 + dWdz_profile(:) = 0.0 + Uavg_profile(:) = 0.0 endif ! Store values in control structure From e90f16d2695f2aacb0d3563d595a9550cbf75787 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 08:21:58 -0400 Subject: [PATCH 079/104] +Recast vertvisc to work with velocities in [L T-1] Recast vertvisc and vertvisc_limit_vel to work internally with velocities in units of [L T-1] and pass velocities to write_u_accel and write_v_accel in [L T-1]. All answers are bitwise identical, but the units of arguments to diagnostic routines have been changed. --- src/diagnostics/MOM_PointAccel.F90 | 99 +++++++------- .../vertical/MOM_vert_friction.F90 | 128 ++++++++++-------- 2 files changed, 126 insertions(+), 101 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 92292bb8e7..9983c70e01 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -47,8 +47,8 @@ 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 [m s-1]. - v_av => NULL(), & !< Time average velocity [m s-1]. + 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 [m s-1]. v_prev => NULL(), & !< Previous v-velocity [m s-1]. T => NULL(), & !< Temperature [degC]. @@ -58,7 +58,7 @@ module MOM_PointAccel 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]. - + real :: u_av_scale !< A scaling factor to convert u_av to m s-1. end type PointAccel_CS contains @@ -73,7 +73,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: um !< The new zonal velocity [m s-1]. + intent(in) :: um !< The new zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -83,7 +83,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [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 [m 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 integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -132,14 +132,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! Determine which layers to write out accelerations for. do k=1,nz - if (((max(CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -163,29 +163,29 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') 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," ",$)') (um(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*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," ",$)') (CS%u_prev(I,j,k)); enddo endif write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%u_av(I,j,k)); enddo write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(US%m_to_L*um(I,j,k)) * dt * G%dy_Cu(I,j) + CFL = abs(um(I,j,k)) * US%s_to_T*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)) * dt * US%m_to_L*G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * US%s_to_T*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," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))); enddo + ((US%L_T_to_m_s*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 @@ -207,7 +207,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo + (US%L_T_to_m_s*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*ADp%du_dt_visc(I,j,k)); enddo @@ -285,10 +285,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*US%m_to_L*G%IdxCv(i,J-1)); enddo + (uh_scale*US%m_to_L*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*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,j-1,k)*h_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," ",$)') & @@ -297,10 +297,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*US%m_to_L*G%IdxCv(i,J)); enddo + (uh_scale*US%m_to_L*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*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,J,k)*h_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," ",$)') & @@ -309,10 +309,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*US%m_to_L*G%IdxCv(i+1,J-1)); enddo + (uh_scale*US%m_to_L*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*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%u_av_scale*CS%v_av(i+1,J-1,k)*h_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," ",$)') & @@ -321,14 +321,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*US%m_to_L*G%IdxCv(i+1,J)); enddo + (uh_scale*US%m_to_L*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*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_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*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i+1,j) @@ -336,7 +336,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = um(I,j,k)-CS%u_prev(I,j,k) + 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 Inorm(k) = 1.0 / du enddo @@ -346,7 +346,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + ((US%L_T_to_m_s*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," ",$)') & @@ -404,7 +404,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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),SZJB_(G),SZK_(G)), & - intent(in) :: vm !< The new meridional velocity [m s-1]. + intent(in) :: vm !< The new meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -414,7 +414,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [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 [m 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 integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -462,14 +462,14 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st prev_avail = (associated(CS%u_prev) .and. associated(CS%v_prev)) do k=1,nz - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -493,7 +493,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') 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," ",$)') (vm(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*vm(i,J,k)); enddo if (prev_avail) then write(file,'(/,"v(mp): ",$)') @@ -501,22 +501,22 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_av(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%v_av(i,J,k)); enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(US%m_to_L*vm(i,J,k)) * dt * G%dx_Cv(i,J) + CFL = abs(vm(i,J,k)) * US%s_to_T*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)) * dt * US%m_to_L*G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * US%s_to_T*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," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))); enddo + ((US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k))); enddo endif write(file,'(/,"CAv: ",$)') @@ -541,7 +541,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo + (US%L_T_to_m_s*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," ",$)') & @@ -619,10 +619,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*US%m_to_L*G%IdyCu(I-1,j)); enddo + (uh_scale*US%m_to_L*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," ",$)') & - (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j,k) * h_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," ",$)') & @@ -631,10 +631,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*US%m_to_L*G%IdyCu(I-1,j+1)); enddo + (uh_scale*US%m_to_L*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," ",$)') & - (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_scale*CS%u_av(I-1,j+1,k) * h_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," ",$)') & @@ -643,10 +643,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*US%m_to_L*G%IdyCu(I,j)); enddo + (uh_scale*US%m_to_L*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," ",$)') & - (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av_scale*CS%u_av(I,j,k) * h_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," ",$)') & @@ -655,10 +655,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*US%m_to_L*G%IdyCu(I,j+1)); enddo + (uh_scale*US%m_to_L*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," ",$)') & - (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_scale*CS%u_av(I,j+1,k) * 0.5*h_scale*(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," ",$)') & @@ -670,7 +670,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = vm(i,J,k)-CS%v_prev(i,J,k) + 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 Inorm(k) = 1.0 / dv enddo @@ -679,7 +679,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + ((US%L_T_to_m_s*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 @@ -755,6 +755,9 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_av => MIS%u_av; if (.not.associated(MIS%u_av)) CS%u_av => MIS%u(:,:,:) CS%v_av => MIS%v_av; if (.not.associated(MIS%v_av)) CS%v_av => MIS%v(:,:,:) +! CS%u_av_scale = G%US%L_T_to_m_s ; if (.not.associated(MIS%u_av)) CS%u_av_scale = 1.0 + CS%u_av_scale = 1.0 + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d517223f7d..3cdc394675 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -46,9 +46,9 @@ module MOM_vert_friction real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer [Z2 T-1 ~> m2 s-1]. - real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. + real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [m s-1]. + !! are set to 0 [L T-1 ~> m s-1]. logical :: CFL_based_trunc !< If true, base truncations on CFL numbers, not !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they @@ -183,8 +183,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress [H ~> m or kg m-2]. real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the time step [s-1]. - real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. + real :: dt_in_T ! The timestep [T ~> s] + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. + real :: dt_Rho0 ! The time step divided by the mean density [L s2 H m T-1 kg-1 ~> s m3 kg-1 or s]. real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - [T H Z-1 ~> s or s kg m-3]. @@ -192,10 +193,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: stress ! The surface stress times the time step, divided - ! by the density [m2 s-1]. + ! by the density [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress - ! stress is applied as a body force [m2 s-1]. + ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -207,15 +208,25 @@ 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.") + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + + if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif - dt_Rho0 = dt/GV%H_to_kg_m2 - dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H + dt_in_T = US%s_to_T*dt + dt_Rho0 = US%m_s_to_L_T*US%T_to_s * dt_in_T / GV%H_to_kg_m2 + dt_Z_to_H = dt_in_T*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff - Idt = 1.0 / dt + Idt = 1.0 / dt_in_T !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. @@ -239,7 +250,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) + US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq @@ -314,25 +325,25 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq - ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + ADp%du_dt_visc(I,j,k) = US%L_T2_to_m_s2*(u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*US%s_to_T*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = Rho0 * (u(I,j,nz)*US%s_to_T*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = US%L_T2_to_m_s2*Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + Rho0 * (US%s_to_T*Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + US%L_T2_to_m_s2*Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) - US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif enddo ! end u-component j loop @@ -347,7 +358,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + if (do_i(i)) v(i,j,k) = v(i,j,k) + US%m_s_to_L_T*Waves%Us_y(i,j,k) enddo ; enddo ; endif if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie @@ -395,25 +406,25 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie - ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + ADp%dv_dt_visc(i,J,k) = US%L_T2_to_m_s2*(v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*US%s_to_T*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (v(i,J,nz)*US%s_to_T*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (US%L_T2_to_m_s2*v(i,J,nz)*CS%a_v(i,J,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%s_to_T*Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%L_T2_to_m_s2*Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + if (do_i(i)) v(i,J,k) = v(i,J,k) - US%m_s_to_L_T*Waves%Us_y(i,J,k) enddo ; enddo ; endif enddo ! end of v-component J loop @@ -427,18 +438,27 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (OBC%segment(n)%is_N_or_S) then J = OBC%segment(n)%HI%JsdB do k=1,nz ; do i=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v(i,J,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(i,J,k) + v(i,J,k) = OBC%segment(n)%normal_vel(i,J,k) enddo ; enddo elseif (OBC%segment(n)%is_E_or_W) then I = OBC%segment(n)%HI%IsdB do k=1,nz ; do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u(I,j,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(I,j,k) + u(I,j,k) = OBC%segment(n)%normal_vel(I,j,k) enddo ; enddo endif endif enddo endif + + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) @@ -1353,9 +1373,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers @@ -1368,13 +1388,14 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both [m s-1]. + real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. real :: dt_Rho0 ! The timestep divided by the Boussinesq density [s m3 kg-1]. - real :: vel_report(SZIB_(G),SZJB_(G)) - real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) - real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) + real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] + real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) ! The previous u-velocity [L T-1 ~> m s-1] + real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] logical :: trunc_any, dowrite(SZIB_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -1383,6 +1404,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS maxvel = CS%maxvel truncvel = 0.9*maxvel H_report = 6.0 * GV%Angstrom_H + dt_in_T = US%s_to_T*dt dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then @@ -1391,13 +1413,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do I=Isq,Ieq ; dowrite(I,j) = .false. ; enddo if (CS%CFL_based_trunc) then - do I=Isq,Ieq ; vel_report(i,j) = 3.0e8 ; enddo ! Speed of light default. + do I=Isq,Ieq ; vel_report(i,j) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,11 +1443,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1441,11 +1463,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1476,13 +1498,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do i=is,ie ; dowrite(i,J) = .false. ; enddo if (CS%CFL_based_trunc) then - do i=is,ie ; vel_report(i,J) = 3.0e8 ; enddo ! Speed of light default. + do i=is,ie ; vel_report(i,J) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,11 +1528,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1526,11 +1548,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1684,7 +1706,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity "//& - "components are truncated.", units="m s-1", default=3.0e8) + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & "If true, base truncations on the CFL number, and not an "//& "absolute speed.", default=.true.) @@ -1728,7 +1750,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 From a0a46e83d96159c84607e513177ecb0e8793a941 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 08:48:17 -0400 Subject: [PATCH 080/104] +Rescaled ADp%du_dt_visc to units of [L T-2] Rescaled ADp%du_dt_visc and ADp%dv_dt_visc to units of [L T-2]. All answers are bitwise identical but there are changes to the units of elements of a transparent type. --- src/core/MOM_variables.F90 | 4 ++-- src/diagnostics/MOM_PointAccel.F90 | 12 ++++++------ src/diagnostics/MOM_diagnostics.F90 | 4 ++-- src/parameterizations/vertical/MOM_vert_friction.F90 | 8 ++++---- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 33797198a5..aeea2329b6 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -162,8 +162,8 @@ module MOM_variables CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] - du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] - dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] + du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] + dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [L T-2 ~> m s-2] dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9983c70e01..e78e6133f3 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -207,10 +207,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)-dt*ADp%du_dt_visc(I,j,k)); enddo + US%L_T_to_m_s*(um(I,j,k) - US%s_to_T*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*ADp%du_dt_visc(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k)); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -373,7 +373,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -541,11 +541,11 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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)-dt*ADp%dv_dt_visc(i,J,k)); enddo + US%L_T_to_m_s*(vm(i,J,k) - US%s_to_T*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*ADp%dv_dt_visc(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') @@ -703,7 +703,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9662eb0985..b853ee668b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 3cdc394675..35f0bcb78d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -325,7 +325,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq - ADp%du_dt_visc(I,j,k) = US%L_T2_to_m_s2*(u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq @@ -406,7 +406,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie - ADp%dv_dt_visc(i,J,k) = US%L_T2_to_m_s2*(v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie @@ -1785,10 +1785,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, & - Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & From 887e36b3a816bb8480dcfd1af52cb2f2b9e45fa5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 09:21:21 -0400 Subject: [PATCH 081/104] +Pass velocities to vertvisc in [L T-1] Passed the velocity arguments to vertvisc in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 28 + src/core/MOM_dynamics_split_RK2.F90.bad1 | 1319 ----------------- src/core/MOM_dynamics_unsplit.F90 | 42 + src/core/MOM_dynamics_unsplit_RK2.F90 | 42 + .../vertical/MOM_vert_friction.F90 | 22 +- 5 files changed, 114 insertions(+), 1339 deletions(-) delete mode 100644 src/core/MOM_dynamics_split_RK2.F90.bad1 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d8e6ad386b..8e1e996c2b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -590,8 +590,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -800,8 +814,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_dynamics_split_RK2.F90.bad1 b/src/core/MOM_dynamics_split_RK2.F90.bad1 deleted file mode 100644 index 8064680d90..0000000000 --- a/src/core/MOM_dynamics_split_RK2.F90.bad1 +++ /dev/null @@ -1,1319 +0,0 @@ -!> Time step the adiabatic dynamic core of MOM using RK2 method. -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 : 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 - -use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT -use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_mediator_init, enable_averaging -use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr -use MOM_diag_mediator, only : register_diag_field, register_static_field -use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids -use MOM_domains, only : MOM_domains_init -use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR -use MOM_domains, only : To_North, To_East, Omit_Corners -use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_domains, only : start_group_pass, complete_group_pass, pass_var -use MOM_debugging, only : hchksum, uvchksum -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery -use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_get_input, only : directories -use MOM_io, only : MOM_io_init, vardesc, var_desc -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_time_manager, only : time_type, time_type_to_real, operator(+) -use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) - -use MOM_ALE, only : ALE_CS -use MOM_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source -use MOM_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_CS -use MOM_boundary_update, only : update_OBC_data, update_OBC_CS -use MOM_continuity, only : continuity, continuity_init, continuity_CS -use MOM_continuity, only : continuity_stencil -use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS -use MOM_debugging, only : check_redundant -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS -use MOM_interface_heights, only : find_eta -use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_MEKE_types, only : MEKE_type -use MOM_open_boundary, only : ocean_OBC_type, radiation_open_bdry_conds -use MOM_open_boundary, only : open_boundary_zero_normal_flow -use MOM_open_boundary, only : open_boundary_test_extern_h -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_remnant -use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS -use MOM_vert_friction, only : updateCFLtruncationValue -use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units -use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units -use MOM_wave_interface, only: wave_parameters_CS - -implicit none ; private - -#include - -!> MOM_dynamics_split_RK2 module control structure -type, public :: MOM_dyn_split_RK2_CS ; private - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] - PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] - - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] - PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] - - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u - !< Both the fraction of the zonal momentum originally in a - !! layer that remains after a time-step of viscosity, and the - !! fraction of a time-step worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. - !! Nondimensional between 0 (at the bottom) and 1 (far above). - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt - !< The zonal layer accelerations due to the difference between - !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v - !< Both the fraction of the meridional momentum originally in - !! a layer that remains after a time-step of viscosity, and the - !! fraction of a time-step worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. - !! Nondimensional between 0 (at the bottom) and 1 (far above). - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt - !< The meridional layer accelerations due to the difference between - !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] - - ! The following variables are only used with the split time stepping scheme. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq - !! mode) or column mass anomaly (in non-Boussinesq - !! mode) [H ~> m or kg m-2] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic - !! timestep [L T-1 ~> m s-1] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic - !! timestep [L T-1 ~> m s-1] - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer - !! thicknesses [H ~> m or kg m-2] - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and - !! PFv [H ~> m or kg m-2] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. - !! uhbt is roughly equal to the vertical sum of uh. - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. - !! vhbt is roughly equal to vertical sum of vh. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure - !! anomaly in each layer due to free surface height - !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. - - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] - type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the - !! effective summed open face areas as a function - !! of barotropic flow. - - ! This is to allow the previous, velocity-based coupling with between the - ! baroclinic and barotropic modes. - logical :: BT_use_layer_fluxes !< If true, use the summed layered fluxes plus - !! an adjustment due to a changed barotropic - !! velocity in the barotropic continuity equation. - logical :: split_bottom_stress !< If true, provide the bottom stress - !! calculated by the vertical viscosity to the - !! barotropic solver. - logical :: calc_dtbt !< If true, calculate the barotropic time-step - !! dynamically. - - real :: be !< A nondimensional number from 0.5 to 1 that controls - !! the backward weighting of the time stepping scheme. - 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. - 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. - - !>@{ Diagnostic IDs - integer :: id_uh = -1, id_vh = -1 - integer :: id_umo = -1, id_vmo = -1 - integer :: id_umo_2d = -1, id_vmo_2d = -1 - integer :: id_PFu = -1, id_PFv = -1 - integer :: id_CAu = -1, id_CAv = -1 - - ! Split scheme only. - integer :: id_uav = -1, id_vav = -1 - integer :: id_u_BT_accel = -1, id_v_BT_accel = -1 - !!@} - - type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the - !! timing of diagnostic output. - type(accel_diag_ptrs), pointer :: ADp !< A structure pointing to the various - !! accelerations in the momentum equations, - !! which can later be used to calculate - !! derived diagnostics like energy budgets. - type(cont_diag_ptrs), pointer :: CDp !< A structure with pointers to various - !! terms in the continuity equations, - !! which can later be used to calculate - !! derived diagnostics like energy budgets. - - ! 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() - !> 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() - !> 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() - !> 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 tidal forcing control structure - type(tidal_forcing_CS), pointer :: tides_CSp => NULL() - !> A pointer to the ALE control structure. - type(ALE_CS), pointer :: ALE_CSp => NULL() - - type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary - !! condition type that specifies whether, where, and what open boundary - !! conditions are used. If no open BCs are used, this pointer stays - !! nullified. Flather OBCs use open boundary_CS as well. - !> A pointer to the update_OBC control structure - type(update_OBC_CS), pointer :: update_OBC_CSp => NULL() - - type(group_pass_type) :: pass_eta !< Structure for group halo pass - type(group_pass_type) :: pass_visc_rem !< Structure for group halo pass - type(group_pass_type) :: pass_uvp !< Structure for group halo pass - type(group_pass_type) :: pass_hp_uv !< Structure for group halo pass - type(group_pass_type) :: pass_uv !< Structure for group halo pass - type(group_pass_type) :: pass_h !< Structure for group halo pass - type(group_pass_type) :: pass_av_uvh !< Structure for group halo pass - -end type MOM_dyn_split_RK2_CS - - -public step_MOM_dyn_split_RK2 -public register_restarts_dyn_split_RK2 -public initialize_dyn_split_RK2 -public end_dyn_split_RK2 - -!>@{ CPU time clock IDs -integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc -integer :: id_clock_horvisc, id_clock_mom_update -integer :: id_clock_continuity, id_clock_thick_diff -integer :: id_clock_btstep, id_clock_btcalc, id_clock_btforce -integer :: id_clock_pass, id_clock_pass_init -!!@} - -contains - -!> 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< layer thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type - type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related - type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step [s] - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic - !! time step [Pa] - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic - !! time step [Pa] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport - !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport - !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< accumulatated merid volume/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 - !! 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 - !! interface height diffusivities - type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing - !! fields related to the surface wave conditions - - ! local variables - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel - ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in - ! 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]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj - ! u_adj and v_adj are the zonal or meridional velocities after u and v - ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out [m s-1]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC - ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [m s-1]. - - real :: Pa_to_eta ! A factor that converts pressures to the units of eta. - real, pointer, dimension(:,:) :: & - p_surf => NULL(), eta_PF_start => NULL(), & - taux_bot => NULL(), tauy_bot => NULL(), & - eta => NULL() - - real, pointer, dimension(:,:,:) :: & - uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & - u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - 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 :: Idt - logical :: dyn_p_surf - logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the - ! relative weightings of the layers in calculating - ! the barotropic accelerations. - !---For group halo pass - logical :: showCallTree, sym - - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: cont_stencil - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta - Idt = 1.0 / dt - - sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums - - showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") - - !$OMP parallel do default(shared) - do k = 1, nz - do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo - do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo - do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo - enddo - - ! Update CFL truncation value as function of time - call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) - - if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call check_redundant("Start predictor u ", u, v, G) - call check_redundant("Start predictor uh ", uh, vh, G) - endif - - dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) - if (dyn_p_surf) then - p_surf => p_surf_end - call safe_alloc_ptr(eta_PF_start,G%isd,G%ied,G%jsd,G%jed) - eta_PF_start(:,:) = 0.0 - else - p_surf => forces%p_surf - endif - - if (associated(CS%OBC)) then - if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) - - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) - enddo ; enddo ; enddo - endif - - BT_cont_BT_thick = .false. - if (associated(CS%BT_cont)) BT_cont_BT_thick = & - (allocated(CS%BT_cont%h_u) .and. allocated(CS%BT_cont%h_v)) - - if (CS%split_bottom_stress) then - taux_bot => CS%taux_bot ; tauy_bot => CS%tauy_bot - endif - - !--- begin set up for group halo pass - - cont_stencil = continuity_stencil(CS%continuity_CSp) - !### Apart from circle_OBCs halo for eta could be 1, but halo>=3 is required - !### to match circle_OBCs solutions. Why? - call cpu_clock_begin(id_clock_pass) - call create_group_pass(CS%pass_eta, eta, G%Domain) !### , halo=1) - call create_group_pass(CS%pass_visc_rem, CS%visc_rem_u, CS%visc_rem_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE, halo=max(1,cont_stencil)) - call create_group_pass(CS%pass_uvp, up, vp, G%Domain, halo=max(1,cont_stencil)) - call create_group_pass(CS%pass_hp_uv, hp, G%Domain, halo=2) - call create_group_pass(CS%pass_hp_uv, u_av, v_av, G%Domain, halo=2) - call create_group_pass(CS%pass_hp_uv, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) - - call create_group_pass(CS%pass_uv, u, v, G%Domain, halo=max(2,cont_stencil)) - call create_group_pass(CS%pass_h, h, G%Domain, halo=max(2,cont_stencil)) - call create_group_pass(CS%pass_av_uvh, u_av, v_av, G%Domain, halo=2) - call create_group_pass(CS%pass_av_uvh, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) - call cpu_clock_end(id_clock_pass) - !--- end set up for group halo pass - - -! PFu = d/dx M(h,T,S) -! pbce = dM/deta - if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) - call cpu_clock_begin(id_clock_pres) - call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & - CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) - if (dyn_p_surf) then - Pa_to_eta = 1.0 / GV%H_to_Pa - !$OMP parallel do default(shared) - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_PF_start(i,j) = CS%eta_PF(i,j) - Pa_to_eta * & - (p_surf_begin(i,j) - p_surf_end(i,j)) - enddo ; enddo - endif - call cpu_clock_end(id_clock_pres) - call disable_averaging(CS%diag) - if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)") - - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) - endif; endif - if (associated(CS%OBC) .and. CS%debug_OBC) & - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) - - if (G%nonblocking_updates) & - call start_group_pass(CS%pass_eta, G%Domain, clock=id_clock_pass) - -! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av - call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%L_T_to_m_s*u_av, US%L_T_to_m_s*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) - call cpu_clock_end(id_clock_Cor) - if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") - -! u_bc_accel = CAu + PFu + diffu(u[n-1]) - call cpu_clock_begin(id_clock_btforce) - !$OMP parallel do default(shared) - do k=1,nz - do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) - enddo ; enddo - enddo - if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) - endif - call cpu_clock_end(id_clock_btforce) - - if (CS%debug) then - call MOM_accel_chksum("pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & - symmetric=sym) - call check_redundant("pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) - call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) - call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) - endif - - call cpu_clock_begin(id_clock_vertvisc) - !$OMP parallel do default(shared) - do k=1,nz - do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) - enddo ; enddo - enddo - - call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & - CS%set_visc_CSp) - call disable_averaging(CS%diag) - - if (CS%debug) then - call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) - endif - call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) - call cpu_clock_end(id_clock_vertvisc) - if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") - - - call cpu_clock_begin(id_clock_pass) - if (G%nonblocking_updates) then - call complete_group_pass(CS%pass_eta, G%Domain) - call start_group_pass(CS%pass_visc_rem, G%Domain) - else - call do_group_pass(CS%pass_eta, G%Domain) - call do_group_pass(CS%pass_visc_rem, G%Domain) - endif - call cpu_clock_end(id_clock_pass) - - call cpu_clock_begin(id_clock_btcalc) - ! Calculate the relative layer weights for determining barotropic quantities. - if (.not.BT_cont_BT_thick) & - call btcalc(h, G, GV, CS%barotropic_CSp, OBC=CS%OBC) - call bt_mass_source(h, eta, .true., G, GV, CS%barotropic_CSp) - call cpu_clock_end(id_clock_btcalc) - - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) - -! 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 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, & - OBC=CS%OBC) - endif - if (showCallTree) call callTree_wayPoint("done with continuity[BT_cont] (step_MOM_dyn_split_RK2)") - endif - - if (CS%BT_use_layer_fluxes) then - uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v - endif - - u_init => u ; v_init => v - call cpu_clock_begin(id_clock_btstep) - 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, & - US%L_T_to_m_s*u_av, US%L_T_to_m_s*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, & - 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) - if (showCallTree) call callTree_leave("btstep()") - call cpu_clock_end(id_clock_btstep) - -! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt * CS%be - call cpu_clock_begin(id_clock_mom_update) - - !$OMP parallel do default(shared) - do k=1,nz - do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) - enddo ; enddo - do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) - enddo ; enddo - enddo - call cpu_clock_end(id_clock_mom_update) - - if (CS%debug) then - call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) - call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) - call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) - call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & - symmetric=sym, vel_scale=1.0) - call check_redundant("Predictor 1 up", up, vp, G) - call check_redundant("Predictor 1 uh", uh, vh, G) - endif - -! up <- up + dt_pred d/dz visc d/dz up -! u_av <- u_av + dt_pred d/dz visc d/dz u_av - call cpu_clock_begin(id_clock_vertvisc) - if (CS%debug) then - call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) - endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & - CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & - GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) - if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") - if (G%nonblocking_updates) then - call cpu_clock_end(id_clock_vertvisc) - call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) - call cpu_clock_begin(id_clock_vertvisc) - endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) - call cpu_clock_end(id_clock_vertvisc) - - call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) - if (G%nonblocking_updates) then - call complete_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) - else - call do_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) - endif - - ! 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, & - 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)") - - call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) - - if (associated(CS%OBC)) then - - if (CS%debug) & - call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - - !### Remove this later - u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) - v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) - !### Remove this later - u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) - v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) - - if (CS%debug) & - call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - - ! These should be done with a pass that excludes uh & vh. -! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) - endif - - if (G%nonblocking_updates) then - call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - endif - - ! h_av = (h + hp)/2 - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) - enddo ; enddo ; enddo - - ! The correction phase of the time step starts here. - call enable_averaging(dt, Time_local, CS%diag) - - ! Calculate a revised estimate of the free-surface height correction to be - ! used in the next call to btstep. This call is at this point so that - ! hp can be changed if CS%begw /= 0. - ! eta_cor = ... (hidden inside CS%barotropic_CSp) - call cpu_clock_begin(id_clock_btcalc) - call bt_mass_source(hp, eta_pred, .false., G, GV, CS%barotropic_CSp) - call cpu_clock_end(id_clock_btcalc) - - if (CS%begw /= 0.0) then - ! hp <- (1-begw)*h_in + begw*hp - ! Back up hp to the value it would have had after a time-step of - ! begw*dt. hp is not used again until recalculated by continuity. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hp(i,j,k) = (1.0-CS%begw)*h(i,j,k) + CS%begw*hp(i,j,k) - enddo ; enddo ; enddo - - ! PFu = d/dx M(hp,T,S) - ! pbce = dM/deta - call cpu_clock_begin(id_clock_pres) - call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & - CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) - call cpu_clock_end(id_clock_pres) - if (showCallTree) call callTree_wayPoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)") - endif - - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - - if (BT_cont_BT_thick) then - call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & - OBC=CS%OBC) - if (showCallTree) call callTree_wayPoint("done with btcalc[BT_cont_BT_thick] (step_MOM_dyn_split_RK2)") - endif - - if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US,) - call check_redundant("Predictor up ", up, vp, G) - call check_redundant("Predictor uh ", uh, vh, G) - endif - -! diffu = horizontal viscosity terms (u_av) - call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & - OBC=CS%OBC, BT=CS%barotropic_CSp) - call cpu_clock_end(id_clock_horvisc) - if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") - -! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av - call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) - call cpu_clock_end(id_clock_Cor) - if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") - -! Calculate the momentum forcing terms for the barotropic equations. - -! u_bc_accel = CAu + PFu + diffu(u[n-1]) - call cpu_clock_begin(id_clock_btforce) - !$OMP parallel do default(shared) - do k=1,nz - do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) - enddo ; enddo - enddo - if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) - endif - call cpu_clock_end(id_clock_btforce) - - if (CS%debug) then - call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & - symmetric=sym) - call check_redundant("corr pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) - call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) - call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) - endif - - ! u_accel_bt = layer accelerations due to barotropic solver - ! pbce = dM/deta - call cpu_clock_begin(id_clock_btstep) - if (CS%BT_use_layer_fluxes) then - !### Remove this later - u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) ; v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) - uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av - endif - - 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, 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) - do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo - call cpu_clock_end(id_clock_btstep) - if (showCallTree) call callTree_leave("btstep()") - - if (CS%BT_use_layer_fluxes) then - !### Remove this later - u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) ; v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) - endif - - if (CS%debug) then - call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G) - endif - - ! u = u + dt*( u_bc_accel + u_accel_bt ) - call cpu_clock_begin(id_clock_mom_update) - !$OMP parallel do default(shared) - do k=1,nz - do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) - enddo ; enddo - enddo - call cpu_clock_end(id_clock_mom_update) - - if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) - call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) - call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) - call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & - symmetric=sym) - endif - - ! u <- u + dt d/dz visc d/dz u - ! u_av <- u_av + dt d/dz visc d/dz u_av - call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & - CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) - if (G%nonblocking_updates) then - call cpu_clock_end(id_clock_vertvisc) - call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) - call cpu_clock_begin(id_clock_vertvisc) - endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) - call cpu_clock_end(id_clock_vertvisc) - if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") - -! Later, h_av = (h_in + h_out)/2, but for now use h_av to store h_in. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - h_av(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - - call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) - if (G%nonblocking_updates) then - call complete_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) - else - call do_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) - endif - - ! uh = u_av * h - ! 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 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 - ! for vertical remapping may need to be regenerated. - call diag_update_remap_grids(CS%diag) - if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") - - if (G%nonblocking_updates) then - call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - else - call do_group_pass(CS%pass_av_uvh, G%domain, clock=id_clock_pass) - endif - - if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) - endif - -! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - h_av(i,j,k) = 0.5*(h_av(i,j,k) + h(i,j,k)) - enddo ; enddo ; enddo - - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - - !$OMP parallel do default(shared) - do k=1,nz - do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt - enddo ; enddo - do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt - enddo ; enddo - enddo - - ! The time-averaged free surface height has already been set by the last - ! call to btstep. - - ! Here various terms used in to update the momentum equations are - ! offered for time averaging. - if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) - if (CS%id_PFv > 0) call post_data(CS%id_PFv, CS%PFv, CS%diag) - if (CS%id_CAu > 0) call post_data(CS%id_CAu, CS%CAu, CS%diag) - if (CS%id_CAv > 0) call post_data(CS%id_CAv, CS%CAv, CS%diag) - - ! Here the thickness fluxes are offered for time averaging. - if (CS%id_uh > 0) call post_data(CS%id_uh , uh, CS%diag) - if (CS%id_vh > 0) call post_data(CS%id_vh , vh, CS%diag) - if (CS%id_uav > 0) call post_data(CS%id_uav, u_av, CS%diag) - if (CS%id_vav > 0) call post_data(CS%id_vav, v_av, CS%diag) - 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) - - if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) - endif - - if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") - -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 -!! 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 - 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] - 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] - - type(vardesc) :: vd - character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. - character(len=48) :: thickness_units, flux_units - - integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke - IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB - - ! This is where a control structure specific to this module would be allocated. - if (associated(CS)) then - call MOM_error(WARNING, "register_restarts_dyn_split_RK2 called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - ALLOC_(CS%diffu(IsdB:IedB,jsd:jed,nz)) ; CS%diffu(:,:,:) = 0.0 - ALLOC_(CS%diffv(isd:ied,JsdB:JedB,nz)) ; CS%diffv(:,:,:) = 0.0 - ALLOC_(CS%CAu(IsdB:IedB,jsd:jed,nz)) ; CS%CAu(:,:,:) = 0.0 - ALLOC_(CS%CAv(isd:ied,JsdB:JedB,nz)) ; CS%CAv(:,:,:) = 0.0 - ALLOC_(CS%PFu(IsdB:IedB,jsd:jed,nz)) ; CS%PFu(:,:,:) = 0.0 - ALLOC_(CS%PFv(isd:ied,JsdB:JedB,nz)) ; CS%PFv(:,:,:) = 0.0 - - ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 - ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 - ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 - ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H - - thickness_units = get_thickness_units(GV) - flux_units = get_flux_units(GV) - - if (GV%Boussinesq) then - vd = var_desc("sfc",thickness_units,"Free surface Height",'h','1') - else - vd = var_desc("p_bot",thickness_units,"Bottom Pressure",'h','1') - endif - call register_restart_field(CS%eta, vd, .false., restart_CS) - - vd = var_desc("u2","m s-1","Auxiliary Zonal velocity",'u','L') - call register_restart_field(CS%u_av, vd, .false., restart_CS) - - vd = var_desc("v2","m s-1","Auxiliary Meridional velocity",'v','L') - call register_restart_field(CS%v_av, vd, .false., restart_CS) - - vd = var_desc("h2",thickness_units,"Auxiliary Layer Thickness",'h','L') - call register_restart_field(CS%h_av, vd, .false., restart_CS) - - vd = var_desc("uh",flux_units,"Zonal thickness flux",'u','L') - call register_restart_field(uh, vd, .false., restart_CS) - - vd = var_desc("vh",flux_units,"Meridional thickness flux",'v','L') - call register_restart_field(vh, vd, .false., restart_CS) - - vd = var_desc("diffu","m s-2","Zonal horizontal viscous acceleration",'u','L') - call register_restart_field(CS%diffu, vd, .false., restart_CS) - - vd = var_desc("diffv","m s-2","Meridional horizontal viscous acceleration",'v','L') - call register_restart_field(CS%diffv, vd, .false., restart_CS) - - call register_barotropic_restarts(HI, GV, param_file, CS%barotropic_CSp, & - restart_CS) - -end subroutine register_restarts_dyn_split_RK2 - -!> This subroutine initializes all of the variables that are used by this -!! dynamic core, including diagnostics and the cpu clocks. -subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & - 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) - 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_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< merid velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] - type(time_type), target, intent(in) :: Time !< current model time - 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 - real, intent(in) :: dt !< time step [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(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(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 - - ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp - character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. - 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 :: 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 :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run. - real :: H_convert - type(group_pass_type) :: pass_av_h_uvh - logical :: use_tides, debug_truncations - - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: IsdB, IedB, JsdB, JedB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 - - if (.not.associated(CS)) call MOM_error(FATAL, & - "initialize_dyn_split_RK2 called with an unassociated control structure.") - if (CS%module_is_initialized) then - call MOM_error(WARNING, "initialize_dyn_split_RK2 called with a control "// & - "structure that has already been initialized.") - return - endif - CS%module_is_initialized = .true. - - CS%diag => diag - - call get_param(param_file, mdl, "TIDES", use_tides, & - "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mdl, "BE", CS%be, & - "If SPLIT is true, BE determines the relative weighting "//& - "of a 2nd-order Runga-Kutta baroclinic time stepping "//& - "scheme (0.5) and a backward Euler scheme (1) that is "//& - "used for the Coriolis and inertial terms. BE may be "//& - "from 0.5 to 1, but instability may occur near 0.5. "//& - "BE is also applicable if SPLIT is false and USE_RK2 "//& - "is true.", units="nondim", default=0.6) - call get_param(param_file, mdl, "BEGW", CS%begw, & - "If SPLIT is true, BEGW is a 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. "//& - "If SPLIT is false and USE_RK2 is true, BEGW can be "//& - "between 0 and 0.5 to damp gravity waves.", & - units="nondim", default=0.0) - - call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & - "If true, provide the bottom stress calculated by the "//& - "vertical viscosity to the barotropic solver.", default=.false.) - call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & - "If true, use the summed layered fluxes plus an "//& - "adjustment due to the change in the barotropic velocity "//& - "in the barotropic continuity equation.", default=.true.) - call get_param(param_file, mdl, "DEBUG", CS%debug, & - "If true, write out verbose debugging data.", & - default=.false., debuggingParam=.true.) - call get_param(param_file, mdl, "DEBUG_OBC", CS%debug_OBC, default=.false.) - call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & - default=.false.) - - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 - - ALLOC_(CS%uhbt(IsdB:IedB,jsd:jed)) ; CS%uhbt(:,:) = 0.0 - ALLOC_(CS%vhbt(isd:ied,JsdB:JedB)) ; CS%vhbt(:,:) = 0.0 - ALLOC_(CS%visc_rem_u(IsdB:IedB,jsd:jed,nz)) ; CS%visc_rem_u(:,:,:) = 0.0 - ALLOC_(CS%visc_rem_v(isd:ied,JsdB:JedB,nz)) ; CS%visc_rem_v(:,:,:) = 0.0 - ALLOC_(CS%eta_PF(isd:ied,jsd:jed)) ; CS%eta_PF(:,:) = 0.0 - ALLOC_(CS%pbce(isd:ied,jsd:jed,nz)) ; CS%pbce(:,:,:) = 0.0 - - ALLOC_(CS%u_accel_bt(IsdB:IedB,jsd:jed,nz)) ; CS%u_accel_bt(:,:,:) = 0.0 - ALLOC_(CS%v_accel_bt(isd:ied,JsdB:JedB,nz)) ; CS%v_accel_bt(:,:,:) = 0.0 - - MIS%diffu => CS%diffu - MIS%diffv => CS%diffv - MIS%PFu => CS%PFu - MIS%PFv => CS%PFv - MIS%CAu => CS%CAu - MIS%CAv => CS%CAv - MIS%pbce => CS%pbce - MIS%u_accel_bt => CS%u_accel_bt - MIS%v_accel_bt => CS%v_accel_bt - MIS%u_av => CS%u_av - MIS%v_av => CS%v_av - - CS%ADp => Accel_diag - CS%CDp => Cont_diag - Accel_diag%diffu => CS%diffu - Accel_diag%diffv => CS%diffv - Accel_diag%PFu => CS%PFu - Accel_diag%PFv => CS%PFv - Accel_diag%CAu => CS%CAu - Accel_diag%CAv => CS%CAv - -! Accel_diag%pbce => CS%pbce -! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt -! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av - - call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) - call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & - CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) - 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, & - activate=is_new_run(restart_CS) ) - - if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) CS%OBC => OBC - if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp - - eta_rest_name = "sfc" ; if (.not.GV%Boussinesq) eta_rest_name = "p_bot" - if (.not. query_initialized(CS%eta, trim(eta_rest_name), restart_CS)) then - ! Estimate eta based on the layer thicknesses - h. With the Boussinesq - ! approximation, eta is the free surface height anomaly, while without it - ! eta is the mass of ocean per unit area. eta always has the same - ! dimensions as h, either m or kg m-3. - ! CS%eta(:,:) = 0.0 already from initialization. - if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo - endif - do k=1,nz ; do j=js,je ; do i=is,ie - CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) - enddo ; enddo ; enddo - elseif ((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 j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo - endif - ! Copy eta into an output array. - do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - - call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & - CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & - CS%tides_CSp) - - 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, & - OBC=CS%OBC, BT=CS%barotropic_CSp) - elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then - accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB - CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie - CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) - enddo ; enddo ; enddo - endif - - if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & - .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) - CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) - elseif ( (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) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB - CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie - CS%u_av(i,J,k) = vel_rescale * CS%u_av(i,J,k) - enddo ; enddo ; enddo - endif - - ! This call is just here to initialize uh and vh. - if (.not. query_initialized(uh,"uh",restart_CS) .or. & - .not. query_initialized(vh,"vh",restart_CS)) then - h_tmp(:,:,:) = h(:,:,:) - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) - call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) - CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) - else - if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then - CS%h_av(:,:,:) = h(:,:,:) - elseif ((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 ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo - endif - if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & - (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then - uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & - (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo - endif - endif - - call cpu_clock_begin(id_clock_pass_init) - call create_group_pass(pass_av_h_uvh, CS%u_av, CS%v_av, G%Domain, halo=2) - call create_group_pass(pass_av_h_uvh, CS%h_av, G%Domain, halo=2) - call create_group_pass(pass_av_h_uvh, uh, vh, G%Domain, halo=2) - call do_group_pass(pass_av_h_uvh, G%Domain) - call cpu_clock_end(id_clock_pass_init) - - flux_units = get_flux_units(GV) - H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 - CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & - 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert*US%L_to_m**2*US%s_to_T) - CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & - 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert*US%L_to_m**2*US%s_to_T) - - CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - '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_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & - 'Barotropic-step Averaged Zonal Velocity', 'm s-1') - CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & - 'Barotropic-step Averaged Meridional Velocity', 'm s-1') - - CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - - id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) - id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) - id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=CLOCK_MODULE) - id_clock_vertvisc = cpu_clock_id('(Ocean vertical viscosity)', grain=CLOCK_MODULE) - id_clock_horvisc = cpu_clock_id('(Ocean horizontal viscosity)', grain=CLOCK_MODULE) - id_clock_mom_update = cpu_clock_id('(Ocean momentum increments)', grain=CLOCK_MODULE) - id_clock_pass = cpu_clock_id('(Ocean message passing)', grain=CLOCK_MODULE) - id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', grain=CLOCK_ROUTINE) - id_clock_btcalc = cpu_clock_id('(Ocean barotropic mode calc)', grain=CLOCK_MODULE) - id_clock_btstep = cpu_clock_id('(Ocean barotropic mode stepping)', grain=CLOCK_MODULE) - id_clock_btforce = cpu_clock_id('(Ocean barotropic forcing calc)', grain=CLOCK_MODULE) - -end subroutine initialize_dyn_split_RK2 - - -!> Close the dyn_split_RK2 module -subroutine end_dyn_split_RK2(CS) - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - - DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) - DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) - DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) - - if (associated(CS%taux_bot)) deallocate(CS%taux_bot) - if (associated(CS%tauy_bot)) deallocate(CS%tauy_bot) - DEALLOC_(CS%uhbt) ; DEALLOC_(CS%vhbt) - DEALLOC_(CS%u_accel_bt) ; DEALLOC_(CS%v_accel_bt) - DEALLOC_(CS%visc_rem_u) ; DEALLOC_(CS%visc_rem_v) - - DEALLOC_(CS%eta) ; DEALLOC_(CS%eta_PF) ; DEALLOC_(CS%pbce) - DEALLOC_(CS%h_av) ; DEALLOC_(CS%u_av) ; DEALLOC_(CS%v_av) - - call dealloc_BT_cont_type(CS%BT_cont) - - deallocate(CS) -end subroutine end_dyn_split_RK2 - - -!> \namespace mom_dynamics_split_rk2 -!! -!! This file time steps the adiabatic dynamic core by splitting -!! between baroclinic and barotropic modes. It uses a pseudo-second order -!! Runge-Kutta time stepping scheme for the baroclinic momentum -!! equation and a forward-backward coupling between the baroclinic -!! momentum and continuity equations. This split time-stepping -!! scheme is described in detail in Hallberg (JCP, 1997). Additional -!! issues related to exact tracer conservation and how to -!! ensure consistency between the barotropic and layered estimates -!! of the free surface height are described in Hallberg and -!! Adcroft (Ocean Modelling, 2009). This was the time stepping code -!! that is used for most GOLD applications, including GFDL's ESM2G -!! Earth system model, and all of the examples provided with the -!! MOM code (although several of these solutions are routinely -!! verified by comparison with the slower unsplit schemes). -!! -!! The subroutine step_MOM_dyn_split_RK2 actually does the time -!! stepping, while register_restarts_dyn_split_RK2 sets the fields -!! that are found in a full restart file with this scheme, and -!! initialize_dyn_split_RK2 initializes the cpu clocks that are -!! used in this module. For largely historical reasons, this module -!! does not have its own control structure, but shares the same -!! control structure with MOM.F90 and the other MOM_dynamics_... -!! modules. - -end module MOM_dynamics_split_RK2 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 54471d53f2..611319c706 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -346,8 +346,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -410,8 +424,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + upp(I,j,k) = US%m_s_to_L_T*upp(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vpp(i,J,k) = US%m_s_to_L_T*vpp(i,J,k) + enddo ; enddo ; enddo call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + upp(I,j,k) = US%L_T_to_m_s*upp(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vpp(i,J,k) = US%L_T_to_m_s*vpp(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(upp, vpp, G%Domain, clock=id_clock_pass) @@ -480,8 +508,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(u, v, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 5f37ab63c2..ddbdc84364 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -343,8 +343,22 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call disable_averaging(CS%diag) call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -395,12 +409,40 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc_coef(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo ; enddo call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) call pass_vector(u_in, v_in, G%Domain, clock=id_clock_pass) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 35f0bcb78d..03b2cb767a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -148,9 +148,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -208,15 +208,6 @@ 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.") - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - - if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix @@ -450,15 +441,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo endif - - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) From 670dcd9f9bdf53b4000b7d920ea32c59e1ca5355 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 16:51:53 -0400 Subject: [PATCH 082/104] Velocities in [L T-1] in step_MOM_dyn_split_RK2 Work with velocity units of [L T-1] inside of step_MOM_dyn_split_RK2, step_MOM_dyn_unsplit, and step_MOM_dyn_unsplit_RK2. There are still some places where the velociies revert to [m s-1] because radiation_open_bdry_conds still takes intent in/out arguments in [m s-1]. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 174 ++++++++++++++------------ src/core/MOM_dynamics_unsplit.F90 | 122 +++++++----------- src/core/MOM_dynamics_unsplit_RK2.F90 | 100 ++++++--------- 3 files changed, 180 insertions(+), 216 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 8e1e996c2b..07910340e7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -278,8 +278,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! local variables real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel @@ -344,8 +344,23 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) + enddo ; enddo ; enddo + !$OMP parallel do default(shared) - do k = 1, nz + do k=1,nz do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo @@ -355,7 +370,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -373,10 +388,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) 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) + u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_old_rad_OBC(i,J,k) = v_av(i,J,k) + v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) enddo ; enddo ; enddo endif @@ -439,7 +454,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, Gv, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -474,22 +489,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * v_bc_accel(i,J,k)) enddo ; enddo enddo call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, tv, forces, visc, dt, G, GV, US, & + 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 call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -518,7 +533,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & + call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then @@ -533,8 +548,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & uh_ptr => uh_in; vh_ptr => vh_in call safe_alloc_ptr(u_ptr, G%IsdB,G%IedB,G%jsd,G%jed,G%ke) call safe_alloc_ptr(v_ptr, G%isd,G%ied,G%JsdB,G%JedB,G%ke) - u_ptr(:,:,:) = US%m_s_to_L_T*u(:,:,:) - v_ptr(:,:,:) = US%m_s_to_L_T*v(:,:,:) + u_ptr(:,:,:) = u(:,:,:) + v_ptr(:,:,:) = v(:,:,:) endif u_init => u ; v_init => v @@ -542,8 +557,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & 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(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & - US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & + 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, & OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & @@ -558,18 +573,18 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) + call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -577,7 +592,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & - symmetric=sym, vel_scale=1.0) + symmetric=sym, vel_scale=US%L_T_to_m_s) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) endif @@ -586,26 +601,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt_pred d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) if (CS%debug) then - call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) + call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -625,16 +626,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_continuity) if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") @@ -643,12 +637,26 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then if (CS%debug) & - call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) + enddo ; enddo ; enddo if (CS%debug) & - call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) ! These should be done with a pass that excludes uh & vh. ! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) @@ -703,7 +711,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) @@ -713,7 +721,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & + call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) call cpu_clock_end(id_clock_horvisc) @@ -721,7 +729,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -759,14 +767,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_begin(id_clock_btstep) if (CS%BT_use_layer_fluxes) then uh_ptr => uh ; vh_ptr => vh ! ; u_ptr => u_av ; v_ptr => v_av - u_ptr(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) - v_ptr(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) + u_ptr(:,:,:) = u_av(:,:,:) + v_ptr(:,:,:) = v_av(:,:,:) endif if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the corrector step call to btstep. - call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & - CS%eta_PF, US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, CS%u_accel_bt, CS%v_accel_bt, & + 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, OBC=CS%OBC, & BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & @@ -789,18 +797,18 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & + u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & + v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) + call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -813,23 +821,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) @@ -856,15 +850,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo 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 @@ -879,7 +866,21 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -901,6 +902,21 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo ; enddo enddo + !### Remove this later. + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo + ! The time-averaged free surface height has already been set by the last ! call to btstep. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 611319c706..d51ab1b526 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -222,9 +222,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() real :: dt_pred ! The time step for the predictor part of the baroclinic ! time stepping. @@ -234,6 +234,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt / 3.0 + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 @@ -249,13 +257,13 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) endif ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, Varmix, & + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -263,7 +271,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*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, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -282,10 +290,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s*CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + US%s_to_T*dt * CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s*CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + US%s_to_T*dt * CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) @@ -299,7 +307,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(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -323,17 +331,17 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up = u + dt_pred * (PFu + CAu) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & - US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & - US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -341,34 +349,20 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & + call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, & + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) @@ -381,7 +375,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(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -405,48 +399,34 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * 0.5 * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * 0.5 * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - upp(I,j,k) = US%m_s_to_L_T*upp(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vpp(i,J,k) = US%m_s_to_L_T*vpp(i,J,k) - enddo ; enddo ; enddo call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - upp(I,j,k) = US%L_T_to_m_s*upp(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vpp(i,J,k) = US%L_T_to_m_s*vpp(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(upp, vpp, G%Domain, clock=id_clock_pass) ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, & + call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) @@ -477,7 +457,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(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -497,38 +477,24 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo + call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -544,6 +510,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (dyn_p_surf) deallocate(p_surf) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index ddbdc84364..d80b786a8a 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -234,8 +234,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! Eddy Kinetic Energy. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() real :: dt_pred ! The time step for the predictor part of the baroclinic ! time stepping. @@ -245,6 +245,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt * CS%BE + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo ; enddo + h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 @@ -260,13 +268,13 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) endif ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & + call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -279,7 +287,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(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) @@ -295,7 +303,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(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -322,11 +330,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt_pred * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt_pred * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -338,34 +346,20 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*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, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -376,11 +370,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) ! 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(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then @@ -392,57 +386,29 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * (1.+CS%begw) * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * & + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * (1.+CS%begw) * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * & + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo - call vertvisc_coef(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo ; enddo call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) call pass_vector(u_in, v_in, G%Domain, clock=id_clock_pass) @@ -450,7 +416,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(US%m_s_to_L_T*up, US%m_s_to_L_T*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, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -466,7 +432,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -482,6 +448,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (dyn_p_surf) deallocate(p_surf) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) + enddo ; enddo ; enddo + ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) From 7b0875f86d77aeef3615e129b69d1839a0c5ed42 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 18:07:16 -0400 Subject: [PATCH 083/104] +Pass vels to radiation_open_bdry_conds in [L T-1] Passed the velocity arguments to radiation_open_bdry_conds in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 34 +---- src/core/MOM_open_boundary.F90 | 186 +++++++++++++++------------- 2 files changed, 100 insertions(+), 120 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 07910340e7..295d405ceb 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -310,7 +310,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [m s-1]. + ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. real :: Pa_to_eta ! A factor that converts pressures to the units of eta. real, pointer, dimension(:,:) :: & @@ -388,10 +388,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) + u_old_rad_OBC(I,j,k) = u_av(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) + v_old_rad_OBC(i,J,k) = v_av(i,J,k) enddo ; enddo ; enddo endif @@ -639,21 +639,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) - enddo ; enddo ; enddo if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -866,21 +852,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 93eb0005e5..4555ebaddf 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1524,17 +1524,18 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new !< On exit, new v values on open boundaries. - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: dt !< Appropriate timestep + real, intent(in) :: dt !< Appropriate timestep [s] ! Local variables - real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 + real :: dhdt, dhdx, dhdy ! One-point differences in time or space [m s-1] + real :: gamma_u, gamma_v, gamma_2 real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation @@ -1602,14 +1603,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G,segment,u_new,v_new) + if (segment%oblique) call gradient_at_q_points(G,segment,US%L_T_to_m_s*u_new(:,:,:),US%L_T_to_m_s*v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1617,13 +1618,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I-1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) 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 + dhdt = US%L_T_to_m_s*(u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new + dhdx = US%L_T_to_m_s*(u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha 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 @@ -1641,8 +1642,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -1650,7 +1652,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I-1,j,k) + segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -1677,7 +1679,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1699,15 +1701,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo endif @@ -1749,8 +1751,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -1774,10 +1777,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo @@ -1806,8 +1809,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (I>G%HI%IecB) cycle 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 + dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1815,13 +1818,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I+1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) 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 + dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha 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 @@ -1839,8 +1842,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -1848,7 +1852,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I+1,j,k) + segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0. on inflow in oblique case @@ -1875,7 +1879,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1897,15 +1901,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo endif @@ -1947,8 +1951,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -1972,11 +1977,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2004,8 +2009,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2013,13 +2018,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J-1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) 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 + dhdt = US%L_T_to_m_s*(v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new + dhdy = US%L_T_to_m_s*(v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 segment%ry_normal(i,J,k) = ry_avg 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) @@ -2038,10 +2043,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = US%m_s_to_L_T * & + segment%normal_vel(i,J,k) = & ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& - min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -2049,7 +2054,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J-1,k) + segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2076,7 +2081,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2098,15 +2103,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) +! rx_avg = v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) +! rx_avg = v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo @@ -2149,10 +2154,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + segment%tangential_vel(I,J,k) = & ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2176,11 +2181,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2208,8 +2213,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J>G%HI%JecB) cycle 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 + dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2217,13 +2222,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J+1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) 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 + dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha 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 @@ -2241,8 +2246,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -2250,7 +2256,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J+1,k) + segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2277,7 +2283,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2299,15 +2305,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) +! rx_avg = v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) +! rx_avg = v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo endif @@ -2349,10 +2355,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + segment%tangential_vel(I,J,k) = & ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2376,11 +2382,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2416,8 +2422,10 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) ! Arguments type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open boundaries - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open + !! boundaries [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open + !! boundaries [L T-1 ~> m s-1] ! Local variables integer :: i, j, k, n type(OBC_segment_type), pointer :: segment => NULL() @@ -2432,12 +2440,12 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) if (segment%is_E_or_W) then I=segment%HI%IsdB do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed - u(I,j,k) = G%US%L_T_to_m_s*segment%normal_vel(I,j,k) + u(I,j,k) = segment%normal_vel(I,j,k) enddo ; enddo elseif (segment%is_N_or_S) then J=segment%HI%JsdB do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied - v(i,J,k) = G%US%L_T_to_m_s*segment%normal_vel(i,J,k) + v(i,J,k) = segment%normal_vel(i,J,k) enddo ; enddo endif endif @@ -2481,8 +2489,8 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(OBC_segment_type), pointer :: segment !< OBC segment structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [m s-1] integer :: i,j,k if (.not. segment%on_pe) return From 3d594e0ca9bf38002aeea6a3c59e5bca0601b526 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 14:01:03 -0400 Subject: [PATCH 084/104] MOM_dyn_split_RK2_CS%u_av in units of [L T-1] Use units of [L T-1] for MOM_dyn_split_RK2_CS%u_av and ...%v_av at all times. Also eliminated the use of unnecessary pointers and eliminated some unused variables. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 88 +++++++++++------------------ 1 file changed, 32 insertions(+), 56 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 295d405ceb..7dae7774a3 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -87,7 +87,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt !< The zonal layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v !< Both the fraction of the meridional momentum originally in !! a layer that remains after a time-step of viscosity, and the @@ -97,7 +97,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt !< The meridional layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq @@ -105,10 +105,10 @@ module MOM_dynamics_split_RK2 !! mode) [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer !! thicknesses [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and @@ -301,12 +301,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj - ! u_adj and v_adj are the zonal or meridional velocities after u and v - ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out [m s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are @@ -320,9 +314,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, pointer, dimension(:,:,:) :: & uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & - u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - u_av, & ! The zonal velocity time-averaged over a time step [m s-1]. - v_av, & ! The meridional velocity time-averaged over a time step [m s-1]. + 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 :: Idt logical :: dyn_p_surf @@ -351,13 +344,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied v(i,J,k) = US%m_s_to_L_T*v(i,J,k) enddo ; enddo ; enddo - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) - enddo ; enddo ; enddo !$OMP parallel do default(shared) do k=1,nz @@ -370,7 +356,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -544,15 +530,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%BT_use_layer_fluxes) then - ! uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v - uh_ptr => uh_in; vh_ptr => vh_in - call safe_alloc_ptr(u_ptr, G%IsdB,G%IedB,G%jsd,G%jed,G%ke) - call safe_alloc_ptr(v_ptr, G%isd,G%ied,G%JsdB,G%JedB,G%ke) - u_ptr(:,:,:) = u(:,:,:) - v_ptr(:,:,:) = v(:,:,:) + uh_ptr => uh_in ; vh_ptr => vh_in; u_ptr => u ; v_ptr => v endif - u_init => u ; v_init => v call cpu_clock_begin(id_clock_btstep) if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") @@ -573,11 +553,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo @@ -588,11 +568,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & - symmetric=sym, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & + symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) endif @@ -697,10 +677,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -752,9 +732,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! pbce = dM/deta call cpu_clock_begin(id_clock_btstep) if (CS%BT_use_layer_fluxes) then - uh_ptr => uh ; vh_ptr => vh ! ; u_ptr => u_av ; v_ptr => v_av - u_ptr(:,:,:) = u_av(:,:,:) - v_ptr(:,:,:) = v_av(:,:,:) + uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av endif if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") @@ -768,9 +746,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo - if (associated(u_ptr)) deallocate(u_ptr) - if (associated(v_ptr)) deallocate(v_ptr) - call cpu_clock_end(id_clock_btstep) if (showCallTree) call callTree_leave("btstep()") @@ -783,11 +758,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo @@ -798,7 +773,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -882,12 +857,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied v(i,J,k) = US%L_T_to_m_s*v(i,J,k) enddo ; enddo ; enddo - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo ! The time-averaged free surface height has already been set by the last ! call to btstep. @@ -909,9 +878,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") @@ -1050,6 +1019,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 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 @@ -1208,8 +1179,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = u(:,:,:) - CS%v_av(:,:,:) = v(:,:,:) + CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) + CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) + elseif ( (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) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif ! This call is just here to initialize uh and vh. @@ -1262,9 +1238,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & - 'Barotropic-step Averaged Zonal Velocity', 'm s-1') + 'Barotropic-step Averaged Zonal Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & - 'Barotropic-step Averaged Meridional Velocity', 'm s-1') + 'Barotropic-step Averaged Meridional Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) From dd89a5ddd6f57968e3d9ee426e4d41754341b879 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 16:40:40 -0400 Subject: [PATCH 085/104] +Pass velocities to step_MOM_dyn_... in [L T-1] Passed the velocity arguments to step_MOM_dyn_split_RK2, step_MOM_dyn_unsplit, step_MOM_dyn_unsplit_RK2, initialize_dyn_split_RK2, initialize_dyn_unsplit and initialize_dyn_unsplit_RK2 in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM.F90 | 35 +++++++++++++++++++++ src/core/MOM_dynamics_split_RK2.F90 | 45 +++++++++------------------ src/core/MOM_dynamics_unsplit.F90 | 32 +++++-------------- src/core/MOM_dynamics_unsplit_RK2.F90 | 30 +++++------------- 4 files changed, 65 insertions(+), 77 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c45d017036..0053a7dd81 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -979,6 +979,15 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call disable_averaging(CS%diag) endif + + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -1019,6 +1028,14 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) @@ -2321,6 +2338,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) + + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + CS%u(I,j,k) = US%m_s_to_L_T*CS%u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + CS%v(i,J,k) = US%m_s_to_L_T*CS%v(i,J,k) + enddo ; enddo ; enddo + if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2354,6 +2380,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc) endif + + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) + enddo ; enddo ; enddo + call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 7dae7774a3..9f3aca1d4b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -238,9 +238,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & 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_(G)), & - target, intent(inout) :: u !< zonal velocity [m s-1] + target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity [m s-1] + target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type @@ -337,14 +337,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - !$OMP parallel do default(shared) do k=1,nz do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo @@ -849,15 +841,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo ; enddo enddo - !### Remove this later. - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! The time-averaged free surface height has already been set by the last ! call to btstep. @@ -976,9 +959,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 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_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< merid velocity [m s-1] + intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -1155,13 +1138,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - call barotropic_init(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%eta, Time, G, GV, US, param_file, diag, & + call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) then - call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, VarMix, & + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) else @@ -1179,22 +1162,24 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) - CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ; CS%u_av(I,j,k) = u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = v(i,J,k) ; enddo ; enddo ; enddo elseif ( (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) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif ! This call is just here to initialize uh and vh. if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then - h_tmp(:,:,:) = h(:,:,:) - call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + 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 pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) - CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) + 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)) + enddo ; enddo ; enddo else if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index d51ab1b526..879310f2fa 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -187,8 +187,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -234,14 +234,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt / 3.0 - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 @@ -257,7 +249,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -341,7 +333,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -409,7 +401,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -494,7 +486,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -510,14 +502,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (dyn_p_surf) deallocate(p_surf) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) @@ -581,9 +565,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity [m s-1]. + intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity [m s-1]. + intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index d80b786a8a..7a67254d71 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -191,9 +191,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, !! [H ~> m or kg m-2], depending on whether !! the Boussinesq approximation is made. @@ -245,14 +245,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt * CS%BE - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo ; enddo - h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 @@ -268,7 +260,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -370,7 +362,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) ! 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) @@ -432,7 +424,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -448,14 +440,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (dyn_p_surf) deallocate(p_surf) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) - enddo ; enddo ; enddo - ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) @@ -525,8 +509,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse From 8d96f8d48e1bd0b18a535f0931b937e1b283437b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 17:46:09 -0400 Subject: [PATCH 086/104] Introduced dt_in_T to step_MOM_dyn... Introduced a new variable, dt_in_T, that is the time step in [T] to the three step_MOM_dyn... subroutines. Also changed the units of dt_pred from [s] to [T]. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 35 +++++++++++++++------------ src/core/MOM_dynamics_unsplit.F90 | 32 ++++++++++++------------ src/core/MOM_dynamics_unsplit_RK2.F90 | 30 ++++++++++++----------- 3 files changed, 52 insertions(+), 45 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 9f3aca1d4b..17beedc723 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -276,8 +276,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! fields related to the surface wave conditions ! local variables - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. @@ -317,7 +315,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - real :: Idt + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. + + real :: Idt ! The inverse of the timestep [s-1] logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -330,6 +331,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta + + dt_in_T = US%s_to_T*dt Idt = 1.0 / dt sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums @@ -467,10 +470,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * v_bc_accel(i,J,k)) enddo ; enddo enddo @@ -539,17 +542,17 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_end(id_clock_btstep) ! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt * CS%be + dt_pred = dt_in_T * CS%be call cpu_clock_begin(id_clock_mom_update) !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo @@ -575,9 +578,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + call vertvisc(up, vp, h, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then @@ -585,7 +588,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) @@ -611,7 +614,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, US%T_to_s*dt_pred) if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -750,11 +753,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo @@ -834,10 +837,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt_in_T enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt_in_T enddo ; enddo enddo diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 879310f2fa..1dc08b0abe 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -226,13 +226,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() - real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_pred = dt / 3.0 + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T / 3.0 h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 @@ -282,16 +283,16 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + US%s_to_T*dt * CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + dt_in_T * CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + US%s_to_T*dt * CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + dt_in_T * CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -323,11 +324,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up = u + dt_pred * (PFu + CAu) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -344,6 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) + !### I think that the time steps in the next two calls should be dt_pred. call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & @@ -391,11 +393,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * 0.5 * & + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * 0.5 * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * 0.5 * & + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * 0.5 * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -440,10 +442,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo @@ -469,11 +471,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 7a67254d71..c4be7f96b9 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -237,13 +237,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() + real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + ! time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_pred = dt * CS%BE + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T * CS%BE h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 @@ -279,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, & + call continuity(u_in, v_in, h_in, hp, uh, vh, US%T_to_s*dt_pred, G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) @@ -322,11 +324,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_pred * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_pred * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -338,12 +340,12 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & + call vertvisc(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -378,15 +380,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * (1.+CS%begw) * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * (1.+CS%begw) * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * & + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * (1.+CS%begw) * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * (1.+CS%begw) * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * & + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo @@ -416,10 +418,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + US%s_to_T*dt*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt_in_T*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + US%s_to_T*dt*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt_in_T*vh(i,J,k) enddo ; enddo enddo From 80523af9df627359465924a0af2d4f0b5a77ddd4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 18:36:43 -0400 Subject: [PATCH 087/104] +Point MIS%u_prev to MOM_control_struct%u_prev MIS%u_prev is supposed to point to MOM_control_struct%u_prev, but somehow this was not happening. This has now been fixed, and the units of MIS%u_prev are now [L T-1]. Also corrected units in the documentation of ocean_internal_state. This will restore some diagnostics of truncations that were present in the code but have been disabled for some time. The model solutions are bitwise identical. --- src/core/MOM.F90 | 81 ++++++++++-------------------- src/core/MOM_variables.F90 | 16 +++--- src/diagnostics/MOM_PointAccel.F90 | 20 ++++---- 3 files changed, 44 insertions(+), 73 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0053a7dd81..af534f90de 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -251,8 +251,8 @@ module MOM type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) real, dimension(:,:,:), pointer :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics [m s-1] - v_prev => NULL() !< previous value of v stored for diagnostics [m s-1] + u_prev => NULL(), & !< previous value of u stored for diagnostics [L T-1 ~> m s-1] + v_prev => NULL() !< previous value of v stored for diagnostics [L T-1 ~> m s-1] logical :: interp_p_surf !< If true, linearly interpolate surface pressure !! over the coupling time step, using specified value @@ -615,6 +615,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + !=========================================================================== ! This is the first place where the diabatic processes and remapping could occur. if (CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics. @@ -644,27 +652,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & end_time_thermo = Time_local + real_to_time(dtdia-dt) endif - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") @@ -759,27 +751,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! by the call to step_MOM_thermo, noting that they end at the same time. if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia @@ -804,6 +780,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_dynamics) endif + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + !=========================================================================== ! Calculate diagnostics at the end of the time step if the state is self-consistent. if (MOM_state_is_synchronized(CS)) then @@ -972,7 +956,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(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(US%m_s_to_L_T*CS%u(:,:,:), US%m_s_to_L_T*CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & + call set_viscous_BBL(CS%u(:,:,:), CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") @@ -980,14 +964,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -1028,14 +1004,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) @@ -2100,6 +2068,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (debug_truncations) then allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz)) ; CS%u_prev(:,:,:) = 0.0 allocate(CS%v_prev(isd:ied,JsdB:JedB,nz)) ; CS%v_prev(:,:,:) = 0.0 + MOM_internal_state%u_prev => CS%u_prev + MOM_internal_state%v_prev => CS%v_prev call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(CS%ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) if (.not.CS%adiabatic) then @@ -2429,7 +2399,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! now register some diagnostics since the tracer registry is now locked call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) - call register_diags(Time, G, GV, CS%IDs, CS%diag) + call register_diags(Time, G, GV, US, CS%IDs, CS%diag) call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm) @@ -2575,10 +2545,11 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) end subroutine finish_MOM_initialization !> Register certain diagnostics -subroutine register_diags(Time, G, GV, IDs, diag) +subroutine register_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type type(MOM_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -2594,9 +2565,9 @@ subroutine register_diags(Time, G, GV, IDs, diag) ! Diagnostics of the rapidly varying dynamic state IDs%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, Time, & - 'Zonal velocity after the dynamics update', 'm s-1') + 'Zonal velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, Time, & - 'Meridional velocity after the dynamics update', 'm s-1') + 'Meridional velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_h = register_diag_field('ocean_model', 'h_dyn', diag%axesTL, Time, & 'Layer Thickness after the dynamics update', thickness_units, & v_extensive=.true., conversion=H_convert) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index aeea2329b6..36148f69ba 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -134,21 +134,21 @@ module MOM_variables uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] vh => NULL() !< Pointer to meridional transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & - CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] - CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] + CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [L T-2 ~> m s-2] + CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [L T-2 ~> m s-2] PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [L T-2 ~> m s-2] PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [L T-2 ~> m s-2] - diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] - diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [L T-2 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2] u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] - v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] - u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [m s-1] - v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [m s-1] + u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [L T-1 ~> m s-1] + v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [L T-1 ~> m s-1] + u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [L T-1 ~> m s-1] + v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [L T-1 ~> m s-1] end type ocean_internal_state !> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index e78e6133f3..e0bbd832bb 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -49,8 +49,8 @@ module MOM_PointAccel 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 [m s-1]. - v_prev => NULL(), & !< Previous v-velocity [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] @@ -166,7 +166,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*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," ",$)') (CS%u_prev(I,j,k)); enddo + 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 endif write(file,'(/,"u(3): ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%u_av(I,j,k)); enddo @@ -185,7 +185,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 + (US%L_T_to_m_s*(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 @@ -336,7 +336,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! 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) + 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 Inorm(k) = 1.0 / du enddo @@ -346,7 +346,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 + (US%L_T_to_m_s*(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," ",$)') & @@ -497,7 +497,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (prev_avail) then write(file,'(/,"v(mp): ",$)') - 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," ",$)') (US%L_T_to_m_s*CS%v_prev(i,J,k)); enddo endif write(file,'(/,"v(3): ",$)') @@ -516,7 +516,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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 + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))); enddo endif write(file,'(/,"CAv: ",$)') @@ -670,7 +670,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! 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) + 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 Inorm(k) = 1.0 / dv enddo @@ -679,7 +679,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/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 + (US%L_T_to_m_s*(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 From d0077ea391e408445e5a2504f5b7b9c6727620c6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 19:19:14 -0400 Subject: [PATCH 088/104] +Pass velocities to calculate_diagnostic_fields in [L T-1] Pass velocities to calculate_diagnostic_fields in [L T-1]. Also rearranged some code in calculate_diagnostic_fields to calculate time derivatives before they are posted or used and to check whether the diagnostics module is initialized before its control structure is used. The energy diagnostics and the diagnostics of the total acceleration should have been corrected. All diagnostics should have been properly rescaled for output, and all solutions are bitwise identical. --- src/core/MOM.F90 | 32 +++++++++--------- src/diagnostics/MOM_diagnostics.F90 | 50 ++++++++++++++--------------- 2 files changed, 41 insertions(+), 41 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index af534f90de..2b9f5173d3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -780,14 +780,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_dynamics) endif - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - !=========================================================================== ! Calculate diagnostics at the end of the time step if the state is self-consistent. if (MOM_state_is_synchronized(CS)) then @@ -808,6 +800,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) endif + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if (do_dyn .and. .not.CS%count_calls) CS%nstep_tot = CS%nstep_tot + 1 if (showCallTree) call callTree_leave("DT cycles (step_MOM)") @@ -2351,14 +2351,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%ntrunc) endif - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) - enddo ; enddo ; enddo - call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & @@ -2375,6 +2367,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) + enddo ; enddo ; enddo + if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b853ee668b..54025a0ac0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -66,8 +66,8 @@ module MOM_diagnostics ! following fields have nz layers. real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [m s-2] - dv_dt => NULL(), & !< net j-acceleration [m s-2] + du_dt => NULL(), & !< net i-acceleration [L T-1 s-1 ~> m s-2] + dv_dt => NULL(), & !< net j-acceleration [L T-1 s-1 ~> m s-2] dh_dt => NULL(), & !< thickness rate of change [H s-1 ~> m s-1 or kg m-2 s-1] p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] @@ -188,9 +188,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -251,6 +251,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = G%ke ; nkmb = GV%nk_rho_varies + if (loc(CS)==0) call MOM_error(FATAL, & + "calculate_diagnostic_fields: Module must be initialized before used.") + + call calculate_derivs(dt, G, CS) + if (dt > 0.0) then call diag_save_grids(CS%diag) call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) @@ -277,11 +282,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! one iteration that would break the following one-line workaround! if (nkmb==0 .and. nz > 1) nkmb = nz - if (loc(CS)==0) call MOM_error(FATAL, & - "calculate_diagnostic_fields: Module must be initialized before used.") - - call calculate_derivs(dt, G, CS) - if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) if (CS%id_v > 0) call post_data(CS%id_v, v, CS%diag) @@ -629,7 +629,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * sqrt(0.5 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((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 + & @@ -678,7 +678,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * sqrt(0.5 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((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 + & @@ -882,9 +882,9 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -916,7 +916,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS 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)) + & + CS%KE(i,j,k) = US%L_T_to_m_s**2*((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. @@ -936,13 +936,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*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) = CS%KE(i,j,k)*US%s_to_T*CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1123,14 +1123,14 @@ end subroutine register_time_deriv !> This subroutine calculates all registered time derivatives. subroutine calculate_derivs(dt, G, CS) - real, intent(in) :: dt !< The time interval over which differences occur [s]. + real, intent(in) :: dt !< The time interval over which differences occur [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine calculates all registered time derivatives. - integer i, j, k, m - real Idt + real :: Idt ! The inverse timestep [T-1 ~> s-1] + integer :: i, j, k, m if (dt > 0.0) then ; Idt = 1.0/dt else ; return ; endif @@ -1544,10 +1544,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & - 'Zonal velocity', 'm s-1', cmor_field_name='uo', & + 'Zonal velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='uo', & cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & - 'Meridional velocity', 'm s-1', cmor_field_name='vo', & + 'Meridional velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='vo', & cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') CS%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) @@ -1574,21 +1574,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'In situ density', 'kg m-3') CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & - 'Zonal Acceleration', 'm s-2') + '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') + '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", v_extensive = .true.) + '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) From 897fa670a80363fa39cf6b5cd8462d7a36f0fab6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 05:21:57 -0400 Subject: [PATCH 089/104] +Change units of MOM_control_struct%u to [L T-1] Changed the units of MOM_control_struct%u and ...%v to [L T-1] for greater dimensional consistency testing, and return velocities from MOM_initialize_state in units of [L T-1]. This step includes changing the units of u and v in the restart files to [L T-1]. All answers are bitwise identical. --- src/core/MOM.F90 | 88 ++++++------------- .../MOM_state_initialization.F90 | 32 +++++-- 2 files changed, 53 insertions(+), 67 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2b9f5173d3..df4fbba77d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -155,11 +155,11 @@ module MOM T, & !< potential temperature [degC] S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u, & !< zonal velocity component [m s-1] + u, & !< zonal velocity component [L T-1 ~> m s-1] uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v, & !< meridional velocity [m s-1] + v, & !< meridional velocity [L T-1 ~> m s-1] 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 @@ -461,8 +461,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ssh ! sea surface height, which may be based on eta_av [m] real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component [m s-1] - v => NULL(), & ! v : meridional velocity component [m s-1] + u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] + v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1] h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -615,14 +615,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - !=========================================================================== ! This is the first place where the diabatic processes and remapping could occur. if (CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics. @@ -800,14 +792,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) endif - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if (do_dyn .and. .not.CS%count_calls) CS%nstep_tot = CS%nstep_tot + 1 if (showCallTree) call callTree_leave("DT cycles (step_MOM)") @@ -837,12 +821,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & enddo ; enddo ; endif if (CS%ensemble_ocean) then - ! update the time for the next analysis step if needed - call set_analysis_time(CS%Time,CS%odaCS) - ! store ensemble vector in odaCS - call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) - ! call DA interface - call oda(CS%Time,CS%odaCS) + ! update the time for the next analysis step if needed + call set_analysis_time(CS%Time,CS%odaCS) + ! store ensemble vector in odaCS + call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) + ! call DA interface + call oda(CS%Time,CS%odaCS) endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") @@ -870,7 +854,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & G, CS%sum_output_CSp) if (MOM_state_is_synchronized(CS)) & - call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & + call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=real_to_time(time_interval) ) @@ -2199,7 +2183,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth endif - ! At this point, all user-modified initialization code has been called. The ! remainder of this subroutine is controlled by the parameters that have ! have already been set. @@ -2309,14 +2292,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%u(I,j,k) = US%m_s_to_L_T*CS%u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%v(i,J,k) = US%m_s_to_L_T*CS%v(i,J,k) - enddo ; enddo ; enddo - if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2367,14 +2342,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) - enddo ; enddo ; enddo - if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) @@ -2536,7 +2503,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & + call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") @@ -2726,12 +2693,13 @@ subroutine extract_surface_state(CS, sfc_state) ! local real :: hu, hv ! Thicknesses interpolated to velocity points [H ~> m or kg m-2] - type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing + type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing !! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - real, dimension(:,:,:), pointer :: & - u => NULL(), & !< u : zonal velocity component [m s-1] - v => NULL(), & !< v : meridional velocity component [m s-1] + type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info + type(unit_scale_type), pointer :: US => NULL() !< structure containing various unit conversion factors + real, dimension(:,:,:), pointer :: & +! u => NULL(), & !< u : zonal velocity component [m s-1] +! v => NULL(), & !< v : meridional velocity component [m s-1] h => NULL() !< h : layer thickness [H ~> m or kg m-2] real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed @@ -2749,12 +2717,12 @@ subroutine extract_surface_state(CS, sfc_state) character(240) :: msg call callTree_enter("extract_surface_state(), MOM.F90") - G => CS%G ; GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US 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 iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB isdB = G%isdB ; iedB = G%iedB; jsdB = G%jsdB ; jedB = G%jedB - u => CS%u ; v => CS%v ; h => CS%h + h => CS%h use_temperature = associated(CS%tv%T) @@ -2788,10 +2756,10 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%SSS(i,j) = CS%tv%S(i,j,1) enddo ; enddo ; endif do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo else ! (CS%Hmix >= 0.0) @@ -2864,7 +2832,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%v(i,J) = sfc_state%v(i,J) + dh * v(i,J,k) + sfc_state%v(i,J) = sfc_state%v(i,J) + dh * US%L_T_to_m_s * CS%v(i,J,k) depth(i) = depth(i) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2890,7 +2858,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%u(I,j) = sfc_state%u(I,j) + dh * u(I,j,k) + sfc_state%u(I,j) = sfc_state%u(I,j) + dh * US%L_T_to_m_s * CS%u(I,j,k) depth(I) = depth(I) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2902,10 +2870,10 @@ subroutine extract_surface_state(CS, sfc_state) enddo ! end of j loop else ! Hmix_UV<=0. do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo endif endif ! (CS%Hmix >= 0.0) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0beda5477c..241ce01b76 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -126,10 +126,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< The meridional velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic @@ -153,9 +153,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: dt ! The baroclinic dynamics timestep for this run [s]. + 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 :: dt ! The baroclinic dynamics timestep for this run [s]. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -424,9 +426,19 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "Unrecognized velocity configuration "//trim(config)) end select + ! This rescaling should be incorporated into the calls above. + if (new_sim) then + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + endif + 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) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly @@ -493,6 +505,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & 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 endif + if ( (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) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; u(I,j,k) = vel_rescale * u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; v(i,J,k) = vel_rescale * v(i,J,k) ; enddo ; enddo ; enddo + endif endif if ( use_temperature ) then @@ -535,7 +553,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("RGC"); call RGC_initialize_sponges(G, GV, tv, u, v, PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, tv, US%L_T_to_m_s*u(:,:,:), US%L_T_to_m_s*v(:,:,:), PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & From 29bb12b8384134c04e6d2e5ff1fcbec774d5d1bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 06:53:42 -0400 Subject: [PATCH 090/104] +initialize_vel routines pass velocities in [L T-1] Changed initialize_velocity routines to return velocities in [L T-1], including ..._from_file, ..._uniform, ..._circular, soliton_..., Phillips_..., Rossby_front_..., and USER_initialize_velocity. Several of these routines required new unit_scale_type arguments. Also added the target attribute to the u and v arguments to RGC_initialize_sponges and cleaned up indenting in RGC_initialization to comply with MOM6 2-point indent standards. All answers are bitwise identical in the MOM6-examples test cases, but there are new arguments and unit changes in multiple public interfaces. --- .../MOM_state_initialization.F90 | 55 ++++---- src/user/Phillips_initialization.F90 | 28 ++-- src/user/RGC_initialization.F90 | 129 +++++++++--------- src/user/Rossby_front_2d_initialization.F90 | 8 +- src/user/soliton_initialization.F90 | 22 +-- src/user/user_initialization.F90 | 7 +- 6 files changed, 127 insertions(+), 122 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 241ce01b76..67959c9d9b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -407,35 +407,25 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, PF, & + case ("file"); call initialize_velocity_from_file(u, v, G, US, PF, & just_read_params=just_read) case ("zero"); call initialize_velocity_zero(u, v, G, PF, & just_read_params=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, PF, & + case ("uniform"); call initialize_velocity_uniform(u, v, G, US, PF, & just_read_params=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, PF, & + case ("circular"); call initialize_velocity_circular(u, v, G, US, PF, & just_read_params=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read_params=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G) - case ("USER"); call user_initialize_velocity(u, v, G, PF, & + case ("soliton"); call soliton_initialize_velocity(u, v, h, G, US) + case ("USER"); call user_initialize_velocity(u, v, G, US, PF, & just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select - ! This rescaling should be incorporated into the calls above. - if (new_sim) then - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - endif - 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) @@ -553,7 +543,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("RGC"); call RGC_initialize_sponges(G, GV, tv, US%L_T_to_m_s*u(:,:,:), US%L_T_to_m_s*v(:,:,:), PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, tv, u, v, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & @@ -1256,12 +1246,13 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & end subroutine cut_off_column_top !> Initialize horizontal velocity components from file -subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + 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 @@ -1290,7 +1281,7 @@ subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) " initialize_velocity_from_file: Unable to open "//trim(filename)) ! Read the velocities from a netcdf file. - call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:),G%Domain) + call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file @@ -1299,9 +1290,9 @@ end subroutine initialize_velocity_from_file subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + 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 modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1330,12 +1321,13 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + 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 @@ -1352,10 +1344,10 @@ subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "INITIAL_V_CONST", initial_v_const, & "A initial uniform value for the meridional flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1370,12 +1362,13 @@ 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, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + 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 @@ -1394,7 +1387,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, 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].", & - units="m s-1", default=0., do_not_log=just_read) + units="m s-1", default=0., scale=US%L_T_to_m_s, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index af17bb87a5..29e049c9b6 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -51,7 +51,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: jet_width ! The width of the zonal-mean jet [km] real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] - real :: y_2 + 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. @@ -120,18 +120,22 @@ end subroutine Phillips_initialize_thickness subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] 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. - real :: jet_width, jet_height, x_2, y_2 - real :: velocity_amplitude, pi + real :: jet_width ! The width of the zonal-mean jet [km] + real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] + real :: x_2 ! The x-position relative to the center of the domain [nondim] + real :: y_2 ! The y-position relative to the center of the domain [km] or [nondim] + 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. character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. @@ -142,7 +146,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p 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.", & - units="m s-1", default=0.001, do_not_log=just_read) + units="m s-1", default=0.001, scale=US%m_s_to_L_T, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -163,12 +167,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p y_2 = G%geoLatCu(I,j) - G%south_lat - 0.5*G%len_lat ! This uses d/d y_2 atan(y_2 / jet_width) ! u(I,j,k) = u(I,j,k+1) + (1e-3 * jet_height / & -! (jet_width * (1.0 + (y_2 / jet_width)**2))) * & -! (2.0 * US%L_to_m**2*US%s_to_T**2*GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) +! (US%m_to_L*jet_width * (1.0 + (y_2 / jet_width)**2))) * & +! (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) ! This uses d/d y_2 tanh(y_2 / jet_width) - u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / jet_width) * & + u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / (US%m_to_L*jet_width)) * & (sech(y_2 / jet_width))**2 ) * & - (2.0 * US%L_to_m**2*US%s_to_T**2*GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) + (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index f0000dc03d..d5f2bb608b 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -44,9 +44,8 @@ module RGC_initialization contains -!> Sets up the the inverse restoration time (Idamp), and -! the values towards which the interface heights and an arbitrary -! number of tracers should be restored within each sponge. +!> Sets up the the inverse restoration time, and the values towards which the interface heights, +!! velocities and tracers should be restored within the sponges for the RGC test case. subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -55,8 +54,10 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< u velocity. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< v velocity. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(in) :: v !< Array with the v velocity [L T-1 ~> m s-1] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -67,12 +68,12 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt - real :: U1(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for u - real :: V1(SZI_(G), SZJB_(G), SZK_(G)) ! A temporary array for v + real :: U1(SZIB_(G),SZJ_(G),SZK_(G)) ! A temporary array for u [L T-1 ~> m s-1] + real :: V1(SZI_(G),SZJB_(G),SZK_(G)) ! A temporary array for v [L T-1 ~> m s-1] real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [s-1]. real :: TNUDG ! Nudging time scale, days real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! @@ -118,9 +119,9 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - if (associated(CSp)) call MOM_error(FATAL, & + if (associated(CSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & + if (associated(ACSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! @@ -128,61 +129,61 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. - do i=is,ie; do j=js,je - if (G%geoLonT(i,j) <= lensponge) then - dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 - !damp = 1.0/TNUDG * max(0.0,dummy1) - damp = 0.0 - !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp + do i=is,ie ; do j=js,je + if (G%geoLonT(i,j) <= lensponge) then + dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 + !damp = 1.0/TNUDG * max(0.0,dummy1) + damp = 0.0 + !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp - elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then + elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then - ! 1 / day - dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) - damp = (1.0/TNUDG) * max(0.0,dummy1) +! 1 / day + dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) + damp = (1.0/TNUDG) * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif - ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo +! convert to 1 / seconds + if (G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif + enddo ; enddo - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) ! GM: get two different files, one with temp and one with salt values ! this is work around to avoid having wrong values near the surface ! because of the FIT_SALINITY option. To get salt values right in the ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & + call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & "The name of the file with temps., salts. and interfaces to \n"// & " damp toward.", fail_if_missing=.true.) - call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & + call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & "The name of the potential temperature variable in \n"//& "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & + call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & "The name of the salinity variable in \n"//& "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & + call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & "The name of the interface height variable in \n"//& "SPONGE_STATE_FILE.", default="eta") - call get_param(PF, mod, "SPONGE_H_VAR", h_var, & + call get_param(PF, mod, "SPONGE_H_VAR", h_var, & "The name of the layer thickness variable in \n"//& "SPONGE_STATE_FILE.", default="h") - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) - call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) - call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) + call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) + call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) - if (use_ALE) then + if (use_ALE) then call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) call pass_var(h, G%domain) @@ -199,37 +200,37 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) endif if (sponge_uv) then - U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 - call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) + U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 + call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) endif - else ! layer mode + else ! layer mode - !read eta - call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) + !read eta + call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) - ! Set the inverse 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) + ! Set the inverse 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) - if ( GV%nkml>0 ) then - ! This call to set_up_sponge_ML_density registers the target values of the - ! mixed layer density, which is used in determining which layers can be - ! inflated without causing static instabilities. - do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo + if ( GV%nkml>0 ) then + ! This call to set_up_sponge_ML_density registers the target values of the + ! mixed layer density, which is used in determining which layers can be + ! inflated without causing static instabilities. + do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo - do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo + do j=js,je + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo - call set_up_sponge_ML_density(tmp, G, CSp) - endif + call set_up_sponge_ML_density(tmp, G, CSp) + endif - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 9676464330..b991fa95bc 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -163,13 +163,13 @@ end subroutine Rossby_front_initialize_temperature_salinity subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call @@ -214,7 +214,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just zi = zi - hAtU ! Bottom interface position zc = zi - 0.5*hAtU ! Position of middle of cell zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer - u(I,j,k) = US%L_T_to_m_s * dUdT * Ty * zm ! Thermal wind starting at base of ML + u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML enddo enddo ; enddo diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 033a8f0e52..4351060fb8 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -63,14 +63,20 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, h, G) - type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m s-1] +subroutine soliton_initialize_velocity(u, v, h, G, US) + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] - - real :: x, y, x0, y0 - real :: val1, val2, val3, val4 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + real :: x, x0 ! Positions in the same units as geoLonT. + real :: y, y0 ! Positions in the same units as geoLatT. + real :: val1 ! A zonal decay scale in the inverse of the units of geoLonT. + real :: val2 ! An overall velocity amplitude [L T-1 ~> m s-1] + real :: val3 ! A decay factor [nondim] + real :: val4 ! The local velocity amplitude [L T-1 ~> m s-1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -78,7 +84,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = US%m_s_to_L_T * 0.771*(val1*val1) v(:,:,:) = 0.0 u(:,:,:) = 0.0 diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index bcf1942cad..64f4f84247 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -106,10 +106,11 @@ 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, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] + 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. From 57eb24bcae21700ebee4654e7281880cbd7fedb0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 07:26:56 -0400 Subject: [PATCH 091/104] +Pass velocities to write_energy in [L T-1] Pass velocities to write_energy in [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments to a public interface have changed. --- src/core/MOM.F90 | 4 ++-- src/diagnostics/MOM_sum_output.F90 | 21 ++++++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index df4fbba77d..3e41e075c1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -854,7 +854,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & G, CS%sum_output_CSp) if (MOM_state_is_synchronized(CS)) & - call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=real_to_time(time_interval) ) @@ -2503,7 +2503,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d2c21551ce..d6f495faa5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -305,9 +305,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -387,6 +387,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: H_to_kg_m2 ! Local copy of a unit conversion factor. + real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy + ! calculation [kg T2 L-2 s-2 H-1 ~> kg m-3 or nondim] 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 @@ -687,9 +689,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Calculate the Kinetic Energy integrated over each layer. + KE_scale_factor = GV%H_to_kg_m2*US%L_T_to_m_s**2 tmp1(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = (0.25 * H_to_kg_m2 * (areaTm(i,j) * h(i,j,k))) * & + tmp1(i,j,k) = (0.25 * KE_scale_factor * (areaTm(i,j) * h(i,j,k))) * & (u(I-1,j,k)**2 + u(I,j,k)**2 + v(i,J-1,k)**2 + v(i,J,k)**2) enddo ; enddo ; enddo KE_tot = reproducing_sum(tmp1, sums=KE) @@ -713,21 +716,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo From d645d98db72bba1e84d2facde3eb1eb9a8396e0e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 09:02:16 -0400 Subject: [PATCH 092/104] +Pass timestep to continuity in [T] Pass the timestep to continuity and continuity_PPM in [T]. All answers are bitwise identical, but the rescaled units of arguments to two public interfaces have changed. --- src/core/MOM_continuity.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 20 ++++++++++---------- src/core/MOM_dynamics_split_RK2.F90 | 8 ++++---- src/core/MOM_dynamics_unsplit.F90 | 6 +++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- 5 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 7e8d2d1843..9aaa6f92fc 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -57,7 +57,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 3a6021e6b5..8a8ecf9da5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -73,7 +73,7 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. @@ -89,7 +89,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & @@ -149,12 +149,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, 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, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, hin, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -164,12 +164,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, 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, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, h, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -180,24 +180,24 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, 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, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, hin, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, h, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 17beedc723..696953f649 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -514,7 +514,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & + call continuity(u, v, h, hp, uh_in, vh_in, dt_in_T, G, GV, US, CS%continuity_CSp, & OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then @@ -601,7 +601,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -806,7 +806,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(u, v, h, h, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) @@ -1178,7 +1178,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, h_tmp, uh, vh, US%s_to_T*dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) do k=1,nz ; do j=jsd,jed ; do i=isd,ied CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 1dc08b0abe..6ffc526f4a 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -264,7 +264,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt_in_T*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -356,7 +356,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, & + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt_in_T), G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) @@ -420,7 +420,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, & + call continuity(upp, vpp, hp, h, uh, vh, (dt_in_T*0.5), G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index c4be7f96b9..729dae15bb 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -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, US%T_to_s*dt_pred, G, GV, US, & + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) @@ -353,7 +353,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_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -410,7 +410,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_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) From e3b875467121e2118e76f1ed76effe77b4360cc8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 09:08:14 -0400 Subject: [PATCH 093/104] Rescaled MOM_open_boundary.F90 internal variables Rescaled internal variables in MOM_open_boundary.F90. There are some expressions with oblique boundary conditions that do not make sense to me and may be dimensionally inconsistent. All solutions are bitwise identical. --- src/core/MOM_open_boundary.F90 | 132 +++++++++++++++++---------------- 1 file changed, 68 insertions(+), 64 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 4555ebaddf..7c0ba4c6b4 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -156,11 +156,11 @@ module MOM_open_boundary !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment times a grid spacing [m s-1 L-1 ~> s-1] + !! segment times a grid spacing [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -1534,7 +1534,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: dt !< Appropriate timestep [s] ! Local variables - real :: dhdt, dhdx, dhdy ! One-point differences in time or space [m s-1] + real :: dhdt, dhdx, dhdy ! One-point differences in time or space [L T-1 ~> m s-1] real :: gamma_u, gamma_v, gamma_2 real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation @@ -1544,7 +1544,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() - real, parameter :: eps = 1.0e-20 + real :: eps ! A small velocity squared [L2 T-2 ~> m2 s-2]? type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n integer :: is_obc, ie_obc, js_obc, je_obc @@ -1556,6 +1556,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (.not.(OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) & return + eps = 1.0e-20*US%m_s_to_L_T**2 + !! Copy previously calculated phase velocity from global arrays into segments !! This is terribly inefficient and temporary solution for continuity across restarts !! and needs to be revisited in the future. @@ -1603,14 +1605,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G,segment,US%L_T_to_m_s*u_new(:,:,:),US%L_T_to_m_s*v_new(:,:,:)) + if (segment%oblique) call gradient_at_q_points(G, segment, u_new(:,:,:), v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1623,8 +1625,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new - dhdx = US%L_T_to_m_s*(u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 + 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 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 @@ -1633,9 +1635,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + ry_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -1643,7 +1646,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -1752,9 +1755,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1780,7 +1783,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo @@ -1809,8 +1812,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (I>G%HI%IecB) cycle do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then - dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + 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 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1823,8 +1826,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + 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 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 @@ -1833,9 +1836,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + ry_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new @@ -1843,9 +1847,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & - min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1952,9 +1956,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1980,8 +1984,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2009,8 +2013,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2023,8 +2027,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new - dhdy = US%L_T_to_m_s*(v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + 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 segment%ry_normal(i,J,k) = ry_avg 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) @@ -2034,20 +2038,20 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff,max(dhdt*dhdx,-cff)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + rx_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = & - ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& - min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -2154,11 +2158,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = & - ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2184,7 +2187,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2213,8 +2216,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J>G%HI%JecB) cycle do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) then - dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + 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 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2227,8 +2230,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + 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 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 @@ -2237,9 +2240,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff,max(dhdt*dhdx,-cff)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + rx_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -2247,7 +2251,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -2357,8 +2361,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = & ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2385,8 +2389,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2489,8 +2493,8 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(OBC_segment_type), pointer :: segment !< OBC segment structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k if (.not. segment%on_pe) return From 4b62f777dda06b488d60a5cc72d89b858f04e0d9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 09:17:46 -0400 Subject: [PATCH 094/104] Simplified a logical test in step_forward_MEKE Simplified a logical test in step_forward_MEKE to eliminate the addition of variables with different units. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9f43034564..5d6b71a576 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -168,7 +168,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - if ((US%s_to_T*CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & + if ((CS%MEKE_damping > 0.0) .or. (CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & .or. CS%visc_drag) then use_drag_rate = .true. else From 170c7be79ada580be976780f301b50b9f4e01c4b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 17:02:06 -0400 Subject: [PATCH 095/104] Rescaled taux_bot and tauy_bot to [kg L Z T-2 m-3] Rescaled the bottom drag returned from MOM_vert_friction and passed to btstep into units of [kg L Z T-2 m-3 ~> Pa] for greater dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 13 ++++++++----- src/core/MOM_dynamics_split_RK2.F90 | 6 ++++-- src/core/MOM_dynamics_unsplit.F90 | 6 ++++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 ++++-- .../vertical/MOM_vert_friction.F90 | 18 ++++++++++-------- 5 files changed, 30 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b3b0b1925c..8d48ebbb0b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -444,9 +444,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! gradient at the start of the barotropic stepping !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from - !! ocean to the seafloor [Pa]. + !! ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress - !! from ocean to the seafloor [Pa]. + !! from ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate @@ -581,6 +581,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1]. + real :: mass_accel_to_Z ! The depth unit converison times an acceleration conversion divided by + ! the mean density (Rho0) [Z L m s2 T-2 kg-1 ~> m3 kg-1]. real :: 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]. @@ -722,7 +724,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dtbt = dt_in_T * Instep bebt = CS%bebt be_proj = CS%bebt - mass_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_accel_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_to_Z = US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -986,14 +989,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatu should be replaced by ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds). - BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_accel_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatv should be replaced by ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds). - BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_accel_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) enddo ; enddo if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 696953f649..1f43a699a1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -123,8 +123,10 @@ module MOM_dynamics_split_RK2 !! anomaly in each layer due to free surface height !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the !! effective summed open face areas as a function !! of barotropic flow. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6ffc526f4a..108f4c8943 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -116,8 +116,10 @@ module MOM_dynamics_unsplit PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] logical :: debug !< If true, write verbose checksums for debugging purposes. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 729dae15bb..af33db8011 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -113,8 +113,10 @@ module MOM_dynamics_unsplit_RK2 PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 9aadb526b7..1bed36e75e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -162,9 +162,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information @@ -325,10 +327,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = US%L_T2_to_m_s2*Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + US%L_T2_to_m_s2*Rho0 * (Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -406,10 +408,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (US%L_T2_to_m_s2*v(i,J,nz)*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%L_T2_to_m_s2*Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -1730,10 +1732,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) if ((len_trim(CS%u_trunc_file) > 0) .or. (len_trim(CS%v_trunc_file) > 0)) & call PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS%PointAccel_CSp) From a38b298e482258e70676383051c45e010f91bb68 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Tue, 20 Aug 2019 15:37:21 -0400 Subject: [PATCH 096/104] added diagnostic for internal heat in 3D --- .../vertical/MOM_geothermal.F90 | 26 +++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 15f1116190..8fb96e2c97 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,6 +35,8 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. + integer :: id_internal_heat_tend_3d = -1 ! ID for 3D diagnostic of internal heat + end type geothermal_CS contains @@ -100,6 +102,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer before any heat is added, for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer before any heat is added, for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to calculate change in heat due to geothermal + real :: Idt ! inverse of the timestep [s-1] + logical :: do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz, k2, i2 integer :: isj, iej, num_start, num_left, nkmb, k_tgt @@ -119,6 +126,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref + Idt = 1/dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") @@ -136,6 +144,10 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) +! Save temperature and thickness before any changes are made (for diagnostic) +temp_old = tv%T +h_old = h + do j=js,je ! 1. Only work on columns that are being heated. ! 2. Find the deepest layer with any mass. @@ -304,6 +316,14 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop +! Calculate heat tendency due to addition and transfer of internal heat +if (CS%id_internal_heat_tend_3d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + enddo ; enddo ; enddo + call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) +endif + ! do i=is,ie ; do j=js,je ! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & ! (G%mask2dT(i,j) * (CS%geo_heat(i,j) * (dt*Irho_cp))) @@ -392,6 +412,12 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) + ! Diagnostic for tendency due to internal heat (in 3d) + CS%id_internal_heat_tend_3d = register_diag_field('ocean_model',& + 'internal_heat_tend_3d', diag%axesTL, Time, & + 'Internal heat tendency in 3D, reveals layer(s) that heat is added to','W m-2',& + v_extensive = .true.) + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. From ee2e09059bd9e1040540e8a7beaab0ef6cb4f3a9 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Tue, 20 Aug 2019 16:49:55 -0400 Subject: [PATCH 097/104] further modifications to internal heat diagnostic --- .../vertical/MOM_geothermal.F90 | 44 +++++++++++-------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 8fb96e2c97..4121795766 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,7 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_internal_heat_tend_3d = -1 ! ID for 3D diagnostic of internal heat + integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat end type geothermal_CS @@ -102,9 +102,15 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer before any heat is added, for diagnostics [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer before any heat is added, for diagnostics [m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to calculate change in heat due to geothermal + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer + ! before any heat is added, + ! for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer + ! before any heat is added, + ! for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to + ! calculate change in heat + ! due to geothermal real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) @@ -126,7 +132,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref - Idt = 1/dt + Idt = 1.0 / dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") @@ -144,9 +150,9 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) -! Save temperature and thickness before any changes are made (for diagnostic) -temp_old = tv%T -h_old = h + ! Save temperature and thickness before any changes are made (for diagnostic) + temp_old = tv%T + h_old = h do j=js,je ! 1. Only work on columns that are being heated. @@ -316,13 +322,13 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop -! Calculate heat tendency due to addition and transfer of internal heat -if (CS%id_internal_heat_tend_3d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) - enddo ; enddo ; enddo - call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) -endif + ! Calculate heat tendency due to addition and transfer of internal heat + if (CS%id_internal_heat_tend_3d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + enddo ; enddo ; enddo + call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) + endif ! do i=is,ie ; do j=js,je ! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & @@ -413,10 +419,10 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) ! Diagnostic for tendency due to internal heat (in 3d) - CS%id_internal_heat_tend_3d = register_diag_field('ocean_model',& - 'internal_heat_tend_3d', diag%axesTL, Time, & - 'Internal heat tendency in 3D, reveals layer(s) that heat is added to','W m-2',& - v_extensive = .true.) + CS%id_internal_heat_tend_3d=register_diag_field('ocean_model', & + 'internal_heat_tend_3d', diag%axesTL, Time, & + 'Internal heat tendency in 3D, reveals layer(s) that heat is added to', & + 'W m-2', v_extensive = .true.) end subroutine geothermal_init From a3c5ef9bc91eda92b5da50b68bdf30be582fc409 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 13:44:51 -0400 Subject: [PATCH 098/104] testing stream --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 4121795766..7fe6d53bea 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,7 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat + integer :: id_internal_heat_tend_3d = -1 !< test ID for 3D diagnostic of internal heat end type geothermal_CS From dde649246767632fb599d17e47e79be4bc62ad97 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 13:46:47 -0400 Subject: [PATCH 099/104] testing stream --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 7fe6d53bea..4121795766 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,7 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_internal_heat_tend_3d = -1 !< test ID for 3D diagnostic of internal heat + integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat end type geothermal_CS From 177ed82f613ba52abf33db322bc15cbcdf479c53 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 16:43:35 -0400 Subject: [PATCH 100/104] updated calculation of internal heat diagnostic --- .../vertical/MOM_geothermal.F90 | 44 ++++++++++++------- 1 file changed, 27 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 4121795766..d2dc565bde 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -102,15 +102,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer - ! before any heat is added, - ! for diagnostics [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer - ! before any heat is added, - ! for diagnostics [m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to - ! calculate change in heat - ! due to geothermal + real :: T_old ! Temperature of each layer before any heat is added, + ! for diagnostics [degC] + real, allocatable, dimension(:,:,:) :: h_old ! Thickness of each layer before any heat is added, + ! for diagnostics [m or kg m-2] + real, allocatable, dimension(:,:,:) :: work_3d ! Scratch variable used to calculate change in heat + ! due to geothermal real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) @@ -150,9 +147,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) - ! Save temperature and thickness before any changes are made (for diagnostic) - temp_old = tv%T - h_old = h + ! Allocate diagnostic arrays if required + if (CS%id_internal_heat_tend_3d > 0) then + allocate(h_old(is:ie,js:je,nz)) ; h_old(:,:,:) = 0.0 + allocate(work_3d(is:ie,js:je,nz)) ; work_3d(:,:,:) = 0.0 + endif do j=js,je ! 1. Only work on columns that are being heated. @@ -193,6 +192,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do k=nz,1,-1 do i=isj,iej ; if (do_i(i)) then + ! Save temperature and thickness before any changes are made (for diagnostic) + if (CS%id_internal_heat_tend_3d > 0) then + T_old = tv%T(i,j,k) + h_old(i,j,k) = h(i,j,k) + endif + if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then h_heated = h_geo_rem(i) @@ -312,6 +317,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! endif endif endif + + ! Calculate heat tendency due to addition and transfer of internal heat + if (CS%id_internal_heat_tend_3d > 0) then + work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old) + endif + endif ; enddo if (num_left <= 0) exit enddo ! k-loop @@ -322,12 +333,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop - ! Calculate heat tendency due to addition and transfer of internal heat + ! Post diagnostic of internal heat tendency in 3D if (CS%id_internal_heat_tend_3d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) - enddo ; enddo ; enddo call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) + deallocate(h_old) + deallocate(work_3d) endif ! do i=is,ie ; do j=js,je @@ -421,7 +431,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) ! Diagnostic for tendency due to internal heat (in 3d) CS%id_internal_heat_tend_3d=register_diag_field('ocean_model', & 'internal_heat_tend_3d', diag%axesTL, Time, & - 'Internal heat tendency in 3D, reveals layer(s) that heat is added to', & + '3D heat tendency due to internal (geothermal) sources', & 'W m-2', v_extensive = .true.) end subroutine geothermal_init From a04e559781b431660d50c4706a9056e2c93cb5d0 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 19:21:08 -0400 Subject: [PATCH 101/104] included diagnostics for T and h from internal heat, and improved logic --- .../vertical/MOM_geothermal.F90 | 74 ++++++++++++------- 1 file changed, 48 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index d2dc565bde..e80af18220 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,9 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat + integer :: id_internal_heat_heat_tendency = -1 !< ID for diagnostic of heat tendency + integer :: id_internal_heat_temp_tendency = -1 !< ID for diagnostic of temperature tendency + integer :: id_internal_heat_h_tendency = -1 !< ID for diagnostic of thickness tendency end type geothermal_CS @@ -102,12 +104,15 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] - real :: T_old ! Temperature of each layer before any heat is added, - ! for diagnostics [degC] - real, allocatable, dimension(:,:,:) :: h_old ! Thickness of each layer before any heat is added, - ! for diagnostics [m or kg m-2] - real, allocatable, dimension(:,:,:) :: work_3d ! Scratch variable used to calculate change in heat - ! due to geothermal + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_old ! Temperature of each layer + ! before any heat is added, + ! for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer + ! before any heat is added, + ! for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to + ! calculate change in heat + ! due to geothermal real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) @@ -147,12 +152,6 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) - ! Allocate diagnostic arrays if required - if (CS%id_internal_heat_tend_3d > 0) then - allocate(h_old(is:ie,js:je,nz)) ; h_old(:,:,:) = 0.0 - allocate(work_3d(is:ie,js:je,nz)) ; work_3d(:,:,:) = 0.0 - endif - do j=js,je ! 1. Only work on columns that are being heated. ! 2. Find the deepest layer with any mass. @@ -193,10 +192,15 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do i=isj,iej ; if (do_i(i)) then ! Save temperature and thickness before any changes are made (for diagnostic) - if (CS%id_internal_heat_tend_3d > 0) then - T_old = tv%T(i,j,k) + if (CS%id_internal_heat_h_tendency > 0 & + .or. CS%id_internal_heat_heat_tendency & + .or. CS%id_internal_heat_temp_tendency ) then h_old(i,j,k) = h(i,j,k) endif + if (CS%id_internal_heat_heat_tendency > 0 .or. CS%id_internal_heat_temp_tendency) then + T_old(i,j,k) = tv%T(i,j,k) + endif + if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then @@ -319,8 +323,8 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) endif ! Calculate heat tendency due to addition and transfer of internal heat - if (CS%id_internal_heat_tend_3d > 0) then - work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old) + if (CS%id_internal_heat_heat_tendency > 0) then + work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old(i,j,k)) endif endif ; enddo @@ -333,11 +337,21 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop - ! Post diagnostic of internal heat tendency in 3D - if (CS%id_internal_heat_tend_3d > 0) then - call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) - deallocate(h_old) - deallocate(work_3d) + ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat + if (CS%id_internal_heat_heat_tendency > 0) then + call post_data(CS%id_internal_heat_heat_tendemcy, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_internal_heat_temp_tendency > 0) then + do j=js,je; do i=is,ie; do k=ks,ke + work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_T_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_internal_heat_h_tendency > 0) then + do j=js,je; do i=is,ie; do k=ks,ke + work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h = h_old) endif ! do i=is,ie ; do j=js,je @@ -428,11 +442,19 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) - ! Diagnostic for tendency due to internal heat (in 3d) - CS%id_internal_heat_tend_3d=register_diag_field('ocean_model', & - 'internal_heat_tend_3d', diag%axesTL, Time, & - '3D heat tendency due to internal (geothermal) sources', & + ! Diagnostic for tendencies due to internal heat (in 3d) + CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & + 'internal_heat_heat_tendency', diag%axesTL, Time, & + 'Heat tendency (in 3D) due to internal (geothermal) sources', & 'W m-2', v_extensive = .true.) + CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & + 'internal_heat_temp_tendency', diag%axesTL, Time, & + 'Temperature tendency (in 3D) due to internal (geothermal) sources', & + 'degC s-1', v_extensive = .true.) + 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', & + 'm OR kg m-2', v_extensive = .true.) end subroutine geothermal_init From ed7382e1a731d13b718c9d1b4bfd13875ca1a5cf Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 19:25:32 -0400 Subject: [PATCH 102/104] minor adjustment --- src/parameterizations/vertical/MOM_geothermal.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index e80af18220..5c29c3667c 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -339,16 +339,16 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat if (CS%id_internal_heat_heat_tendency > 0) then - call post_data(CS%id_internal_heat_heat_tendemcy, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_heat_tendency, work_3d, CS%diag, alt_h = h_old) endif if (CS%id_internal_heat_temp_tendency > 0) then - do j=js,je; do i=is,ie; do k=ks,ke + do j=js,je; do i=is,ie; do k=nz,1,-1 work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) enddo; enddo; enddo - call post_data(CS%id_T_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) endif if (CS%id_internal_heat_h_tendency > 0) then - do j=js,je; do i=is,ie; do k=ks,ke + do j=js,je; do i=is,ie; do k=nz,1,-1 work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) enddo; enddo; enddo call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h = h_old) @@ -455,7 +455,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & 'm OR kg m-2', v_extensive = .true.) - + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. From ebec6108ef6bb30022f0a7be24cb62c80a491d7c Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 23:11:17 -0400 Subject: [PATCH 103/104] removed whitespace --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 5c29c3667c..5885473459 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -455,7 +455,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & 'm OR kg m-2', v_extensive = .true.) - + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. From 7c811e2bd9e87fb77c18cf4268d62a4378660468 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 23:59:44 -0400 Subject: [PATCH 104/104] fixed problem in conditional statements --- src/parameterizations/vertical/MOM_geothermal.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 5885473459..10fe37da89 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -193,11 +193,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Save temperature and thickness before any changes are made (for diagnostic) if (CS%id_internal_heat_h_tendency > 0 & - .or. CS%id_internal_heat_heat_tendency & - .or. CS%id_internal_heat_temp_tendency ) then + .or. CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 ) then h_old(i,j,k) = h(i,j,k) endif - if (CS%id_internal_heat_heat_tendency > 0 .or. CS%id_internal_heat_temp_tendency) then + if (CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0) then T_old(i,j,k) = tv%T(i,j,k) endif